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/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/USR – NEMO

source: NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/USR/usrdef_fmask.F90 @ 12960

Last change on this file since 12960 was 12960, checked in by smasson, 5 years ago

Extra_Halo: additional bugfixes and developments, see #2366
  • Property svn:keywords set to Id
File size: 8.2 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 + nn_hls       ;   ij1 = 101 + nn_hls           ! Gibraltar strait  : partial slip (pfmsk=0.5)
71            ii0 = 139 + nn_hls - 1   ;   ii1 = 140 + nn_hls - 1
72            pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
73            ij0 = 102 + nn_hls       ;   ij1 = 102 + nn_hls
74            ii0 = 139 + nn_hls - 1   ;   ii1 = 140 + nn_hls - 1
75            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 + nn_hls       ;   ij1 =  88  + nn_hls          ! Bab el Mandeb : partial slip (pfmsk=1)
79            ii0 = 160  + nn_hls - 1  ;   ii1 = 160 + nn_hls - 1
80            pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
81            ij0 =  88 + nn_hls       ;   ij1 =  88 + nn_hls
82            ii0 = 159 + nn_hls - 1   ;   ii1 = 159 + nn_hls - 1
83            pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
84            !
85            ! We keep this as an example but it is instable in this case
86            !IF(lwp) WRITE(numout,*) '      Danish straits '
87            !         ij0 = 115   ;   ij1 = 115 ! Danish straits  : strong slip (pfmsk > 2)
88            !         ii0 = 145   ;   ii1 = 146   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
89            !         ij0 = 116   ;   ij1 = 116
90            !         ii0 = 145   ;   ii1 = 146   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
91            !
92         CASE( 1 )                           ! R1 case
93            IF(lwp) WRITE(numout,*)
94            IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R1: increase lateral friction near the following straits:'
95            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'   
96!!gm    ! This dirty section will be suppressed by simplification process:
97!!gm    ! all this will come back in input files
98!!gm    ! Currently these hard-wired indices relate to configuration with extend grid (jpjglo=332)
99            !
100            isrow = 332 - Nj0glo - 2
101            !
102            IF(lwp) WRITE(numout,*)
103            IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : '
104            IF(lwp) WRITE(numout,*) '      Gibraltar '
105            ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait
106            ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
107            !
108            IF(lwp) WRITE(numout,*) '      Bhosporus '
109            ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait
110            ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
111            !
112            IF(lwp) WRITE(numout,*) '      Makassar (Top) '
113            ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top)
114            ij0 = 189 - isrow   ;   ij1 = 190 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 
115            !
116            IF(lwp) WRITE(numout,*) '      Lombok '
117            ii0 =  44           ;   ii1 =  44        ! Lombok 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,*) '      Ombai '
121            ii0 =  53           ;   ii1 =  53        ! Ombai Strait
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,*) '      Timor Passage '
125            ii0 =  56           ;   ii1 =  56        ! Timor Passage
126            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
127            !
128            IF(lwp) WRITE(numout,*) '      West Halmahera '
129            ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait
130            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 
131            !
132            IF(lwp) WRITE(numout,*) '      East Halmahera '
133            ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait
134            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 
135            !
136         CASE DEFAULT
137            IF(lwp) WRITE(numout,*)
138            IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R', kcfg,' : NO alteration of fmask in specific straits '
139            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'   
140         END SELECT
141      ELSE
142         IF(lwp) WRITE(numout,*)
143         IF(lwp) WRITE(numout,*) 'usr_def_fmask : NO alteration of fmask in specific straits '
144         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
145      ENDIF
146      !
147      CALL lbc_lnk( 'usrdef_fmask', pfmsk, 'F', 1._wp )      ! Lateral boundary conditions on fmask
148      !
149   END SUBROUTINE usr_def_fmask
150   
151   !!======================================================================
152END MODULE usrdef_fmask
Note: See TracBrowser for help on using the repository browser.