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_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DOM – NEMO

source: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DOM/dommsk.F90 @ 14644

Last change on this file since 14644 was 14644, checked in by sparonuz, 3 years ago

Merge trunk -r14642:HEAD

  • Property svn:keywords set to Id
File size: 12.2 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
[13237]20   !!            4.x  ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio
[1566]21   !!----------------------------------------------------------------------
[3]22
23   !!----------------------------------------------------------------------
[7646]24   !!   dom_msk       : compute land/ocean mask
[3]25   !!----------------------------------------------------------------------
[7646]26   USE oce            ! ocean dynamics and tracers
27   USE dom_oce        ! ocean space and time domain
[13286]28   USE domutl         !
[7646]29   USE usrdef_fmask   ! user defined fmask
[9124]30   USE bdy_oce        ! open boundary
31   !
[7646]32   USE in_out_manager ! I/O manager
[9600]33   USE iom            ! IOM library
[7646]34   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
35   USE lib_mpp        ! Massively Parallel Processing library
[3]36
37   IMPLICIT NONE
38   PRIVATE
39
[6140]40   PUBLIC   dom_msk    ! routine called by inidom.F90
[3]41
[1601]42   !                            !!* Namelist namlbc : lateral boundary condition *
[4147]43   REAL(wp)        :: rn_shlat   ! type of lateral boundary condition on velocity
44   LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition
[3294]45   !                                            with analytical eqs.
[2715]46
[3]47   !! * Substitutions
[12377]48#  include "do_loop_substitute.h90"
[1566]49   !!----------------------------------------------------------------------
[9598]50   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[7753]51   !! $Id$
[10068]52   !! Software governed by the CeCILL license (see ./LICENSE)
[1566]53   !!----------------------------------------------------------------------
[3]54CONTAINS
[2715]55
[7646]56   SUBROUTINE dom_msk( k_top, k_bot )
[3]57      !!---------------------------------------------------------------------
58      !!                 ***  ROUTINE dom_msk  ***
59      !!
60      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
[6125]61      !!      zontal velocity points (u & v), vorticity points (f) points.
[3]62      !!
[7646]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) :
[1601]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
[3]74      !!
[7646]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.
[3]80      !!
[7646]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
[3]88      !!----------------------------------------------------------------------
[7646]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  ::   iktop, ikbot   !   -       -
93      INTEGER  ::   ios, inum
[1601]94      !!
[3294]95      NAMELIST/namlbc/ rn_shlat, ln_vorlat
[7646]96      NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file,         &
97         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
98         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &
99         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
[9657]100         &             cn_ice, nn_ice_dta,                                     &
[11536]101         &             ln_vol, nn_volctl, nn_rimwidth
[3]102      !!---------------------------------------------------------------------
[3294]103      !
[4147]104      READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 )
[11536]105901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlbc in reference namelist' )
[4147]106      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 )
[11536]107902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlbc in configuration namelist' )
[4624]108      IF(lwm) WRITE ( numond, namlbc )
[1566]109     
110      IF(lwp) THEN                  ! control print
[3]111         WRITE(numout,*)
112         WRITE(numout,*) 'dommsk : ocean mask '
113         WRITE(numout,*) '~~~~~~'
[1566]114         WRITE(numout,*) '   Namelist namlbc'
[3294]115         WRITE(numout,*) '      lateral momentum boundary cond.    rn_shlat  = ',rn_shlat
116         WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat 
[3]117      ENDIF
[9169]118      !
119      IF(lwp) WRITE(numout,*)
120      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  free-slip'
121      ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  no-slip'
122      ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  partial-slip'
123      ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  strong-slip'
[1601]124      ELSE
[9527]125         CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' )
[3]126      ENDIF
127
[7646]128      !  Ocean/land mask at t-point  (computed from ko_top and ko_bot)
129      ! ----------------------------
[1566]130      !
[7753]131      tmask(:,:,:) = 0._wp
[13305]132      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
[12377]133         iktop = k_top(ji,jj)
134         ikbot = k_bot(ji,jj)
135         IF( iktop /= 0 ) THEN       ! water in the column
[13286]136            tmask(ji,jj,iktop:ikbot) = 1._wp
[12377]137         ENDIF
138      END_2D
[11233]139      !
[13286]140      ! Mask corrections for bdy (read in mppini2)
[7646]141      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
[11536]142903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist' )
[7646]143      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
[11536]144904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist' )
[7646]145      ! ------------------------
146      IF ( ln_bdy .AND. ln_mask_file ) THEN
[9600]147         CALL iom_open( cn_mask_file, inum )
[13286]148         CALL iom_get ( inum, jpdom_global, 'bdy_msk', bdytmask(:,:) )
[9600]149         CALL iom_close( inum )
[13295]150         DO_3D( 1, 1, 1, 1, 1, jpkm1 )
[12377]151            tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj)
152         END_3D
[3]153      ENDIF
[7646]154         
155      !  Ocean/land mask at u-, v-, and f-points   (computed from tmask)
156      ! ----------------------------------------
157      ! NB: at this point, fmask is designed for free slip lateral boundary condition
[13295]158      DO_3D( 0, 0, 0, 0, 1, jpk )
[13286]159         umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)
160         vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk)
161         fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
162            &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
163      END_3D
[14644]164      CALL lbc_lnk( 'dommsk', umask, 'U', 1.0_wp, vmask, 'V', 1.0_wp, fmask, 'F', 1.0_wp )      ! Lateral boundary conditions
[7646]165 
166      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask)
167      !-----------------------------------------
[7753]168      wmask (:,:,1) = tmask(:,:,1)     ! surface
169      wumask(:,:,1) = umask(:,:,1)
170      wvmask(:,:,1) = vmask(:,:,1)
[5836]171      DO jk = 2, jpk                   ! interior values
[7753]172         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
173         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)   
174         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1)
[5120]175      END DO
[3]176
[7646]177      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical)
178      ! ----------------------------------------------
179      ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 )
180      ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 )
181      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 )
[13237]182      ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 )
[14053]183      IF( lk_SWE ) THEN      ! Shallow Water Eq. case : redefine ssfmask
[14644]184         DO_2D( 0,0, 0,0  )
[14053]185            ssfmask(ji,jj) = MAX(  ssmask(ji,jj+1), ssmask(ji+1,jj+1),  & 
186               &                   ssmask(ji,jj  ), ssmask(ji+1,jj  )   )
187         END_2D
188         CALL lbc_lnk( 'dommsk', ssfmask, 'F', 1.0_wp )
189      ENDIF
190#if defined key_qco
191      fe3mask(:,:,:) = fmask(:,:,:)
192#endif
[7646]193
194      ! Interior domain mask  (used for global sum)
195      ! --------------------
196      !
[13286]197      CALL dom_uniq( tmask_h, 'T' )
[7646]198      !
199      !                          ! interior mask : 2D ocean mask x halo mask
[7753]200      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:)
[7646]201
[3]202      ! Lateral boundary conditions on velocity (modify fmask)
[7646]203      ! --------------------------------------- 
204      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition
205         !
206         DO jk = 1, jpk
[13295]207            DO_2D( 0, 0, 0, 0 )
[12377]208               IF( fmask(ji,jj,jk) == 0._wp ) THEN
[13461]209                  fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), &
210                     &                                           vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) )
[12377]211               ENDIF
212            END_2D
[7646]213            DO jj = 2, jpjm1
214               IF( fmask(1,jj,jk) == 0._wp ) THEN
[13461]215                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(2,jj,jk), umask(1,jj+1,jk), umask(1,jj,jk) ) )
[3]216               ENDIF
[7646]217               IF( fmask(jpi,jj,jk) == 0._wp ) THEN
[13461]218                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(jpi,jj+1,jk), vmask(jpim1,jj,jk), umask(jpi,jj-1,jk) ) )
[7646]219               ENDIF
220            END DO         
221            DO ji = 2, jpim1
222               IF( fmask(ji,1,jk) == 0._wp ) THEN
[13461]223                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,1,jk), umask(ji,2,jk), vmask(ji,1,jk) ) )
[7646]224               ENDIF
225               IF( fmask(ji,jpj,jk) == 0._wp ) THEN
[13461]226                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,jk), vmask(ji-1,jpj,jk), umask(ji,jpjm1,jk) ) )
[7646]227               ENDIF
[3]228            END DO
229         END DO
[5836]230         !
[10425]231         CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
[3]232         !
[7646]233         ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat
[5506]234         !
[2528]235      ENDIF
[7646]236     
237      ! User defined alteration of fmask (use to reduce ocean transport in specified straits)
238      ! --------------------------------
[2528]239      !
[7646]240      CALL usr_def_fmask( cn_cfg, nn_cfg, fmask )
[6140]241      !
[3]242   END SUBROUTINE dom_msk
243   
244   !!======================================================================
245END MODULE dommsk
Note: See TracBrowser for help on using the repository browser.