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/UKMO/dev_r10037_GPU/src/OCE/DOM – NEMO

source: NEMO/branches/UKMO/dev_r10037_GPU/src/OCE/DOM/dommsk.F90 @ 10847

Last change on this file since 10847 was 10847, checked in by andmirek, 6 years ago

ticket #2197 merge dev_r10037_shlat2d: for use for ORCA1

File size: 15.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   USE iom             ! For shlat2d
35   USE fldread         ! for sn_shlat2d
36
37   IMPLICIT NONE
38   PRIVATE
39
40   PUBLIC   dom_msk    ! routine called by inidom.F90
41
42   !                            !!* Namelist namlbc : lateral boundary condition *
43   REAL(wp)        :: rn_shlat   ! type of lateral boundary condition on velocity
44   LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition
45   !                                            with analytical eqs.
46
47   !! * Substitutions
48#  include "vectopt_loop_substitute.h90"
49   !!----------------------------------------------------------------------
50   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
51   !! $Id$
52   !! Software governed by the CeCILL license (see ./LICENSE)
53   !!----------------------------------------------------------------------
54CONTAINS
55
56   SUBROUTINE dom_msk( k_top, k_bot )
57      !!---------------------------------------------------------------------
58      !!                 ***  ROUTINE dom_msk  ***
59      !!
60      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
61      !!      zontal velocity points (u & v), vorticity points (f) points.
62      !!
63      !! ** Method  :   The ocean/land mask  at t-point is deduced from ko_top
64      !!      and ko_bot, the indices of the fist and last ocean t-levels which
65      !!      are either defined in usrdef_zgr or read in zgr_read.
66      !!                The velocity masks (umask, vmask, wmask, wumask, wvmask)
67      !!      are deduced from a product of the two neighboring tmask.
68      !!                The vorticity mask (fmask) is deduced from tmask taking
69      !!      into account the choice of lateral boundary condition (rn_shlat) :
70      !!         rn_shlat = 0, free slip  (no shear along the coast)
71      !!         rn_shlat = 2, no slip  (specified zero velocity at the coast)
72      !!         0 < rn_shlat < 2, partial slip   | non-linear velocity profile
73      !!         2 < rn_shlat, strong slip        | in the lateral boundary layer
74      !!
75      !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated
76      !!                rows/lines due to cyclic or North Fold boundaries as well
77      !!                as MPP halos.
78      !!      tmask_h : halo mask at t-point, i.e. excluding duplicated rows/lines
79      !!                due to cyclic or North Fold boundaries as well as MPP halos.
80      !!
81      !! ** Action :   tmask, umask, vmask, wmask, wumask, wvmask : land/ocean mask
82      !!                         at t-, u-, v- w, wu-, and wv-points (=0. or 1.)
83      !!               fmask   : land/ocean mask at f-point (=0., or =1., or
84      !!                         =rn_shlat along lateral boundaries)
85      !!               tmask_i : interior ocean mask
86      !!               tmask_h : halo mask
87      !!               ssmask , ssumask, ssvmask, ssfmask : 2D ocean mask
88      !!----------------------------------------------------------------------
89      INTEGER, DIMENSION(:,:), INTENT(in) ::   k_top, k_bot   ! first and last ocean level
90      !
91      INTEGER  ::   ji, jj, jk     ! dummy loop indices
92      INTEGER  ::   iif, iil       ! local integers
93      INTEGER  ::   ijf, ijl       !   -       -
94      INTEGER  ::   iktop, ikbot   !   -       -
95      INTEGER  ::   ios, inum
96      !!
97      INTEGER  :: inum             !  logical unit for shlat2d
98      REAL(wp) :: zshlat           !: locally modified shlat for some strait
99      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zshlat2d
100      LOGICAL                         :: ln_shlat2d
101      CHARACTER(len = 256)            :: cn_shlat2d_file, cn_shlat2d_var 
102      !!
103      NAMELIST/namlbc/ rn_shlat, ln_vorlat, ln_shlat2d, cn_shlat2d_file, cn_shlat2d_var
104      NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file,         &
105         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
106         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &
107         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
108         &             cn_ice, nn_ice_dta,                                     &
109         &             rn_ice_tem, rn_ice_sal, rn_ice_age,                     &
110         &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy
111      !!---------------------------------------------------------------------
112      !
113      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition
114      READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 )
115901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlbc in reference namelist', lwp )
116      REWIND( numnam_cfg )              ! Namelist namlbc in configuration namelist : Lateral momentum boundary condition
117      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 )
118902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlbc in configuration namelist', lwp )
119      IF(lwm) WRITE ( numond, namlbc )
120     
121      IF(lwp) THEN                  ! control print
122         WRITE(numout,*)
123         WRITE(numout,*) 'dommsk : ocean mask '
124         WRITE(numout,*) '~~~~~~'
125         WRITE(numout,*) '   Namelist namlbc'
126         WRITE(numout,*) '      lateral momentum boundary cond.    rn_shlat  = ',rn_shlat
127         WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat 
128      ENDIF
129      !
130      IF(lwp) WRITE(numout,*)
131      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  free-slip'
132      ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  no-slip'
133      ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  partial-slip'
134      ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  strong-slip'
135      ELSE
136         CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' )
137      ENDIF
138
139      IF ( ln_shlat2d ) THEN
140         IF(lwp) WRITE(numout,*) '         READ shlat as a 2D coefficient in a file '
141         ALLOCATE( zshlat2d(jpi,jpj) )
142         CALL iom_open(TRIM(cn_shlat2d_file), inum)
143         CALL iom_get (inum, jpdom_data, TRIM(cn_shlat2d_var), zshlat2d, 1) !
144         CALL iom_close(inum)
145      ENDIF
146
147      !  Ocean/land mask at t-point  (computed from ko_top and ko_bot)
148      ! ----------------------------
149      !
150      tmask(:,:,:) = 0._wp
151      DO jj = 1, jpj
152         DO ji = 1, jpi
153            iktop = k_top(ji,jj)
154            ikbot = k_bot(ji,jj)
155            IF( iktop /= 0 ) THEN       ! water in the column
156               tmask(ji,jj,iktop:ikbot  ) = 1._wp
157            ENDIF
158         END DO 
159      END DO 
160!SF  add here lbc_lnk: bug not still understood : cause now domain configuration is read !
161!!gm I don't understand why... 
162      CALL lbc_lnk( tmask  , 'T', 1._wp )      ! Lateral boundary conditions
163
164     ! Mask corrections for bdy (read in mppini2)
165      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries
166      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
167903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp )
168      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries
169      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
170904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp )
171      ! ------------------------
172      IF ( ln_bdy .AND. ln_mask_file ) THEN
173         CALL iom_open( cn_mask_file, inum )
174         CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) )
175         CALL iom_close( inum )
176         DO jk = 1, jpkm1
177            DO jj = 1, jpj
178               DO ji = 1, jpi
179                  tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj)
180               END DO
181            END DO
182         END DO
183      ENDIF
184         
185      !  Ocean/land mask at u-, v-, and f-points   (computed from tmask)
186      ! ----------------------------------------
187      ! NB: at this point, fmask is designed for free slip lateral boundary condition
188      DO jk = 1, jpk
189         DO jj = 1, jpjm1
190            DO ji = 1, fs_jpim1   ! vector loop
191               umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)
192               vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk)
193            END DO
194            DO ji = 1, jpim1      ! NO vector opt.
195               fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
196                  &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
197            END DO
198         END DO
199      END DO
200      CALL lbc_lnk_multi( umask, 'U', 1., vmask, 'V', 1., fmask, 'F', 1. )      ! Lateral boundary conditions
201 
202      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask)
203      !-----------------------------------------
204      wmask (:,:,1) = tmask(:,:,1)     ! surface
205      wumask(:,:,1) = umask(:,:,1)
206      wvmask(:,:,1) = vmask(:,:,1)
207      DO jk = 2, jpk                   ! interior values
208         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
209         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)   
210         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1)
211      END DO
212
213
214      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical)
215      ! ----------------------------------------------
216      ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 )
217      ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 )
218      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 )
219
220
221      ! Interior domain mask  (used for global sum)
222      ! --------------------
223      !
224      iif = nn_hls   ;   iil = nlci - nn_hls + 1
225      ijf = nn_hls   ;   ijl = nlcj - nn_hls + 1
226      !
227      !                          ! halo mask : 0 on the halo and 1 elsewhere
228      tmask_h(:,:) = 1._wp                 
229      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns
230      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns)
231      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows
232      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
233      !
234      !                          ! north fold mask
235      tpol(1:jpiglo) = 1._wp 
236      fpol(1:jpiglo) = 1._wp
237      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot
238         tpol(jpiglo/2+1:jpiglo) = 0._wp
239         fpol(     1    :jpiglo) = 0._wp
240         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row for tmask_h
241            DO ji = iif+1, iil-1
242               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji))
243            END DO
244         ENDIF
245      ENDIF
246      !
247      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
248         tpol(     1    :jpiglo) = 0._wp
249         fpol(jpiglo/2+1:jpiglo) = 0._wp
250      ENDIF
251      !
252      !                          ! interior mask : 2D ocean mask x halo mask
253      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:)
254
255
256      ! Lateral boundary conditions on velocity (modify fmask)
257      ! --------------------------------------- 
258      IF( rn_shlat /= 0 .or. ln_shlat2d ) THEN      ! Not free-slip lateral boundary condition everywhere
259         !
260         DO jk = 1, jpk
261            IF (  ln_shlat2d ) THEN
262               DO jj = 2, jpjm1
263                  DO ji = fs_2, fs_jpim1   ! vector opt.
264                     IF( fmask(ji,jj,jk) == 0._wp ) THEN
265                        fmask(ji,jj,jk) = zshlat2d(ji,jj) * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk),   &
266                           &                                                  vmask(ji,jj,jk), vmask(ji+1,jj,jk)  )  )
267                     ENDIF
268                  END DO
269               END DO
270            ELSE
271               DO jj = 2, jpjm1
272                  DO ji = fs_2, fs_jpim1   ! vector opt.
273                     IF( fmask(ji,jj,jk) == 0._wp ) THEN
274                        fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk),   &
275                           &                                           vmask(ji,jj,jk), vmask(ji+1,jj,jk)   )  )
276                     ENDIF
277                  END DO
278               END DO
279            ENDIF
280            DO jj = 2, jpjm1
281               IF( fmask(1,jj,jk) == 0._wp ) THEN
282                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(2,jj,jk), umask(1,jj+1,jk), umask(1,jj,jk) ) )
283               ENDIF
284               IF( fmask(jpi,jj,jk) == 0._wp ) THEN
285                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(jpi,jj+1,jk), vmask(jpim1,jj,jk), umask(jpi,jj-1,jk) ) )
286               ENDIF
287            END DO         
288            DO ji = 2, jpim1
289               IF( fmask(ji,1,jk) == 0._wp ) THEN
290                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,1,jk), umask(ji,2,jk), vmask(ji,1,jk) ) )
291               ENDIF
292               IF( fmask(ji,jpj,jk) == 0._wp ) THEN
293                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,jk), vmask(ji-1,jpj,jk), umask(ji,jpjm1,jk) ) )
294               ENDIF
295            END DO
296#if defined key_agrif 
297            IF( .NOT. AGRIF_Root() ) THEN
298               IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(nlci-1 , :     ,jk) = 0.e0      ! east
299               IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1      , :     ,jk) = 0.e0      ! west
300               IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north
301               IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:      ,1      ,jk) = 0.e0      ! south
302            ENDIF 
303#endif
304         END DO
305         !
306         IF( ln_shlat2d ) DEALLOCATE( zshlat2d )
307         !
308         CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
309         !
310         ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat
311         !
312      ENDIF
313     
314      ! User defined alteration of fmask (use to reduce ocean transport in specified straits)
315      ! --------------------------------
316      !
317      CALL usr_def_fmask( cn_cfg, nn_cfg, fmask )
318      !
319   END SUBROUTINE dom_msk
320   
321   !!======================================================================
322END MODULE dommsk
Note: See TracBrowser for help on using the repository browser.