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.
domzgr.F90 in NEMO/branches/2019/ENHANCE-03_closea/src/OCE/DOM – NEMO

source: NEMO/branches/2019/ENHANCE-03_closea/src/OCE/DOM/domzgr.F90 @ 11207

Last change on this file since 11207 was 11207, checked in by mathiot, 5 years ago

ENHANCE-03_closea: closea correction change to match new closea mask in domain_cfg (ticket #2143)

  • Property svn:keywords set to Id
File size: 18.6 KB
RevLine 
[3]1MODULE domzgr
2   !!==============================================================================
3   !!                       ***  MODULE domzgr   ***
[6140]4   !! Ocean domain : definition of the vertical coordinate system
[3]5   !!==============================================================================
[1566]6   !! History :  OPA  ! 1995-12  (G. Madec)  Original code : s vertical coordinate
7   !!                 ! 1997-07  (G. Madec)  lbc_lnk call
8   !!                 ! 1997-04  (J.-O. Beismann)
[2528]9   !!            8.5  ! 2002-09  (A. Bozec, G. Madec)  F90: Free form and module
10   !!             -   ! 2002-09  (A. de Miranda)  rigid-lid + islands
[1566]11   !!  NEMO      1.0  ! 2003-08  (G. Madec)  F90: Free form and module
12   !!             -   ! 2005-10  (A. Beckmann)  modifications for hybrid s-ccordinates & new stretching function
13   !!            2.0  ! 2006-04  (R. Benshila, G. Madec)  add zgr_zco
14   !!            3.0  ! 2008-06  (G. Madec)  insertion of domzgr_zps.h90 & conding style
15   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
[2528]16   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
[3680]17   !!            3.4  ! 2012-08  (J. Siddorn) added Siddorn and Furner stretching function
[3764]18   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  modify C1D case 
[5120]19   !!            3.6  ! 2014-11  (P. Mathiot and C. Harris) add ice shelf capabilitye 
[6152]20   !!            3.?  ! 2015-11  (H. Liu) Modifications for Wetting/Drying
[1099]21   !!----------------------------------------------------------------------
[3]22
23   !!----------------------------------------------------------------------
[7646]24   !!   dom_zgr       : read or set the ocean vertical coordinate system
25   !!   zgr_read      : read the vertical information in the domain configuration file
26   !!   zgr_top_bot   : ocean top and bottom level for t-, u, and v-points with 1 as minimum value
[3]27   !!---------------------------------------------------------------------
[7646]28   USE oce            ! ocean variables
29   USE dom_oce        ! ocean domain
30   USE usrdef_zgr     ! user defined vertical coordinate system
[9161]31   USE closea         ! closed seas
[7646]32   USE depth_e3       ! depth <=> e3
[9023]33   USE wet_dry,   ONLY: ll_wd, ssh_ref  ! Wetting and drying
[6140]34   !
[7646]35   USE in_out_manager ! I/O manager
36   USE iom            ! I/O library
37   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
38   USE lib_mpp        ! distributed memory computing library
[3]39
40   IMPLICIT NONE
41   PRIVATE
42
[2715]43   PUBLIC   dom_zgr        ! called by dom_init.F90
[3]44
[2715]45  !! * Substitutions
[3]46#  include "vectopt_loop_substitute.h90"
47   !!----------------------------------------------------------------------
[9598]48   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[1146]49   !! $Id$
[10068]50   !! Software governed by the CeCILL license (see ./LICENSE)
[3]51   !!----------------------------------------------------------------------
52CONTAINS       
53
[7646]54   SUBROUTINE dom_zgr( k_top, k_bot )
[3]55      !!----------------------------------------------------------------------
56      !!                ***  ROUTINE dom_zgr  ***
57      !!                   
[3764]58      !! ** Purpose :   set the depth of model levels and the resulting
59      !!              vertical scale factors.
[3]60      !!
[4292]61      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d)
[1099]62      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
63      !!              - vertical coordinate (gdep., e3.) depending on the
64      !!                coordinate chosen :
[2528]65      !!                   ln_zco=T   z-coordinate   
[1099]66      !!                   ln_zps=T   z-coordinate with partial steps
67      !!                   ln_zco=T   s-coordinate
[3]68      !!
[1099]69      !! ** Action  :   define gdep., e3., mbathy and bathy
70      !!----------------------------------------------------------------------
[7646]71      INTEGER, DIMENSION(:,:), INTENT(out) ::   k_top, k_bot   ! ocean first and last level indices
[2528]72      !
[7753]73      INTEGER  ::   jk                  ! dummy loop index
[7646]74      INTEGER  ::   ioptio, ibat, ios   ! local integer
75      REAL(wp) ::   zrefdep             ! depth of the reference level (~10m)
[3]76      !!----------------------------------------------------------------------
[3294]77      !
[7646]78      IF(lwp) THEN                     ! Control print
79         WRITE(numout,*)
80         WRITE(numout,*) 'dom_zgr : vertical coordinate'
81         WRITE(numout,*) '~~~~~~~'
82      ENDIF
[454]83
[7646]84      IF( ln_linssh .AND. lwp) WRITE(numout,*) '   linear free surface: the vertical mesh does not change in time'
[4147]85
[7646]86
87      IF( ln_read_cfg ) THEN        !==  read in mesh_mask.nc file  ==!
88         IF(lwp) WRITE(numout,*)
[9169]89         IF(lwp) WRITE(numout,*) '   ==>>>   Read vertical mesh in ', TRIM( cn_domcfg ), ' file'
[7646]90         !
91         CALL zgr_read   ( ln_zco  , ln_zps  , ln_sco, ln_isfcav,   & 
92            &              gdept_1d, gdepw_1d, e3t_1d, e3w_1d   ,   &    ! 1D gridpoints depth
93            &              gdept_0 , gdepw_0                    ,   &    ! gridpoints depth
94            &              e3t_0   , e3u_0   , e3v_0 , e3f_0    ,   &    ! vertical scale factors
95            &              e3w_0   , e3uw_0  , e3vw_0           ,   &    ! vertical scale factors
96            &              k_top   , k_bot            )                  ! 1st & last ocean level
[9198]97            !
[7646]98      ELSE                          !==  User defined configuration  ==!
99         IF(lwp) WRITE(numout,*)
100         IF(lwp) WRITE(numout,*) '          User defined vertical mesh (usr_def_zgr)'
101         !
102         CALL usr_def_zgr( ln_zco  , ln_zps  , ln_sco, ln_isfcav,   & 
103            &              gdept_1d, gdepw_1d, e3t_1d, e3w_1d   ,   &    ! 1D gridpoints depth
104            &              gdept_0 , gdepw_0                    ,   &    ! gridpoints depth
105            &              e3t_0   , e3u_0   , e3v_0 , e3f_0    ,   &    ! vertical scale factors
106            &              e3w_0   , e3uw_0  , e3vw_0           ,   &    ! vertical scale factors
107            &              k_top   , k_bot            )                  ! 1st & last ocean level
108         !
109      ENDIF
110      !
111!!gm to be remove when removing the OLD definition of e3 scale factors so that gde3w disappears
112      ! Compute gde3w_0 (vertical sum of e3w)
[7753]113      gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1)
[7646]114      DO jk = 2, jpk
[7753]115         gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk)
[7646]116      END DO
117      !
[9209]118      ! Any closed seas (defined by closea_mask > 0 in domain_cfg file) to be filled
119      ! in at runtime if ln_closea=.false.
[11207]120      IF( ln_closea ) THEN
121         IF ( ln_maskcs ) THEN
122            ! mask all the closed sea
123            CALL clo_bat( k_top, k_bot, mask_opnsea, 'mask_opensea' )
124         ELSE IF ( ln_mask_csundef ) THEN
125            ! defined closed sea are kept
126            ! mask all the undefined closed sea
127            CALL clo_bat( k_top, k_bot, mask_csundef, 'mask_csundef' )
128         END IF
129      END IF
[9209]130      !
[1099]131      IF(lwp) THEN                     ! Control print
[454]132         WRITE(numout,*)
[7646]133         WRITE(numout,*) '   Type of vertical coordinate (read in ', TRIM( cn_domcfg ), ' file or set in userdef_nam) :'
[6140]134         WRITE(numout,*) '      z-coordinate - full steps      ln_zco    = ', ln_zco
135         WRITE(numout,*) '      z-coordinate - partial steps   ln_zps    = ', ln_zps
136         WRITE(numout,*) '      s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
137         WRITE(numout,*) '      ice shelf cavities             ln_isfcav = ', ln_isfcav
[454]138      ENDIF
139
[1099]140      ioptio = 0                       ! Check Vertical coordinate options
[3764]141      IF( ln_zco      )   ioptio = ioptio + 1
142      IF( ln_zps      )   ioptio = ioptio + 1
143      IF( ln_sco      )   ioptio = ioptio + 1
[2528]144      IF( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
[7646]145
146
147      !                                ! top/bottom ocean level indices for t-, u- and v-points (f-point also for top)
148      CALL zgr_top_bot( k_top, k_bot )      ! with a minimum value set to 1
149     
150
151      !                                ! deepest/shallowest W level Above/Below ~10m
152!!gm BUG in s-coordinate this does not work!
153      zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_1d )                   ! ref. depth with tolerance (10% of minimum layer thickness)
154      nlb10 = MINLOC( gdepw_1d, mask = gdepw_1d > zrefdep, dim = 1 ) ! shallowest W level Below ~10m
155      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m
156!!gm end bug
[2528]157      !
[1348]158      IF( nprint == 1 .AND. lwp )   THEN
[7646]159         WRITE(numout,*) ' MIN val k_top   ', MINVAL(   k_top(:,:) ), ' MAX ', MAXVAL( k_top(:,:) )
160         WRITE(numout,*) ' MIN val k_bot   ', MINVAL(   k_bot(:,:) ), ' MAX ', MAXVAL( k_bot(:,:) )
[4292]161         WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   &
[6140]162            &                          ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde3w_0(:,:,:) )
163         WRITE(numout,*) ' MIN val e3    t ', MINVAL(   e3t_0(:,:,:) ), ' f ', MINVAL(   e3f_0(:,:,:) ),  &
164            &                          ' u ', MINVAL(   e3u_0(:,:,:) ), ' u ', MINVAL(   e3v_0(:,:,:) ),  &
165            &                          ' uw', MINVAL(  e3uw_0(:,:,:) ), ' vw', MINVAL(  e3vw_0(:,:,:)),   &
166            &                          ' w ', MINVAL(   e3w_0(:,:,:) )
[1348]167
[4292]168         WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   &
[6140]169            &                          ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gde3w_0(:,:,:) )
170         WRITE(numout,*) ' MAX val e3    t ', MAXVAL(   e3t_0(:,:,:) ), ' f ', MAXVAL(   e3f_0(:,:,:) ),  &
171            &                          ' u ', MAXVAL(   e3u_0(:,:,:) ), ' u ', MAXVAL(   e3v_0(:,:,:) ),  &
172            &                          ' uw', MAXVAL(  e3uw_0(:,:,:) ), ' vw', MAXVAL(  e3vw_0(:,:,:) ),  &
173            &                          ' w ', MAXVAL(   e3w_0(:,:,:) )
[1348]174      ENDIF
[2528]175      !
[3]176   END SUBROUTINE dom_zgr
177
178
[7646]179   SUBROUTINE zgr_read( ld_zco  , ld_zps  , ld_sco  , ld_isfcav,   &   ! type of vertical coordinate
180      &                 pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d  ,   &   ! 1D reference vertical coordinate
181      &                 pdept , pdepw ,                            &   ! 3D t & w-points depth
182      &                 pe3t  , pe3u  , pe3v   , pe3f ,            &   ! vertical scale factors
183      &                 pe3w  , pe3uw , pe3vw         ,            &   !     -      -      -
184      &                 k_top  , k_bot    )                            ! top & bottom ocean level
185      !!---------------------------------------------------------------------
186      !!              ***  ROUTINE zgr_read  ***
[3]187      !!
[7646]188      !! ** Purpose :   Read the vertical information in the domain configuration file
[3]189      !!
190      !!----------------------------------------------------------------------
[7646]191      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags
192      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag
193      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth       [m]
194      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D vertical scale factors [m]
195      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth          [m]
196      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors    [m]
197      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         !    -       -      -
198      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top , k_bot               ! first & last ocean level
199      !
[7753]200      INTEGER  ::   jk     ! dummy loop index
[7646]201      INTEGER  ::   inum   ! local logical unit
202      REAL(WP) ::   z_zco, z_zps, z_sco, z_cav
203      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace
[3]204      !!----------------------------------------------------------------------
[3294]205      !
[7646]206      IF(lwp) THEN
[3]207         WRITE(numout,*)
[7646]208         WRITE(numout,*) '   zgr_read : read the vertical coordinates in ', TRIM( cn_domcfg ), ' file'
209         WRITE(numout,*) '   ~~~~~~~~'
[3]210      ENDIF
[1099]211      !
[7646]212      CALL iom_open( cn_domcfg, inum )
[3294]213      !
[7646]214      !                          !* type of vertical coordinate
215      CALL iom_get( inum, 'ln_zco'   , z_zco )
216      CALL iom_get( inum, 'ln_zps'   , z_zps )
217      CALL iom_get( inum, 'ln_sco'   , z_sco )
218      IF( z_zco == 0._wp ) THEN   ;   ld_zco = .false.   ;   ELSE   ;   ld_zco = .true.   ;   ENDIF
219      IF( z_zps == 0._wp ) THEN   ;   ld_zps = .false.   ;   ELSE   ;   ld_zps = .true.   ;   ENDIF
220      IF( z_sco == 0._wp ) THEN   ;   ld_sco = .false.   ;   ELSE   ;   ld_sco = .true.   ;   ENDIF
[3294]221      !
[7646]222      !                          !* ocean cavities under iceshelves
223      CALL iom_get( inum, 'ln_isfcav', z_cav )
224      IF( z_cav == 0._wp ) THEN   ;   ld_isfcav = .false.   ;   ELSE   ;   ld_isfcav = .true.   ;   ENDIF
[3294]225      !
[7646]226      !                          !* vertical scale factors
227      CALL iom_get( inum, jpdom_unknown, 'e3t_1d'  , pe3t_1d  )                     ! 1D reference coordinate
228      CALL iom_get( inum, jpdom_unknown, 'e3w_1d'  , pe3w_1d  )
[1099]229      !
[7646]230      CALL iom_get( inum, jpdom_data, 'e3t_0'  , pe3t  , lrowattr=ln_use_jattr )    ! 3D coordinate
231      CALL iom_get( inum, jpdom_data, 'e3u_0'  , pe3u  , lrowattr=ln_use_jattr )
232      CALL iom_get( inum, jpdom_data, 'e3v_0'  , pe3v  , lrowattr=ln_use_jattr )
233      CALL iom_get( inum, jpdom_data, 'e3f_0'  , pe3f  , lrowattr=ln_use_jattr )
234      CALL iom_get( inum, jpdom_data, 'e3w_0'  , pe3w  , lrowattr=ln_use_jattr )
235      CALL iom_get( inum, jpdom_data, 'e3uw_0' , pe3uw , lrowattr=ln_use_jattr )
236      CALL iom_get( inum, jpdom_data, 'e3vw_0' , pe3vw , lrowattr=ln_use_jattr )
[2528]237      !
[7646]238      !                          !* depths
239      !                                   !- old depth definition (obsolescent feature)
240      IF(  iom_varid( inum, 'gdept_1d', ldstop = .FALSE. ) > 0  .AND.  &
241         & iom_varid( inum, 'gdepw_1d', ldstop = .FALSE. ) > 0  .AND.  &
242         & iom_varid( inum, 'gdept_0' , ldstop = .FALSE. ) > 0  .AND.  &
243         & iom_varid( inum, 'gdepw_0' , ldstop = .FALSE. ) > 0    ) THEN
244         CALL ctl_warn( 'zgr_read : old definition of depths and scale factors used ', & 
245            &           '           depths at t- and w-points read in the domain configuration file')
246         CALL iom_get( inum, jpdom_unknown, 'gdept_1d', pdept_1d )   
247         CALL iom_get( inum, jpdom_unknown, 'gdepw_1d', pdepw_1d )
248         CALL iom_get( inum, jpdom_data   , 'gdept_0' , pdept , lrowattr=ln_use_jattr )
249         CALL iom_get( inum, jpdom_data   , 'gdepw_0' , pdepw , lrowattr=ln_use_jattr )
[3]250         !
[7646]251      ELSE                                !- depths computed from e3. scale factors
252         CALL e3_to_depth( pe3t_1d, pe3w_1d, pdept_1d, pdepw_1d )    ! 1D reference depth
253         CALL e3_to_depth( pe3t   , pe3w   , pdept   , pdepw    )    ! 3D depths
254         IF(lwp) THEN
255            WRITE(numout,*)
256            WRITE(numout,*) '              Reference 1D z-coordinate depth and scale factors:'
257            WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
258            WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk )
259         ENDIF
[3]260      ENDIF
[1099]261      !
[7646]262      !                          !* ocean top and bottom level
263      CALL iom_get( inum, jpdom_data, 'top_level'    , z2d  , lrowattr=ln_use_jattr )   ! 1st wet T-points (ISF)
[9919]264      k_top(:,:) = NINT( z2d(:,:) )
[7646]265      CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d  , lrowattr=ln_use_jattr )   ! last wet T-points
[9919]266      k_bot(:,:) = NINT( z2d(:,:) )
[3294]267      !
[9023]268      ! reference depth for negative bathy (wetting and drying only)
269      IF( ll_wd )  CALL iom_get( inum,  'rn_wd_ref_depth' , ssh_ref   )
[3294]270      !
[7646]271      CALL iom_close( inum )
[3294]272      !
[7646]273   END SUBROUTINE zgr_read
[3]274
275
[7646]276   SUBROUTINE zgr_top_bot( k_top, k_bot )
[2528]277      !!----------------------------------------------------------------------
[7646]278      !!                    ***  ROUTINE zgr_top_bot  ***
[2528]279      !!
280      !! ** Purpose :   defines the vertical index of ocean bottom (mbk. arrays)
281      !!
[7646]282      !! ** Method  :   computes from k_top and k_bot with a minimum value of 1 over land
[2528]283      !!
[7646]284      !! ** Action  :   mikt, miku, mikv :   vertical indices of the shallowest
285      !!                                     ocean level at t-, u- & v-points
286      !!                                     (min value = 1)
[2528]287      !! ** Action  :   mbkt, mbku, mbkv :   vertical indices of the deeptest
288      !!                                     ocean level at t-, u- & v-points
289      !!                                     (min value = 1 over land)
290      !!----------------------------------------------------------------------
[7646]291      INTEGER , DIMENSION(:,:), INTENT(in) ::   k_top, k_bot   ! top & bottom ocean level indices
292      !
[2528]293      INTEGER ::   ji, jj   ! dummy loop indices
[9019]294      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace
[2528]295      !!----------------------------------------------------------------------
296      !
297      IF(lwp) WRITE(numout,*)
[7646]298      IF(lwp) WRITE(numout,*) '    zgr_top_bot : ocean top and bottom k-index of T-, U-, V- and W-levels '
299      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~'
[2528]300      !
[7753]301      mikt(:,:) = MAX( k_top(:,:) , 1 )    ! top    ocean k-index of T-level (=1 over land)
302      !
303      mbkt(:,:) = MAX( k_bot(:,:) , 1 )    ! bottom ocean k-index of T-level (=1 over land)
304 
[7646]305      !                                    ! N.B.  top     k-index of W-level = mikt
306      !                                    !       bottom  k-index of W-level = mbkt+1
307      DO jj = 1, jpjm1
[2528]308         DO ji = 1, jpim1
[4990]309            miku(ji,jj) = MAX(  mikt(ji+1,jj  ) , mikt(ji,jj)  )
310            mikv(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj)  )
311            mikf(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj), mikt(ji+1,jj  ), mikt(ji+1,jj+1)  )
[7646]312            !
313            mbku(ji,jj) = MIN(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )
314            mbkv(ji,jj) = MIN(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
[4990]315         END DO
316      END DO
317      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
[10425]318      zk(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'U', 1. )   ;   miku(:,:) = MAX( NINT( zk(:,:) ), 1 )
319      zk(:,:) = REAL( mikv(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'V', 1. )   ;   mikv(:,:) = MAX( NINT( zk(:,:) ), 1 )
320      zk(:,:) = REAL( mikf(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'F', 1. )   ;   mikf(:,:) = MAX( NINT( zk(:,:) ), 1 )
[4990]321      !
[10425]322      zk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'U', 1. )   ;   mbku(:,:) = MAX( NINT( zk(:,:) ), 1 )
323      zk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk( 'domzgr', zk, 'V', 1. )   ;   mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 )
[4990]324      !
[7646]325   END SUBROUTINE zgr_top_bot
[454]326
[3]327   !!======================================================================
328END MODULE domzgr
Note: See TracBrowser for help on using the repository browser.