New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
usrdef_fmask.F90 in NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/USR – NEMO

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/USR/usrdef_fmask.F90 @ 12353

Last change on this file since 12353 was 12353, checked in by acc, 4 years ago

Branch 2019/dev_r11943_MERGE_2019. Additions to the do loop macro implementation: converted a few loops previously missed because they used jpi-1 instead of jpim1 etc.; changed internal macro names in do_loop_substitute.h90 to strings that are much more unlikely to appear in any future code elsewhere and removed the key_vectopt_loop option (and all related code) since the do loop macros have suppressed this option. These changes have been fully SETTE-tested and this branch should now be ready to go back to the trunk.
  • Property svn:keywords set to Id
File size: 8.0 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   !!----------------------------------------------------------------------
29   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
30   !! $Id$
31   !! Software governed by the CeCILL license (see ./LICENSE)
32   !!----------------------------------------------------------------------
33CONTAINS
34
35   SUBROUTINE usr_def_fmask( cd_cfg, kcfg, pfmsk )
36      !!---------------------------------------------------------------------
37      !!                 ***  ROUTINE dom_msk  ***
38      !!
39      !! ** Purpose :   User defined alteration of the lateral boundary
40      !!              condition on velocity.
41      !!
42      !! ** Method  :   Local change of the value of fmask at lateral ocean/land
43      !!              boundary in straits in order to increase the viscous
44      !!              boundary layer and thus reduce the transport through the
45      !!              corresponding straits.
46      !!                Here only alterations in ORCA R2 and R1 cases
47      !!
48      !! ** Action :   fmask : land/ocean mask at f-point with increased value
49      !!                       in some user defined straits
50      !!----------------------------------------------------------------------
51      CHARACTER(len=*)          , INTENT(in   ) ::   cd_cfg   ! configuration name
52      INTEGER                   , INTENT(in   ) ::   kcfg     ! configuration identifier
53      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pfmsk    ! Ocean/Land f-point mask including lateral boundary cond.
54      !
55      INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers
56      INTEGER  ::   ijf, ijl, ij0, ij1       !   -       -
57      INTEGER  ::   isrow                    ! index for ORCA1 starting row
58      !!----------------------------------------------------------------------
59      !
60      IF( TRIM( cd_cfg ) == "orca" ) THEN      !==  ORCA Configurations  ==!
61         !
62         SELECT CASE ( kcfg )
63         !
64         CASE( 2 )                           !  R2 case
65            IF(lwp) WRITE(numout,*)
66            IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R2: increase lateral friction near the following straits:'
67            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
68            !
69            IF(lwp) WRITE(numout,*) '      Gibraltar '
70            ij0 = 101   ;   ij1 = 101           ! Gibraltar strait  : partial slip (pfmsk=0.5)
71            ii0 = 139   ;   ii1 = 140   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
72            ij0 = 102   ;   ij1 = 102
73            ii0 = 139   ;   ii1 = 140   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
74            !
75            IF(lwp) WRITE(numout,*) '      Bab el Mandeb '
76            ij0 =  87   ;   ij1 =  88           ! Bab el Mandeb : partial slip (pfmsk=1)
77            ii0 = 160   ;   ii1 = 160   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
78            ij0 =  88   ;   ij1 =  88
79            ii0 = 159   ;   ii1 = 159   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
80            !
81            ! We keep this as an example but it is instable in this case
82            !IF(lwp) WRITE(numout,*) '      Danish straits '
83            !         ij0 = 115   ;   ij1 = 115 ! Danish straits  : strong slip (pfmsk > 2)
84            !         ii0 = 145   ;   ii1 = 146   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
85            !         ij0 = 116   ;   ij1 = 116
86            !         ii0 = 145   ;   ii1 = 146   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
87            !
88         CASE( 1 )                           ! R1 case
89            IF(lwp) WRITE(numout,*)
90            IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R1: increase lateral friction near the following straits:'
91            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'   
92!!gm    ! This dirty section will be suppressed by simplification process:
93!!gm    ! all this will come back in input files
94!!gm    ! Currently these hard-wired indices relate to configuration with extend grid (jpjglo=332)
95            !
96            isrow = 332 - jpjglo
97            !
98            IF(lwp) WRITE(numout,*)
99            IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : '
100            IF(lwp) WRITE(numout,*) '      Gibraltar '
101            ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait
102            ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
103            !
104            IF(lwp) WRITE(numout,*) '      Bhosporus '
105            ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait
106            ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
107            !
108            IF(lwp) WRITE(numout,*) '      Makassar (Top) '
109            ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top)
110            ij0 = 189 - isrow   ;   ij1 = 190 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 
111            !
112            IF(lwp) WRITE(numout,*) '      Lombok '
113            ii0 =  44           ;   ii1 =  44        ! Lombok Strait
114            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
115            !
116            IF(lwp) WRITE(numout,*) '      Ombai '
117            ii0 =  53           ;   ii1 =  53        ! Ombai Strait
118            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
119            !
120            IF(lwp) WRITE(numout,*) '      Timor Passage '
121            ii0 =  56           ;   ii1 =  56        ! Timor Passage
122            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
123            !
124            IF(lwp) WRITE(numout,*) '      West Halmahera '
125            ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait
126            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 
127            !
128            IF(lwp) WRITE(numout,*) '      East Halmahera '
129            ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait
130            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 
131            !
132         CASE DEFAULT
133            IF(lwp) WRITE(numout,*)
134            IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R', kcfg,' : NO alteration of fmask in specific straits '
135            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'   
136         END SELECT
137      ELSE
138         IF(lwp) WRITE(numout,*)
139         IF(lwp) WRITE(numout,*) 'usr_def_fmask : NO alteration of fmask in specific straits '
140         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
141      ENDIF
142      !
143      CALL lbc_lnk( 'usrdef_fmask', pfmsk, 'F', 1._wp )      ! Lateral boundary conditions on fmask
144      !
145   END SUBROUTINE usr_def_fmask
146   
147   !!======================================================================
148END MODULE usrdef_fmask
Note: See TracBrowser for help on using the repository browser.