source: branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_fmask.F90 @ 6923

Last change on this file since 6923 was 6923, checked in by gm, 5 years ago

#1692 - branch SIMPLIF_2_usrdef: update comments in usrdef modules

File size: 8.1 KB
Line 
1MODULE usrdef_fmask
2   !!======================================================================
3   !!                     ***  MODULE usrdef_fmask   ***
4   !!
5   !!                      ===  ORCA configuration  ===
6   !!                            (2 and 1 degrees)
7   !!
8   !! User defined : alteration of land/sea f-point mask in some straits
9   !!======================================================================
10   !! History :  4.0  ! 2016-06  (G. Madec, S. Flavoni)  Original code
11   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   usr_def_fmask  : alteration of f-point land/ocean mask in some straits
15   !!----------------------------------------------------------------------
16   USE oce             ! ocean dynamics and tracers
17   USE dom_oce         ! ocean space and time domain
18   !
19   USE in_out_manager  ! I/O manager
20   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
21   USE lib_mpp         ! Massively Parallel Processing library
22
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC   usr_def_fmask    ! routine called by dommsk.F90
27
28   !! * Substitutions
29#  include "vectopt_loop_substitute.h90"
30   !!----------------------------------------------------------------------
31   !! NEMO/OPA 4.0 , NEMO Consortium  (2016)
32   !! $Id$
33   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
34   !!----------------------------------------------------------------------
35CONTAINS
36
37   SUBROUTINE usr_def_fmask( cd_cfg, kcfg, pfmsk )
38      !!---------------------------------------------------------------------
39      !!                 ***  ROUTINE dom_msk  ***
40      !!
41      !! ** Purpose :   User defined alteration of the lateral boundary
42      !!              condition on velocity.
43      !!
44      !! ** Method  :   Local change of the value of fmask at lateral ocean/land
45      !!              boundary in straits in order to increase the viscous
46      !!              boundary layer and thus reduce the transport through the
47      !!              corresponding straits.
48      !!                Here only alterations in ORCA R2 and R1 cases
49      !!
50      !! ** Action :   fmask : land/ocean mask at f-point with increased value
51      !!                       in some user defined straits
52      !!----------------------------------------------------------------------
53      CHARACTER(len=1)          , INTENT(in   ) ::   cd_cfg   ! configuration name
54      INTEGER                   , INTENT(in   ) ::   kcfg     ! configuration identifier
55      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pfmsk    ! Ocean/Land f-point mask including lateral boundary cond.
56      !
57      INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers
58      INTEGER  ::   ijf, ijl, ij0, ij1       !   -       -
59      INTEGER  ::   isrow                    ! index for ORCA1 starting row
60      !!----------------------------------------------------------------------
61      !
62      IF( cd_cfg == "orca" ) THEN      !==  ORCA Configurations  ==!
63         !
64         SELECT CASE ( kcfg )
65         !
66         CASE( 2 )                           !  R2 case
67            IF(lwp) WRITE(numout,*)
68            IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R2: increase lateral friction near the following straits:'
69            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
70            !
71            IF(lwp) WRITE(numout,*) '      Gibraltar '
72            ij0 = 101   ;   ij1 = 101           ! Gibraltar strait  : partial slip (pfmsk=0.5)
73            ii0 = 139   ;   ii1 = 140   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
74            ij0 = 102   ;   ij1 = 102
75            ii0 = 139   ;   ii1 = 140   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
76            !
77            IF(lwp) WRITE(numout,*) '      Bab el Mandeb '
78            ij0 =  87   ;   ij1 =  88           ! Bab el Mandeb : partial slip (pfmsk=1)
79            ii0 = 160   ;   ii1 = 160   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
80            ij0 =  88   ;   ij1 =  88
81            ii0 = 159   ;   ii1 = 159   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
82            !
83            ! We keep this as an example but it is instable in this case
84            !IF(lwp) WRITE(numout,*) '      Danish straits '
85            !         ij0 = 115   ;   ij1 = 115 ! Danish straits  : strong slip (pfmsk > 2)
86            !         ii0 = 145   ;   ii1 = 146   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
87            !         ij0 = 116   ;   ij1 = 116
88            !         ii0 = 145   ;   ii1 = 146   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
89            !
90         CASE( 1 )                           ! R1 case
91            IF(lwp) WRITE(numout,*)
92            IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R1: increase lateral friction near the following straits:'
93            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'   
94!!gm    ! This dirty section will be suppressed by simplification process:
95!!gm    ! all this will come back in input files
96!!gm    ! Currently these hard-wired indices relate to configuration with extend grid (jpjglo=332)
97            !
98            isrow = 332 - jpjglo
99            !
100            IF(lwp) WRITE(numout,*)
101            IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : '
102            IF(lwp) WRITE(numout,*) '      Gibraltar '
103            ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait
104            ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
105            !
106            IF(lwp) WRITE(numout,*) '      Bhosporus '
107            ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait
108            ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
109            !
110            IF(lwp) WRITE(numout,*) '      Makassar (Top) '
111            ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top)
112            ij0 = 189 - isrow   ;   ij1 = 190 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 
113            !
114            IF(lwp) WRITE(numout,*) '      Lombok '
115            ii0 =  44           ;   ii1 =  44        ! Lombok Strait
116            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
117            !
118            IF(lwp) WRITE(numout,*) '      Ombai '
119            ii0 =  53           ;   ii1 =  53        ! Ombai Strait
120            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
121            !
122            IF(lwp) WRITE(numout,*) '      Timor Passage '
123            ii0 =  56           ;   ii1 =  56        ! Timor Passage
124            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
125            !
126            IF(lwp) WRITE(numout,*) '      West Halmahera '
127            ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait
128            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 
129            !
130            IF(lwp) WRITE(numout,*) '      East Halmahera '
131            ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait
132            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 
133            !
134         CASE DEFAULT
135            IF(lwp) WRITE(numout,*)
136            IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R', kcfg,' : NO alteration of fmask in specific straits '
137            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'   
138         END SELECT
139      ELSE
140         IF(lwp) WRITE(numout,*)
141         IF(lwp) WRITE(numout,*) 'usr_def_fmask : NO alteration of fmask in specific straits '
142         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
143      ENDIF
144      !
145      CALL lbc_lnk( pfmsk, 'F', 1._wp )      ! Lateral boundary conditions on fmask
146      !
147   END SUBROUTINE usr_def_fmask
148   
149   !!======================================================================
150END MODULE usrdef_fmask
Note: See TracBrowser for help on using the repository browser.