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 utils/tools_dev_r12970_AGRIF_CMEMS/DOMAINcfg/src – NEMO

source: utils/tools_dev_r12970_AGRIF_CMEMS/DOMAINcfg/src/usrdef_fmask.F90 @ 13024

Last change on this file since 13024 was 13024, checked in by rblod, 4 years ago

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