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.
usrdef_zgr.F90 in NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/tests/LOCK_EXCHANGE/MY_SRC – NEMO

source: NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/tests/LOCK_EXCHANGE/MY_SRC/usrdef_zgr.F90 @ 10170

Last change on this file since 10170 was 10170, checked in by smasson, 5 years ago

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2a: add report calls of lbc_lnk, see #2133

  • Property svn:keywords set to Id
File size: 8.2 KB
RevLine 
[6906]1MODULE usrdef_zgr
[6923]2   !!======================================================================
3   !!                   ***  MODULE  usrdef_zgr  ***
[6906]4   !!
[6923]5   !!                   ===  LOCK_EXCHANGE case  ===
[6906]6   !!
[6914]7   !! Ocean domain : user defined vertical coordinate system
[6923]8   !!======================================================================
[6914]9   !! History :  4.0  ! 2016-08  (G. Madec, S. Flavoni)  Original code
[6906]10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
[6914]13   !!   usr_def_zgr   : user defined vertical coordinate system (required)
14   !!       zgr_z1d   : reference 1D z-coordinate
[6906]15   !!---------------------------------------------------------------------
[6914]16   USE oce            ! ocean variables
17   USE usrdef_nam     ! User defined : namelist variables
[6906]18   !
[6914]19   USE in_out_manager ! I/O manager
20   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
21   USE lib_mpp        ! distributed memory computing library
22   USE timing         ! Timing
[6906]23
24   IMPLICIT NONE
25   PRIVATE
26
[6923]27   PUBLIC   usr_def_zgr   ! called by domzgr.F90
[6906]28
29  !! * Substitutions
30#  include "vectopt_loop_substitute.h90"
31   !!----------------------------------------------------------------------
[10073]32   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[6923]33   !! $Id$
[10073]34   !! Software governed by the CeCILL license (see ./LICENSE)
[6906]35   !!----------------------------------------------------------------------
36CONTAINS             
37
38   SUBROUTINE usr_def_zgr( ld_zco  , ld_zps  , ld_sco  , ld_isfcav,    &   ! type of vertical coordinate
39      &                    pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d  ,    &   ! 1D reference vertical coordinate
40      &                    pdept , pdepw ,                             &   ! 3D t & w-points depth
41      &                    pe3t  , pe3u  , pe3v , pe3f ,               &   ! vertical scale factors
42      &                    pe3w  , pe3uw , pe3vw,                      &   !     -      -      -
43      &                    k_top  , k_bot    )                             ! top & bottom ocean level
44      !!---------------------------------------------------------------------
45      !!              ***  ROUTINE usr_def_zgr  ***
46      !!
47      !! ** Purpose :   User defined the vertical coordinates
48      !!
49      !!----------------------------------------------------------------------
50      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags
51      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag
52      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m]
53      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m]
54      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m]
55      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m]
56      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors
57      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level
58      !
[6914]59      INTEGER  ::   jk   ! dummy indices
60      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace
[6906]61      !!----------------------------------------------------------------------
62      !
63      IF(lwp) WRITE(numout,*)
64      IF(lwp) WRITE(numout,*) 'usr_def_zgr : LOCK_EXCHANGE configuration (z-coordinate closed box ocean without cavities)'
65      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
66      !
67      !
[9135]68      ! type of vertical coordinate   ==>>>   here LOCK EXCHANGE : flat bottom always
[6906]69      ! ---------------------------
[9135]70      ld_zco    = .TRUE.       ! z-partial-step coordinate
71      ld_zps    = .FALSE.      ! z-partial-step coordinate
72      ld_sco    = .FALSE.      ! s-coordinate
[6906]73      ld_isfcav = .FALSE.      ! ISF Ice Shelves Flag
74      !
75      !
76      ! Build the vertical coordinate system
77      ! ------------------------------------
78      !
79      !                       !==  UNmasked meter bathymetry  ==!
80      !
[6914]81      ! flat bassin (20m deep and 64000m wide, set through the jpk and jpi (see userdef_nam.F90))
[6906]82      CALL zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! Reference z-coordinate system
83      !
84      !
85      !                       !==  top masked level bathymetry  ==!  (all coordinates)
86      !
87      ! no ocean cavities : top ocean level is ONE, except over land
88      ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=0
89      z2d(:,:) = 1._wp                    ! surface ocean is the 1st level
[10170]90      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90)
[6914]91      k_top(:,:) = NINT( z2d(:,:) )
[6906]92      !
93      !                             
[6914]94      !                       !==  z-coordinate  ==!   (step-like topography)
[6906]95      !
[6914]96      !                                !* bottom ocean compute from the depth of grid-points
97      k_bot(:,:) = jpkm1 * k_top(:,:)     ! here use k_top as a land mask
98      !                                !* horizontally uniform coordinate (reference z-co everywhere)
99      DO jk = 1, jpk
100         pdept(:,:,jk) = pdept_1d(jk)
101         pdepw(:,:,jk) = pdepw_1d(jk)
102         pe3t (:,:,jk) = pe3t_1d (jk)
103         pe3u (:,:,jk) = pe3t_1d (jk)
104         pe3v (:,:,jk) = pe3t_1d (jk)
105         pe3f (:,:,jk) = pe3t_1d (jk)
106         pe3w (:,:,jk) = pe3w_1d (jk)
107         pe3uw(:,:,jk) = pe3w_1d (jk)
108         pe3vw(:,:,jk) = pe3w_1d (jk)
109      END DO
[6906]110      !
111   END SUBROUTINE usr_def_zgr
112
113
114   SUBROUTINE zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! 1D reference vertical coordinate
115      !!----------------------------------------------------------------------
116      !!                   ***  ROUTINE zgr_z1d  ***
117      !!
118      !! ** Purpose :   set the depth of model levels and the resulting
119      !!      vertical scale factors.
120      !!
[7188]121      !! ** Method  :   1D z-coordinate system (use in all type of coordinate)
122      !!       The depth of model levels is set from dep(k), an analytical function:
123      !!                   w-level: depw_1d  = dep(k)
124      !!                   t-level: dept_1d  = dep(k+0.5)
125      !!       The scale factors are the discrete derivative of the depth:
126      !!                   e3w_1d(jk) = dk[ dept_1d ]
127      !!                   e3t_1d(jk) = dk[ depw_1d ]
[6906]128      !!
129      !!            ===    Here constant vertical resolution   ===
130      !!
131      !! ** Action  : - pdept_1d, pdepw_1d : depth of T- and W-point (m)
132      !!              - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
133      !!----------------------------------------------------------------------
134      REAL(wp), DIMENSION(:), INTENT(out) ::   pdept_1d, pdepw_1d   ! 1D grid-point depth        [m]
135      REAL(wp), DIMENSION(:), INTENT(out) ::   pe3t_1d , pe3w_1d    ! 1D vertical scale factors  [m]
136      !
137      INTEGER  ::   jk       ! dummy loop indices
138      REAL(wp) ::   zt, zw   ! local scalar
139      !!----------------------------------------------------------------------
140      !
141      IF(lwp) THEN                         ! Parameter print
142         WRITE(numout,*)
143         WRITE(numout,*) '    zgr_z1d : Reference vertical z-coordinates: uniform dz = ', rn_dz
144         WRITE(numout,*) '    ~~~~~~~'
145      ENDIF
146      !
147      ! Reference z-coordinate (depth - scale factor at T- and W-points)   ! Madec & Imbard 1996 function
148      ! ----------------------
149      DO jk = 1, jpk
150         zw = REAL( jk , wp )
151         zt = REAL( jk , wp ) + 0.5_wp
152         pdepw_1d(jk) =    rn_dz *   REAL( jk-1 , wp )
153         pdept_1d(jk) =    rn_dz * ( REAL( jk-1 , wp ) + 0.5_wp )
154         pe3w_1d (jk) =    rn_dz
155         pe3t_1d (jk) =    rn_dz
156      END DO
157      !
158      IF(lwp) THEN                        ! control print
159         WRITE(numout,*)
160         WRITE(numout,*) '              Reference 1D z-coordinate depth and scale factors:'
161         WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
162         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk )
163      ENDIF
164      !
165   END SUBROUTINE zgr_z1d
166   
167   !!======================================================================
168END MODULE usrdef_zgr
Note: See TracBrowser for help on using the repository browser.