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 branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/USR – NEMO

source: branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_zgr.F90 @ 6977

Last change on this file since 6977 was 6923, checked in by gm, 8 years ago

#1692 - branch SIMPLIF_2_usrdef: update comments in usrdef modules
File size: 13.4 KB
Line 
1MODULE usrdef_zgr
2   !!======================================================================
3   !!                       ***  MODULE  usrdef_zgr  ***
4   !!
5   !!                       ===  GYRE configuration  ===
6   !!
7   !! User defined : vertical coordinate system of a user configuration
8   !!======================================================================
9   !! History :  4.0  ! 2016-06  (G. Madec)  Original code
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   usr_def_zgr      : user defined vertical coordinate system
14   !!       zgr_z        : reference 1D z-coordinate
15   !!       zgr_top_bot  : ocean top and bottom level indices
16   !!       zgr_zco      : 3D verticl coordinate in pure z-coordinate case
17   !!---------------------------------------------------------------------
18   USE oce               ! ocean variables
19   USE dom_oce           ! ocean domain
20   !
21   USE in_out_manager    ! I/O manager
22   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
23   USE lib_mpp           ! distributed memory computing library
24   USE wrk_nemo          ! Memory allocation
25   USE timing            ! Timing
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC   usr_def_zgr        ! called by domzgr.F90
31
32  !! * Substitutions
33#  include "vectopt_loop_substitute.h90"
34   !!----------------------------------------------------------------------
35   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
36   !! $Id$
37   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
38   !!----------------------------------------------------------------------
39CONTAINS             
40
41   SUBROUTINE usr_def_zgr( ld_zco  , ld_zps  , ld_sco  , ld_isfcav,    &   ! type of vertical coordinate
42      &                    pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d  ,    &   ! 1D reference vertical coordinate
43      &                    pdept , pdepw ,                             &   ! 3D t & w-points depth
44      &                    pe3t  , pe3u  , pe3v   , pe3f ,             &   ! vertical scale factors
45      &                    pe3w  , pe3uw , pe3vw         ,             &   !     -      -      -
46      &                    k_top  , k_bot    )                             ! top & bottom ocean level
47      !!---------------------------------------------------------------------
48      !!              ***  ROUTINE usr_def_zgr  ***
49      !!
50      !! ** Purpose :   User defined the vertical coordinates
51      !!
52      !!----------------------------------------------------------------------
53      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags
54      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag
55      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m]
56      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m]
57      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m]
58      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m]
59      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors
60      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level
61      !
62      INTEGER  ::   inum   ! local logical unit
63      REAL(WP) ::   z_zco, z_zps, z_sco, z_cav
64      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace
65      !!----------------------------------------------------------------------
66      !
67      IF(lwp) WRITE(numout,*)
68      IF(lwp) WRITE(numout,*) 'usr_def_zgr : GYRE configuration (z-coordinate closed flat box ocean without cavities)'
69      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
70      !
71      !
72      ! type of vertical coordinate
73      ! ---------------------------
74      ld_zco    = .TRUE.         ! GYRE case:  z-coordinate & no ocean cavities
75      ld_zps    = .FALSE.
76      ld_sco    = .FALSE.
77      ld_isfcav = .FALSE.
78      !
79      !
80      ! Build the vertical coordinate system
81      ! ------------------------------------
82      CALL zgr_z  ( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )  ! Reference z-coordinate system
83      !
84      CALL zgr_msk_top_bot( k_top , k_bot )                  ! masked top and bottom ocean t-level indices
85      !
86      !                                                      ! z-coordinate (3D arrays) from the 1D z-coord.
87      CALL zgr_zco( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d,   &   ! in  : 1D reference vertical coordinate
88         &          pdept   , pdepw   ,                     &   ! out : 3D t & w-points depth
89         &          pe3t    , pe3u    , pe3v   , pe3f   ,   &   !       vertical scale factors
90         &          pe3w    , pe3uw   , pe3vw             )     !           -      -      -
91      !
92   END SUBROUTINE usr_def_zgr
93
94
95   SUBROUTINE zgr_z( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! 1D reference vertical coordinate
96      !!----------------------------------------------------------------------
97      !!                   ***  ROUTINE zgr_z  ***
98      !!
99      !! ** Purpose :   set the depth of model levels and the resulting
100      !!              vertical scale factors.
101      !!
102      !! ** Method  :   z-coordinate system (use in all type of coordinate)
103      !!              The depth of model levels is defined from an analytical
104      !!              function the derivative of which gives the scale factors.
105      !!              both depth and scale factors only depend on k (1d arrays).
106      !!                 w-level: pdepw_1d  = pdep(k)
107      !!                          pe3w_1d(k) = dk(pdep)(k)     = e3(k)
108      !!                 t-level: pdept_1d  = pdep(k+0.5)
109      !!                          pe3t_1d(k) = dk(pdep)(k+0.5) = e3(k+0.5)
110      !!
111      !!      Here the Madec & Imbard (1996) function is used
112      !!
113      !! ** Action  : - pdept_1d, pdepw_1d : depth of T- and W-point (m)
114      !!              - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
115      !!
116      !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
117      !!             Madec and Imbard, 1996, Clim. Dyn.
118      !!----------------------------------------------------------------------
119      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d   ! 1D grid-point depth        [m]
120      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d    ! 1D vertical scale factors  [m]
121      !
122      INTEGER  ::   jk       ! dummy loop indices
123      REAL(wp) ::   zt, zw   ! local scalars
124      REAL(wp) ::   zsur, za0, za1, zkth, zacr   ! Values for the Madec & Imbard (1996) function 
125      !!----------------------------------------------------------------------
126      !
127      IF( nn_timing == 1 )  CALL timing_start('zgr_z')
128      !
129      ! Set variables from parameters
130      ! ------------------------------
131      zsur = -2033.194295283385_wp       
132      za0  =   155.8325369664153_wp 
133      za1  =   146.3615918601890_wp
134      zkth =    17.28520372419791_wp   
135      zacr =     5.0_wp       
136      !
137      IF(lwp) THEN                         ! Parameter print
138         WRITE(numout,*)
139         WRITE(numout,*) '    zgr_z   : Reference vertical z-coordinates '
140         WRITE(numout,*) '    ~~~~~~~'
141         WRITE(numout,*) '       GYRE case : MI96 function with the following coefficients :'
142         WRITE(numout,*) '                 zsur = ', zsur
143         WRITE(numout,*) '                 za0  = ', za0
144         WRITE(numout,*) '                 za1  = ', za1
145         WRITE(numout,*) '                 zkth = ', zkth
146         WRITE(numout,*) '                 zacr = ', zacr
147      ENDIF
148
149
150      ! Reference z-coordinate (depth - scale factor at T- and W-points)   ! Madec & Imbard 1996 function
151      ! ----------------------
152      DO jk = 1, jpk
153         zw = REAL( jk , wp )
154         zt = REAL( jk , wp ) + 0.5_wp
155         pdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr *  LOG( COSH( (zw-zkth) / zacr ) )  )
156         pdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr *  LOG( COSH( (zt-zkth) / zacr ) )  )
157         pe3w_1d (jk) =          za0      + za1        * TANH(       (zw-zkth) / zacr   )
158         pe3t_1d (jk) =          za0      + za1        * TANH(       (zt-zkth) / zacr   )
159      END DO
160      pdepw_1d(1) = 0._wp                    ! force first w-level to be exactly at zero
161
162
163!!gm   This should become the reference !
164!      IF ( ln_isfcav ) THEN
165! need to be like this to compute the pressure gradient with ISF. If not, level beneath the ISF are not aligned (sum(e3t) /= depth)
166! define pe3t_0 and pe3w_0 as the differences between pdept and pdepw respectively
167!         DO jk = 1, jpkm1
168!            pe3t_1d(jk) = pdepw_1d(jk+1)-pdepw_1d(jk)
169!         END DO
170!         pe3t_1d(jpk) = pe3t_1d(jpk-1)   ! we don't care because this level is masked in NEMO
171!
172!         DO jk = 2, jpk
173!            pe3w_1d(jk) = pdept_1d(jk) - pdept_1d(jk-1)
174!         END DO
175!         pe3w_1d(1  ) = 2._wp * (pdept_1d(1) - pdepw_1d(1))
176!      END IF
177!!gm end
178
179      IF(lwp) THEN                        ! control print
180         WRITE(numout,*)
181         WRITE(numout,*) '              Reference 1D z-coordinate depth and scale factors:'
182         WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
183         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk )
184      ENDIF
185      DO jk = 1, jpk                      ! control positivity
186         IF( pe3w_1d (jk) <= 0._wp .OR. pe3t_1d (jk) <= 0._wp )   CALL ctl_stop( 'dom:zgr_z: e3w_1d or e3t_1d =< 0 '    )
187         IF( pdepw_1d(jk) <  0._wp .OR. pdept_1d(jk) <  0._wp )   CALL ctl_stop( 'dom:zgr_z: gdepw_1d or gdept_1d < 0 ' )
188      END DO
189      !
190      IF( nn_timing == 1 )  CALL timing_stop('zgr_z')
191      !
192   END SUBROUTINE zgr_z
193
194
195   SUBROUTINE zgr_msk_top_bot( k_top , k_bot )
196      !!----------------------------------------------------------------------
197      !!                    ***  ROUTINE zgr_msk_top_bot  ***
198      !!
199      !! ** Purpose :   set the masked top and bottom ocean t-levels
200      !!
201      !! ** Method  :   GYRE case = closed flat box ocean without ocean cavities
202      !!                   k_top = 1     except along north, south, east and west boundaries
203      !!                   k_bot = jpk-1 except along north, south, east and west boundaries
204      !!
205      !! ** Action  : - k_top : first ocean level index
206      !!              - k_bot : last  ocean level index
207      !!----------------------------------------------------------------------
208      INTEGER , DIMENSION(:,:), INTENT(out) ::   k_top , k_bot   ! first & last ocean level
209      !
210      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D local workspace
211      !!----------------------------------------------------------------------
212      !
213      IF(lwp) WRITE(numout,*)
214      IF(lwp) WRITE(numout,*) '    zgr_top_bot : defines the top and bottom ocean levels.'
215      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~'
216      IF(lwp) WRITE(numout,*) '       GYRE case : closed flat box ocean without ocean cavities'
217      !
218      z2d(:,:) = REAL( jpkm1 , wp )          ! flat bottom
219      !
220      CALL lbc_lnk( z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed)
221      !
222      k_bot(:,:) = INT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere
223      !
224      k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere
225      !
226   END SUBROUTINE zgr_msk_top_bot
227   
228
229   SUBROUTINE zgr_zco( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d,   &   ! in : 1D reference vertical coordinate
230      &                pdept   , pdepw   ,                     &   ! out: 3D t & w-points depth
231      &                pe3t    , pe3u    , pe3v   , pe3f   ,   &   !      vertical scale factors
232      &                pe3w    , pe3uw   , pe3vw             )     !          -      -      -
233      !!----------------------------------------------------------------------
234      !!                  ***  ROUTINE zgr_zco  ***
235      !!
236      !! ** Purpose :   define the reference z-coordinate system
237      !!
238      !! ** Method  :   set 3D coord. arrays to reference 1D array
239      !!----------------------------------------------------------------------
240      REAL(wp), DIMENSION(:)    , INTENT(in   ) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth       [m]
241      REAL(wp), DIMENSION(:)    , INTENT(in   ) ::   pe3t_1d , pe3w_1d           ! 1D vertical scale factors [m]
242      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdept, pdepw                ! grid-point depth          [m]
243      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors    [m]
244      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3w , pe3uw, pe3vw         !    -       -      -
245      !
246      INTEGER  ::   jk
247      !!----------------------------------------------------------------------
248      !
249      IF( nn_timing == 1 )  CALL timing_start('zgr_zco')
250      !
251      DO jk = 1, jpk
252         pdept(:,:,jk) = pdept_1d(jk)
253         pdepw(:,:,jk) = pdepw_1d(jk)
254         pe3t (:,:,jk) = pe3t_1d (jk)
255         pe3u (:,:,jk) = pe3t_1d (jk)
256         pe3v (:,:,jk) = pe3t_1d (jk)
257         pe3f (:,:,jk) = pe3t_1d (jk)
258         pe3w (:,:,jk) = pe3w_1d (jk)
259         pe3uw(:,:,jk) = pe3w_1d (jk)
260         pe3vw(:,:,jk) = pe3w_1d (jk)
261      END DO
262      !
263      IF( nn_timing == 1 )  CALL timing_stop('zgr_zco')
264      !
265   END SUBROUTINE zgr_zco
266
267   !!======================================================================
268END MODULE usrdef_zgr
Note: See TracBrowser for help on using the repository browser.