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.
dommsk.F90 in NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC – NEMO

source: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/cfgs/penzAM98/MY_SRC/dommsk.F90 @ 13562

Last change on this file since 13562 was 13562, checked in by gm, 4 years ago

zgr_pse created only for NS coast
File size: 20.4 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   USE usrdef_nam , ONLY : nn_cnp    ! use penalisation parameter
35
36   IMPLICIT NONE
37   PRIVATE
38
39   PUBLIC   dom_msk    ! routine called by inidom.F90
40
41   !                            !!* Namelist namlbc : lateral boundary condition *
42   REAL(wp)        :: rn_shlat   ! type of lateral boundary condition on velocity
43   LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition
44   !                                            with analytical eqs.
45
46   !! * Substitutions
47#  include "do_loop_substitute.h90"
48   !!----------------------------------------------------------------------
49   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
50   !! $Id: dommsk.F90 13416 2020-08-20 10:10:55Z gm $
51   !! Software governed by the CeCILL license (see ./LICENSE)
52   !!----------------------------------------------------------------------
53CONTAINS
54
55   SUBROUTINE dom_msk( k_top, k_bot )
56      !!---------------------------------------------------------------------
57      !!                 ***  ROUTINE dom_msk  ***
58      !!
59      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
60      !!      zontal velocity points (u & v), vorticity points (f) points.
61      !!
62      !! ** Method  :   The ocean/land mask  at t-point is deduced from ko_top
63      !!      and ko_bot, the indices of the fist and last ocean t-levels which
64      !!      are either defined in usrdef_zgr or read in zgr_read.
65      !!                The velocity masks (umask, vmask, wmask, wumask, wvmask)
66      !!      are deduced from a product of the two neighboring tmask.
67      !!                The vorticity mask (fmask) is deduced from tmask taking
68      !!      into account the choice of lateral boundary condition (rn_shlat) :
69      !!         rn_shlat = 0, free slip  (no shear along the coast)
70      !!         rn_shlat = 2, no slip  (specified zero velocity at the coast)
71      !!         0 < rn_shlat < 2, partial slip   | non-linear velocity profile
72      !!         2 < rn_shlat, strong slip        | in the lateral boundary layer
73      !!
74      !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated
75      !!                rows/lines due to cyclic or North Fold boundaries as well
76      !!                as MPP halos.
77      !!      tmask_h : halo mask at t-point, i.e. excluding duplicated rows/lines
78      !!                due to cyclic or North Fold boundaries as well as MPP halos.
79      !!
80      !! ** Action :   tmask, umask, vmask, wmask, wumask, wvmask : land/ocean mask
81      !!                         at t-, u-, v- w, wu-, and wv-points (=0. or 1.)
82      !!               fmask   : land/ocean mask at f-point (=0., or =1., or
83      !!                         =rn_shlat along lateral boundaries)
84      !!               tmask_i : interior ocean mask
85      !!               tmask_h : halo mask
86      !!               ssmask , ssumask, ssvmask, ssfmask : 2D ocean mask
87      !!----------------------------------------------------------------------
88      INTEGER, DIMENSION(:,:), INTENT(in) ::   k_top, k_bot   ! first and last ocean level
89      !
90      INTEGER  ::   ji, jj, jk, jl     ! dummy loop indices
91      INTEGER  ::   znummask       ! local integers
92      INTEGER  ::   iif, iil       ! local integers
93      INTEGER  ::   ijf, ijl       !   -       -
94      INTEGER  ::   iktop, ikbot   !   -       -
95      INTEGER  ::   ios, inum
96      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zwf   ! 2D workspace
97      !!
98      NAMELIST/namlbc/ rn_shlat, ln_vorlat
99      NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file,         &
100         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
101         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &
102         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
103         &             cn_ice, nn_ice_dta,                                     &
104         &             ln_vol, nn_volctl, nn_rimwidth
105      !!---------------------------------------------------------------------
106      !
107      READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 )
108901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlbc in reference namelist' )
109      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 )
110902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlbc in configuration namelist' )
111      IF(lwm) WRITE ( numond, namlbc )
112
113      IF(lwp) THEN                  ! control print
114         WRITE(numout,*)
115         WRITE(numout,*) 'dommsk : ocean mask '
116         WRITE(numout,*) '~~~~~~'
117         WRITE(numout,*) '   Namelist namlbc'
118         WRITE(numout,*) '      lateral momentum boundary cond.    rn_shlat  = ',rn_shlat
119         WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat
120      ENDIF
121      !
122      IF(lwp) WRITE(numout,*)
123      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  free-slip'
124      ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  no-slip'
125      ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  partial-slip'
126      ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  strong-slip'
127      ELSE
128         CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' )
129      ENDIF
130
131      !  Ocean/land mask at t-point  (computed from ko_top and ko_bot)
132      ! ----------------------------
133      !
134      tmask(:,:,:) = 0._wp
135      DO_2D_11_11
136         iktop = k_top(ji,jj)
137         ikbot = k_bot(ji,jj)
138         IF( iktop /= 0 ) THEN       ! water in the column
139            tmask(ji,jj,iktop:ikbot  ) = 1._wp
140         ENDIF
141      END_2D
142      !
143      !
144      ! the following call is mandatory
145      ! it masks boundaries (bathy=0) where needed depending on the configuration (closed, periodic...)
146      CALL lbc_lnk( 'dommsk', tmask  , 'T', 1._wp )      ! Lateral boundary conditions
147
148     ! Mask corrections for bdy (read in mppini2)
149      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
150903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist' )
151      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
152904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist' )
153      ! ------------------------
154      IF ( ln_bdy .AND. ln_mask_file ) THEN
155         CALL iom_open( cn_mask_file, inum )
156         CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) )
157         CALL iom_close( inum )
158         DO_3D_11_11( 1, jpkm1 )
159            tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj)
160         END_3D
161      ENDIF
162      !
163      !  Ocean/land mask at u-, v-, and f-points   (computed from tmask)
164      ! ----------------------------------------
165      ! NB: at this point, fmask is designed for free slip lateral boundary condition
166      DO jk = 1, jpk
167         DO jj = 1, jpjm1
168            DO ji = 1, jpim1   ! vector loop
169               umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)
170               vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk)
171            END DO
172            DO ji = 1, jpim1      ! NO vector opt.
173               fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
174                  &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
175            END DO
176         END DO
177      END DO
178      CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1., vmask, 'V', 1., fmask, 'F', 1. )      ! Lateral boundary conditions
179
180      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask)
181      !-----------------------------------------
182      wmask (:,:,1) = tmask(:,:,1)     ! surface
183      wumask(:,:,1) = umask(:,:,1)
184      wvmask(:,:,1) = vmask(:,:,1)
185      DO jk = 2, jpk                   ! interior values
186         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
187         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)
188         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1)
189      END DO
190
191
192      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical)
193      ! ----------------------------------------------
194      ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 )
195      ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 )
196      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 )
197!!an
198      ! ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 )
199      DO_2D_10_10
200         ssfmask(ji,jj) = MAX(  tmask(ji,jj+1,1), tmask(ji+1,jj+1,1),  &
201            &                   tmask(ji,jj  ,1), tmask(ji+1,jj  ,1)   )
202      END_2D
203      CALL lbc_lnk( 'dommsk', ssfmask, 'F', 1._wp )
204
205!!an
206
207# if defined key_bvp
208      ! smoothing 2D
209      ! DO jl = 1, nn_cnp
210      !   DO jk = 1,jpkm1
211      !     DO_2D_00_00
212      !            rpou(ji,jj,jk) = 0.2_wp * ( rpou(ji,jj,jk) + rpo (ji  ,jj  ,jk) + rpof(ji  ,jj  ,jk)   &
213      !               &                                       + rpo (ji+1,jj  ,jk) + rpof(ji  ,jj-1,jk)   )
214      !            rpov(ji,jj,jk) = 0.2_wp * ( rpov(ji,jj,jk) + rpo (ji  ,jj  ,jk) + rpof(ji  ,jj  ,jk)   &
215      !               &                                       + rpo (ji  ,jj+1,jk) + rpof(ji-1,jj  ,jk)   )
216      !        END_2D
217      !     CALL lbc_lnk_multi( 'usrdef_zgr', rpou,  'U', 1._wp, rpov  , 'V', 1._wp, kfillmode=jpfillcopy )
218      !     !
219      !     DO_2D_00_00
220      !            rpo (ji,jj,jk) = 0.2_wp * ( rpo (ji,jj,jk) + rpou(ji-1,jj  ,jk) + rpou(ji  ,jj  ,jk)   &
221      !               &                                       + rpov(ji  ,jj-1,jk) + rpov(ji  ,jj  ,jk)   )
222      !            rpof(ji,jj,jk) = 0.2_wp * ( rpof(ji,jj,jk) + rpou(ji  ,jj+1,jk) + rpou(ji  ,jj  ,jk)   &
223      !               &                                       + rpov(ji  ,jj  ,jk) + rpov(ji+1,jj  ,jk)   )
224      !        END_2D
225      !     CALL lbc_lnk_multi( 'usrdef_zgr', rpo ,  'T', 1._wp, rpof,  'F', 1._wp, kfillmode=jpfillcopy )
226      !   END DO
227      ! END DO
228      !
229      DO jl = 1, nn_cnp
230            DO jk = 1,jpkm1
231              DO_2D_00_00
232                IF ( glamt(ji,jj) > -100000._wp .AND. glamt(ji,jj) < 100000._wp ) THEN
233                     rpou(ji,jj,jk) = 0.2_wp * ( rpou(ji,jj,jk) + rpo (ji  ,jj  ,jk) + rpof(ji  ,jj  ,jk)   &
234                        &                                       + rpo (ji+1,jj  ,jk) + rpof(ji  ,jj-1,jk)   )
235                     rpov(ji,jj,jk) = 0.2_wp * ( rpov(ji,jj,jk) + rpo (ji  ,jj  ,jk) + rpof(ji  ,jj  ,jk)   &
236                        &                                       + rpo (ji  ,jj+1,jk) + rpof(ji-1,jj  ,jk)   )
237                ENDIF
238              END_2D
239              CALL lbc_lnk_multi( 'usrdef_zgr', rpou,  'U', 1._wp, rpov  , 'V', 1._wp, kfillmode=jpfillcopy )
240              !
241              DO_2D_00_00
242                 IF ( glamt(ji,jj) > -100000._wp .AND. glamt(ji,jj) < 100000._wp ) THEN
243                     rpo (ji,jj,jk) = 0.2_wp * ( rpo (ji,jj,jk) + rpou(ji-1,jj  ,jk) + rpou(ji  ,jj  ,jk)   &
244                        &                                       + rpov(ji  ,jj-1,jk) + rpov(ji  ,jj  ,jk)   )
245                     rpof(ji,jj,jk) = 0.2_wp * ( rpof(ji,jj,jk) + rpou(ji  ,jj+1,jk) + rpou(ji  ,jj  ,jk)   &
246                        &                                       + rpov(ji  ,jj  ,jk) + rpov(ji+1,jj  ,jk)   )
247                 ENDIF
248              END_2D
249              CALL lbc_lnk_multi( 'usrdef_zgr', rpo ,  'T', 1._wp, rpof,  'F', 1._wp, kfillmode=jpfillcopy )
250            END DO
251      END DO
252      !
253      ! masked mean, only unmasked cells are used in the mean
254      ! Ca marche pas
255      ! DO jl = 1, nn_cnp
256      !   DO jk = 1,jpkm1
257      !     DO_2D_00_00
258      !            znummask =   1._wp / (1._wp + umask(ji,jj,jk) * ( tmask (ji  ,jj  ,jk) + ssfmask(ji  ,jj  )       &
259      !               &                                           + tmask (ji+1,jj  ,jk) + ssfmask(ji  ,jj-1)   )   )
260      !            rpou(ji,jj,jk) =  znummask * ( rpou(ji  ,jj  ,jk)                           &
261      !               &                         + rpo (ji  ,jj  ,jk) *   tmask(ji  ,jj  ,jk) * umask(ji,jj,jk)   &
262      !               &                         + rpo (ji+1,jj  ,jk) *   tmask(ji+1,jj  ,jk) * umask(ji,jj,jk)   &
263      !               &                         + rpof(ji  ,jj  ,jk) * ssfmask(ji  ,jj     ) * umask(ji,jj,jk)   &
264      !               &                         + rpof(ji  ,jj-1,jk) * ssfmask(ji  ,jj-1   ) * umask(ji,jj,jk)   )
265      !             !
266      !             znummask = 1._wp / ( 1._wp + vmask(ji,jj,jk) * ( tmask (ji  ,jj  ,jk) + ssfmask(ji  ,jj)   &
267      !                &                                           + tmask (ji  ,jj+1,jk) + ssfmask(ji-1,jj)   )   )
268      !             rpov(ji,jj,jk) =  znummask * ( rpov(ji  ,jj  ,jk)    &
269      !                &                         + rpo (ji  ,jj  ,jk) *   tmask(ji  ,jj  ,jk) * vmask(ji,jj,jk)  &
270      !                &                         + rpo (ji  ,jj+1,jk) *   tmask(ji  ,jj+1,jk) * vmask(ji,jj,jk)  &
271      !                &                         + rpof(ji  ,jj  ,jk) * ssfmask(ji  ,jj     ) * vmask(ji,jj,jk)  &
272      !                &                         + rpof(ji-1,jj  ,jk) * ssfmask(ji-1,jj     ) * vmask(ji,jj,jk)  )
273      !             !
274      !        END_2D
275      !     CALL lbc_lnk_multi( 'usrdef_zgr', rpou,  'U', 1._wp, rpov  , 'V', 1._wp, kfillmode=jpfillcopy )
276      !     !
277      !     DO_2D_00_00
278      !     znummask = 1._wp / ( 1._wp + tmask(ji,jj,jk) * ( umask (ji-1,jj  ,jk) + umask(ji  ,jj  ,jk)   &
279      !        &                       + vmask (ji  ,jj-1,jk) + vmask(ji  ,jj  ,jk)   ) )
280      !     rpo(ji,jj,jk) =  znummask * ( rpo (ji  ,jj  ,jk)    &
281      !        &                        + rpou(ji  ,jj  ,jk) * umask(ji  ,jj  ,jk) * tmask(ji,jj,jk)  &
282      !        &                        + rpou(ji-1,jj  ,jk) * umask(ji-1,jj  ,jk) * tmask(ji,jj,jk)  &
283      !        &                        + rpov(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * tmask(ji,jj,jk)  &
284      !        &                        + rpov(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * tmask(ji,jj,jk)  )
285      !      !
286      !      znummask = 1._wp / ( 1._wp  + ssfmask(ji,jj) * ( umask (ji  ,jj+1,jk) + umask(ji  ,jj  ,jk)   &
287      !         &                                 + vmask (ji+1,jj  ,jk) + vmask(ji  ,jj  ,jk)   ) )
288      !      rpof(ji,jj,jk) =  znummask * ( rpof(ji  ,jj  ,jk)    &
289      !         &                         + rpou(ji  ,jj  ,jk) *   umask(ji  ,jj  ,jk) * ssfmask(ji,jj)  &
290      !         &                         + rpou(ji  ,jj+1,jk) *   umask(ji  ,jj+1,jk) * ssfmask(ji,jj)  &
291      !         &                         + rpov(ji  ,jj  ,jk) *   vmask(ji  ,jj  ,jk) * ssfmask(ji,jj)  &
292      !         &                         + rpov(ji+1,jj  ,jk) *   vmask(ji+1,jj  ,jk) * ssfmask(ji,jj)  )
293      !        END_2D
294      !     CALL lbc_lnk_multi( 'usrdef_zgr', rpo ,  'T', 1._wp, rpof,  'F', 1._wp, kfillmode=jpfillcopy )
295      !   END DO
296      ! END DO
297      !
298# endif
299
300      ! Interior domain mask  (used for global sum)
301      ! --------------------
302      !
303      iif = nn_hls   ;   iil = nlci - nn_hls + 1
304      ijf = nn_hls   ;   ijl = nlcj - nn_hls + 1
305      !
306      !                          ! halo mask : 0 on the halo and 1 elsewhere
307      tmask_h(:,:) = 1._wp
308      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns
309      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns)
310      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows
311      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
312      !
313      !                          ! north fold mask
314      tpol(1:jpiglo) = 1._wp
315      fpol(1:jpiglo) = 1._wp
316      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot
317         tpol(jpiglo/2+1:jpiglo) = 0._wp
318         fpol(     1    :jpiglo) = 0._wp
319         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row for tmask_h
320            DO ji = iif+1, iil-1
321               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji))
322            END DO
323         ENDIF
324      ENDIF
325      !
326      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
327         tpol(     1    :jpiglo) = 0._wp
328         fpol(jpiglo/2+1:jpiglo) = 0._wp
329      ENDIF
330      !
331      !                          ! interior mask : 2D ocean mask x halo mask
332      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:)
333
334
335      ! Lateral boundary conditions on velocity (modify fmask)
336      ! ---------------------------------------
337      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition
338         !
339         ALLOCATE( zwf(jpi,jpj) )
340         !
341         DO jk = 1, jpk
342            zwf(:,:) = fmask(:,:,jk)
343            DO_2D_00_00
344               IF( fmask(ji,jj,jk) == 0._wp ) THEN
345                  fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   &
346                     &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  )
347               ENDIF
348            END_2D
349            DO jj = 2, jpjm1
350               IF( fmask(1,jj,jk) == 0._wp ) THEN
351                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
352               ENDIF
353               IF( fmask(jpi,jj,jk) == 0._wp ) THEN
354                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
355               ENDIF
356            END DO
357            DO ji = 2, jpim1
358               IF( fmask(ji,1,jk) == 0._wp ) THEN
359                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
360               ENDIF
361               IF( fmask(ji,jpj,jk) == 0._wp ) THEN
362                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
363               ENDIF
364            END DO
365#if defined key_agrif
366            IF( .NOT. AGRIF_Root() ) THEN
367               IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(nlci-1 , :     ,jk) = 0.e0      ! east
368               IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1      , :     ,jk) = 0.e0      ! west
369               IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north
370               IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:      ,1      ,jk) = 0.e0      ! south
371            ENDIF
372#endif
373         END DO
374         !
375         DEALLOCATE( zwf )
376         !
377         CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
378         !
379         ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat
380         !
381      ENDIF
382
383      ! User defined alteration of fmask (use to reduce ocean transport in specified straits)
384      ! --------------------------------
385      !
386      CALL usr_def_fmask( cn_cfg, nn_cfg, fmask )
387      !
388   END SUBROUTINE dom_msk
389
390   !!======================================================================
391END MODULE dommsk
Note: See TracBrowser for help on using the repository browser.