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 branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/USR – NEMO

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

Last change on this file since 6717 was 6717, checked in by gm, 8 years ago

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