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/releases/r4.0/r4.0-HEAD/src/OCE/DOM – NEMO

source: NEMO/releases/r4.0/r4.0-HEAD/src/OCE/DOM/dommsk.F90 @ 12737

Last change on this file since 12737 was 12737, checked in by jchanut, 4 years ago

Fixes AGRIF reproductibility with land processors removal, i.e. #2240. Trunk is not concerned by this problem since nbondi/nbondj variables are not used anymore.

  • Property svn:keywords set to Id
File size: 14.5 KB
RevLine 
[3]1MODULE dommsk
[1566]2   !!======================================================================
[3]3   !!                       ***  MODULE dommsk   ***
4   !! Ocean initialization : domain land/sea mask
[1566]5   !!======================================================================
6   !! History :  OPA  ! 1987-07  (G. Madec)  Original code
[2528]7   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon)
8   !!            7.0  ! 1996-01  (G. Madec)  suppression of common work arrays
[6140]9   !!             -   ! 1996-05  (G. Madec)  mask computed from tmask
[2528]10   !!            8.0  ! 1997-02  (G. Madec)  mesh information put in domhgr.F
[7646]11   !!            8.1  ! 1997-07  (G. Madec)  modification of kbat and fmask
[1566]12   !!             -   ! 1998-05  (G. Roullet)  free surface
[2528]13   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
[1566]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
[5836]18   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask
[7646]19   !!            4.0  ! 2016-06  (G. Madec, S. Flavoni)  domain configuration / user defined interface
[1566]20   !!----------------------------------------------------------------------
[3]21
22   !!----------------------------------------------------------------------
[7646]23   !!   dom_msk       : compute land/ocean mask
[3]24   !!----------------------------------------------------------------------
[7646]25   USE oce            ! ocean dynamics and tracers
26   USE dom_oce        ! ocean space and time domain
27   USE usrdef_fmask   ! user defined fmask
[9124]28   USE bdy_oce        ! open boundary
29   !
[7646]30   USE in_out_manager ! I/O manager
[9600]31   USE iom            ! IOM library
[7646]32   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
33   USE lib_mpp        ! Massively Parallel Processing library
[3]34
35   IMPLICIT NONE
36   PRIVATE
37
[6140]38   PUBLIC   dom_msk    ! routine called by inidom.F90
[3]39
[1601]40   !                            !!* Namelist namlbc : lateral boundary condition *
[4147]41   REAL(wp)        :: rn_shlat   ! type of lateral boundary condition on velocity
42   LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition
[3294]43   !                                            with analytical eqs.
[2715]44
[3]45   !! * Substitutions
46#  include "vectopt_loop_substitute.h90"
[1566]47   !!----------------------------------------------------------------------
[9598]48   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[7753]49   !! $Id$
[10068]50   !! Software governed by the CeCILL license (see ./LICENSE)
[1566]51   !!----------------------------------------------------------------------
[3]52CONTAINS
[2715]53
[7646]54   SUBROUTINE dom_msk( k_top, k_bot )
[3]55      !!---------------------------------------------------------------------
56      !!                 ***  ROUTINE dom_msk  ***
57      !!
58      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
[6125]59      !!      zontal velocity points (u & v), vorticity points (f) points.
[3]60      !!
[7646]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) :
[1601]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
[3]72      !!
[7646]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.
[3]78      !!
[7646]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
[3]86      !!----------------------------------------------------------------------
[7646]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
[9019]94      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwf   ! 2D workspace
[1601]95      !!
[3294]96      NAMELIST/namlbc/ rn_shlat, ln_vorlat
[7646]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, &
[9657]101         &             cn_ice, nn_ice_dta,                                     &
[11536]102         &             ln_vol, nn_volctl, nn_rimwidth
[3]103      !!---------------------------------------------------------------------
[3294]104      !
[4147]105      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition
106      READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 )
[11536]107901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlbc in reference namelist' )
[4147]108      REWIND( numnam_cfg )              ! Namelist namlbc in configuration namelist : Lateral momentum boundary condition
109      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 )
[11536]110902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlbc in configuration namelist' )
[4624]111      IF(lwm) WRITE ( numond, namlbc )
[1566]112     
113      IF(lwp) THEN                  ! control print
[3]114         WRITE(numout,*)
115         WRITE(numout,*) 'dommsk : ocean mask '
116         WRITE(numout,*) '~~~~~~'
[1566]117         WRITE(numout,*) '   Namelist namlbc'
[3294]118         WRITE(numout,*) '      lateral momentum boundary cond.    rn_shlat  = ',rn_shlat
119         WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat 
[3]120      ENDIF
[9169]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'
[1601]127      ELSE
[9527]128         CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' )
[3]129      ENDIF
130
[7646]131      !  Ocean/land mask at t-point  (computed from ko_top and ko_bot)
132      ! ----------------------------
[1566]133      !
[7753]134      tmask(:,:,:) = 0._wp
[7646]135      DO jj = 1, jpj
136         DO ji = 1, jpi
137            iktop = k_top(ji,jj)
138            ikbot = k_bot(ji,jj)
139            IF( iktop /= 0 ) THEN       ! water in the column
140               tmask(ji,jj,iktop:ikbot  ) = 1._wp
141            ENDIF
[3]142         END DO 
[11233]143      END DO
144      !
145      ! the following call is mandatory
146      ! it masks boundaries (bathy=0) where needed depending on the configuration (closed, periodic...) 
[10425]147      CALL lbc_lnk( 'dommsk', tmask  , 'T', 1._wp )      ! Lateral boundary conditions
[3]148
[7646]149     ! Mask corrections for bdy (read in mppini2)
150      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries
151      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
[11536]152903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist' )
[7646]153      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries
154      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
[11536]155904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist' )
[7646]156      ! ------------------------
157      IF ( ln_bdy .AND. ln_mask_file ) THEN
[9600]158         CALL iom_open( cn_mask_file, inum )
159         CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) )
160         CALL iom_close( inum )
[7646]161         DO jk = 1, jpkm1
162            DO jj = 1, jpj
163               DO ji = 1, jpi
164                  tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj)
165               END DO
[291]166            END DO
[7646]167         END DO
[3]168      ENDIF
[7646]169         
170      !  Ocean/land mask at u-, v-, and f-points   (computed from tmask)
171      ! ----------------------------------------
172      ! NB: at this point, fmask is designed for free slip lateral boundary condition
[3]173      DO jk = 1, jpk
174         DO jj = 1, jpjm1
175            DO ji = 1, fs_jpim1   ! vector loop
176               umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)
177               vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk)
[1271]178            END DO
[1694]179            DO ji = 1, jpim1      ! NO vector opt.
[3]180               fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
[62]181                  &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
[3]182            END DO
183         END DO
184      END DO
[10425]185      CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1., vmask, 'V', 1., fmask, 'F', 1. )      ! Lateral boundary conditions
[7646]186 
187      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask)
188      !-----------------------------------------
[7753]189      wmask (:,:,1) = tmask(:,:,1)     ! surface
190      wumask(:,:,1) = umask(:,:,1)
191      wvmask(:,:,1) = vmask(:,:,1)
[5836]192      DO jk = 2, jpk                   ! interior values
[7753]193         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
194         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)   
195         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1)
[5120]196      END DO
[3]197
[7646]198
199      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical)
200      ! ----------------------------------------------
201      ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 )
202      ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 )
203      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 )
204
205
206      ! Interior domain mask  (used for global sum)
207      ! --------------------
208      !
[9019]209      iif = nn_hls   ;   iil = nlci - nn_hls + 1
210      ijf = nn_hls   ;   ijl = nlcj - nn_hls + 1
[7646]211      !
212      !                          ! halo mask : 0 on the halo and 1 elsewhere
[7753]213      tmask_h(:,:) = 1._wp                 
[7646]214      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns
215      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns)
216      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows
217      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
218      !
219      !                          ! north fold mask
220      tpol(1:jpiglo) = 1._wp 
221      fpol(1:jpiglo) = 1._wp
222      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot
223         tpol(jpiglo/2+1:jpiglo) = 0._wp
224         fpol(     1    :jpiglo) = 0._wp
225         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row for tmask_h
226            DO ji = iif+1, iil-1
227               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji))
228            END DO
229         ENDIF
230      ENDIF
231      !
232      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
233         tpol(     1    :jpiglo) = 0._wp
234         fpol(jpiglo/2+1:jpiglo) = 0._wp
235      ENDIF
236      !
237      !                          ! interior mask : 2D ocean mask x halo mask
[7753]238      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:)
[7646]239
240
[3]241      ! Lateral boundary conditions on velocity (modify fmask)
[7646]242      ! --------------------------------------- 
243      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition
244         !
[9019]245         ALLOCATE( zwf(jpi,jpj) )
[7646]246         !
247         DO jk = 1, jpk
[7753]248            zwf(:,:) = fmask(:,:,jk)         
[7646]249            DO jj = 2, jpjm1
250               DO ji = fs_2, fs_jpim1   ! vector opt.
251                  IF( fmask(ji,jj,jk) == 0._wp ) THEN
252                     fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   &
253                        &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  )
254                  ENDIF
255               END DO
256            END DO
257            DO jj = 2, jpjm1
258               IF( fmask(1,jj,jk) == 0._wp ) THEN
259                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
[3]260               ENDIF
[7646]261               IF( fmask(jpi,jj,jk) == 0._wp ) THEN
262                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
263               ENDIF
264            END DO         
265            DO ji = 2, jpim1
266               IF( fmask(ji,1,jk) == 0._wp ) THEN
267                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
268               ENDIF
269               IF( fmask(ji,jpj,jk) == 0._wp ) THEN
270                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
271               ENDIF
[3]272            END DO
[9023]273#if defined key_agrif 
[9090]274            IF( .NOT. AGRIF_Root() ) THEN
[12737]275               IF ( l_Eastedge )  fmask(nlci-1 , :     ,jk) = 0.e0      ! east
276               IF ( l_Westedge )  fmask(1      , :     ,jk) = 0.e0      ! west
277               IF ( l_Northedge ) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north
278               IF ( l_Southedge ) fmask(:      ,1      ,jk) = 0.e0      ! south
[9090]279            ENDIF 
[9023]280#endif
[3]281         END DO
[5836]282         !
[9019]283         DEALLOCATE( zwf )
[5836]284         !
[10425]285         CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
[3]286         !
[7646]287         ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat
[5506]288         !
[2528]289      ENDIF
[7646]290     
291      ! User defined alteration of fmask (use to reduce ocean transport in specified straits)
292      ! --------------------------------
[2528]293      !
[7646]294      CALL usr_def_fmask( cn_cfg, nn_cfg, fmask )
[6140]295      !
[3]296   END SUBROUTINE dom_msk
297   
298   !!======================================================================
299END MODULE dommsk
Note: See TracBrowser for help on using the repository browser.