source: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/DOM/dommsk.F90 @ 12587

Last change on this file since 12587 was 12377, checked in by acc, 8 months ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

  • Property svn:keywords set to Id
File size: 13.9 KB
Line 
1MODULE dommsk
2   !!======================================================================
3   !!                       ***  MODULE dommsk   ***
4   !! Ocean initialization : domain land/sea mask
5   !!======================================================================
6   !! History :  OPA  ! 1987-07  (G. Madec)  Original code
7   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon)
8   !!            7.0  ! 1996-01  (G. Madec)  suppression of common work arrays
9   !!             -   ! 1996-05  (G. Madec)  mask computed from tmask
10   !!            8.0  ! 1997-02  (G. Madec)  mesh information put in domhgr.F
11   !!            8.1  ! 1997-07  (G. Madec)  modification of kbat and fmask
12   !!             -   ! 1998-05  (G. Roullet)  free surface
13   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
14   !!             -   ! 2001-09  (J.-M. Molines)  Open boundaries
15   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module
16   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
17   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
18   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask
19   !!            4.0  ! 2016-06  (G. Madec, S. Flavoni)  domain configuration / user defined interface
20   !!----------------------------------------------------------------------
21
22   !!----------------------------------------------------------------------
23   !!   dom_msk       : compute land/ocean mask
24   !!----------------------------------------------------------------------
25   USE oce            ! ocean dynamics and tracers
26   USE dom_oce        ! ocean space and time domain
27   USE usrdef_fmask   ! user defined fmask
28   USE bdy_oce        ! open boundary
29   !
30   USE in_out_manager ! I/O manager
31   USE iom            ! IOM library
32   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
33   USE lib_mpp        ! Massively Parallel Processing library
34
35   IMPLICIT NONE
36   PRIVATE
37
38   PUBLIC   dom_msk    ! routine called by inidom.F90
39
40   !                            !!* Namelist namlbc : lateral boundary condition *
41   REAL(wp)        :: rn_shlat   ! type of lateral boundary condition on velocity
42   LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition
43   !                                            with analytical eqs.
44
45   !! * Substitutions
46#  include "do_loop_substitute.h90"
47   !!----------------------------------------------------------------------
48   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
49   !! $Id$
50   !! Software governed by the CeCILL license (see ./LICENSE)
51   !!----------------------------------------------------------------------
52CONTAINS
53
54   SUBROUTINE dom_msk( k_top, k_bot )
55      !!---------------------------------------------------------------------
56      !!                 ***  ROUTINE dom_msk  ***
57      !!
58      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
59      !!      zontal velocity points (u & v), vorticity points (f) points.
60      !!
61      !! ** Method  :   The ocean/land mask  at t-point is deduced from ko_top
62      !!      and ko_bot, the indices of the fist and last ocean t-levels which
63      !!      are either defined in usrdef_zgr or read in zgr_read.
64      !!                The velocity masks (umask, vmask, wmask, wumask, wvmask)
65      !!      are deduced from a product of the two neighboring tmask.
66      !!                The vorticity mask (fmask) is deduced from tmask taking
67      !!      into account the choice of lateral boundary condition (rn_shlat) :
68      !!         rn_shlat = 0, free slip  (no shear along the coast)
69      !!         rn_shlat = 2, no slip  (specified zero velocity at the coast)
70      !!         0 < rn_shlat < 2, partial slip   | non-linear velocity profile
71      !!         2 < rn_shlat, strong slip        | in the lateral boundary layer
72      !!
73      !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated
74      !!                rows/lines due to cyclic or North Fold boundaries as well
75      !!                as MPP halos.
76      !!      tmask_h : halo mask at t-point, i.e. excluding duplicated rows/lines
77      !!                due to cyclic or North Fold boundaries as well as MPP halos.
78      !!
79      !! ** Action :   tmask, umask, vmask, wmask, wumask, wvmask : land/ocean mask
80      !!                         at t-, u-, v- w, wu-, and wv-points (=0. or 1.)
81      !!               fmask   : land/ocean mask at f-point (=0., or =1., or
82      !!                         =rn_shlat along lateral boundaries)
83      !!               tmask_i : interior ocean mask
84      !!               tmask_h : halo mask
85      !!               ssmask , ssumask, ssvmask, ssfmask : 2D ocean mask
86      !!----------------------------------------------------------------------
87      INTEGER, DIMENSION(:,:), INTENT(in) ::   k_top, k_bot   ! first and last ocean level
88      !
89      INTEGER  ::   ji, jj, jk     ! dummy loop indices
90      INTEGER  ::   iif, iil       ! local integers
91      INTEGER  ::   ijf, ijl       !   -       -
92      INTEGER  ::   iktop, ikbot   !   -       -
93      INTEGER  ::   ios, inum
94      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwf   ! 2D workspace
95      !!
96      NAMELIST/namlbc/ rn_shlat, ln_vorlat
97      NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file,         &
98         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
99         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &
100         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
101         &             cn_ice, nn_ice_dta,                                     &
102         &             ln_vol, nn_volctl, nn_rimwidth
103      !!---------------------------------------------------------------------
104      !
105      READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 )
106901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlbc in reference namelist' )
107      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 )
108902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlbc in configuration namelist' )
109      IF(lwm) WRITE ( numond, namlbc )
110     
111      IF(lwp) THEN                  ! control print
112         WRITE(numout,*)
113         WRITE(numout,*) 'dommsk : ocean mask '
114         WRITE(numout,*) '~~~~~~'
115         WRITE(numout,*) '   Namelist namlbc'
116         WRITE(numout,*) '      lateral momentum boundary cond.    rn_shlat  = ',rn_shlat
117         WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat 
118      ENDIF
119      !
120      IF(lwp) WRITE(numout,*)
121      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  free-slip'
122      ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  no-slip'
123      ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  partial-slip'
124      ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  strong-slip'
125      ELSE
126         CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' )
127      ENDIF
128
129      !  Ocean/land mask at t-point  (computed from ko_top and ko_bot)
130      ! ----------------------------
131      !
132      tmask(:,:,:) = 0._wp
133      DO_2D_11_11
134         iktop = k_top(ji,jj)
135         ikbot = k_bot(ji,jj)
136         IF( iktop /= 0 ) THEN       ! water in the column
137            tmask(ji,jj,iktop:ikbot  ) = 1._wp
138         ENDIF
139      END_2D
140      !
141      ! the following call is mandatory
142      ! it masks boundaries (bathy=0) where needed depending on the configuration (closed, periodic...) 
143      CALL lbc_lnk( 'dommsk', tmask  , 'T', 1._wp )      ! Lateral boundary conditions
144
145     ! Mask corrections for bdy (read in mppini2)
146      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
147903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist' )
148      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
149904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist' )
150      ! ------------------------
151      IF ( ln_bdy .AND. ln_mask_file ) THEN
152         CALL iom_open( cn_mask_file, inum )
153         CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) )
154         CALL iom_close( inum )
155         DO_3D_11_11( 1, jpkm1 )
156            tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj)
157         END_3D
158      ENDIF
159         
160      !  Ocean/land mask at u-, v-, and f-points   (computed from tmask)
161      ! ----------------------------------------
162      ! NB: at this point, fmask is designed for free slip lateral boundary condition
163      DO jk = 1, jpk
164         DO jj = 1, jpjm1
165            DO ji = 1, jpim1   ! vector loop
166               umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)
167               vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk)
168            END DO
169            DO ji = 1, jpim1      ! NO vector opt.
170               fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
171                  &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
172            END DO
173         END DO
174      END DO
175      CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1., vmask, 'V', 1., fmask, 'F', 1. )      ! Lateral boundary conditions
176 
177      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask)
178      !-----------------------------------------
179      wmask (:,:,1) = tmask(:,:,1)     ! surface
180      wumask(:,:,1) = umask(:,:,1)
181      wvmask(:,:,1) = vmask(:,:,1)
182      DO jk = 2, jpk                   ! interior values
183         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
184         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)   
185         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1)
186      END DO
187
188
189      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical)
190      ! ----------------------------------------------
191      ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 )
192      ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 )
193      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 )
194
195
196      ! Interior domain mask  (used for global sum)
197      ! --------------------
198      !
199      iif = nn_hls   ;   iil = nlci - nn_hls + 1
200      ijf = nn_hls   ;   ijl = nlcj - nn_hls + 1
201      !
202      !                          ! halo mask : 0 on the halo and 1 elsewhere
203      tmask_h(:,:) = 1._wp                 
204      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns
205      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns)
206      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows
207      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
208      !
209      !                          ! north fold mask
210      tpol(1:jpiglo) = 1._wp 
211      fpol(1:jpiglo) = 1._wp
212      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot
213         tpol(jpiglo/2+1:jpiglo) = 0._wp
214         fpol(     1    :jpiglo) = 0._wp
215         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row for tmask_h
216            DO ji = iif+1, iil-1
217               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji))
218            END DO
219         ENDIF
220      ENDIF
221      !
222      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
223         tpol(     1    :jpiglo) = 0._wp
224         fpol(jpiglo/2+1:jpiglo) = 0._wp
225      ENDIF
226      !
227      !                          ! interior mask : 2D ocean mask x halo mask
228      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:)
229
230
231      ! Lateral boundary conditions on velocity (modify fmask)
232      ! --------------------------------------- 
233      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition
234         !
235         ALLOCATE( zwf(jpi,jpj) )
236         !
237         DO jk = 1, jpk
238            zwf(:,:) = fmask(:,:,jk)         
239            DO_2D_00_00
240               IF( fmask(ji,jj,jk) == 0._wp ) THEN
241                  fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   &
242                     &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  )
243               ENDIF
244            END_2D
245            DO jj = 2, jpjm1
246               IF( fmask(1,jj,jk) == 0._wp ) THEN
247                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
248               ENDIF
249               IF( fmask(jpi,jj,jk) == 0._wp ) THEN
250                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
251               ENDIF
252            END DO         
253            DO ji = 2, jpim1
254               IF( fmask(ji,1,jk) == 0._wp ) THEN
255                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
256               ENDIF
257               IF( fmask(ji,jpj,jk) == 0._wp ) THEN
258                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
259               ENDIF
260            END DO
261#if defined key_agrif 
262            IF( .NOT. AGRIF_Root() ) THEN
263               IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(nlci-1 , :     ,jk) = 0.e0      ! east
264               IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1      , :     ,jk) = 0.e0      ! west
265               IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north
266               IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:      ,1      ,jk) = 0.e0      ! south
267            ENDIF 
268#endif
269         END DO
270         !
271         DEALLOCATE( zwf )
272         !
273         CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
274         !
275         ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat
276         !
277      ENDIF
278     
279      ! User defined alteration of fmask (use to reduce ocean transport in specified straits)
280      ! --------------------------------
281      !
282      CALL usr_def_fmask( cn_cfg, nn_cfg, fmask )
283      !
284   END SUBROUTINE dom_msk
285   
286   !!======================================================================
287END MODULE dommsk
Note: See TracBrowser for help on using the repository browser.