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/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/USR – NEMO

source: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/USR/usrdef_zgr.F90 @ 14933

Last change on this file since 14933 was 14219, checked in by mcastril, 4 years ago

Add Mixed Precision support by Oriol Tintó
  • Property svn:keywords set to Id
File size: 12.6 KB
RevLine 
[6667]1MODULE usrdef_zgr
[6923]2   !!======================================================================
3   !!                       ***  MODULE  usrdef_zgr  ***
[6667]4   !!
[6923]5   !!                       ===  GYRE configuration  ===
[6667]6   !!
[6923]7   !! User defined : vertical coordinate system of a user configuration
8   !!======================================================================
[6667]9   !! History :  4.0  ! 2016-06  (G. Madec)  Original code
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
[7188]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
[6667]17   !!---------------------------------------------------------------------
[7188]18   USE oce            ! ocean variables
19   USE dom_oce        ! ocean domain
20   USE depth_e3       ! depth <=> e3
[6667]21   !
[7188]22   USE in_out_manager ! I/O manager
23   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
24   USE lib_mpp        ! distributed memory computing library
[6667]25
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC   usr_def_zgr        ! called by domzgr.F90
30
31   !!----------------------------------------------------------------------
[9598]32   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[10068]33   !! $Id$
34   !! Software governed by the CeCILL license (see ./LICENSE)
[6667]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]
[14219]55      REAL(dp), DIMENSION(:,:,:), INTENT(out) ::   pe3t                        ! vertical scale factors  [m]
56      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::          pe3u , pe3v , pe3f   ! vertical scale factors  [m]
[6667]57      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors
58      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level
59      !
60      INTEGER  ::   inum   ! local logical unit
61      REAL(WP) ::   z_zco, z_zps, z_sco, z_cav
62      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace
63      !!----------------------------------------------------------------------
64      !
65      IF(lwp) WRITE(numout,*)
66      IF(lwp) WRITE(numout,*) 'usr_def_zgr : GYRE configuration (z-coordinate closed flat box ocean without cavities)'
67      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
68      !
69      !
70      ! type of vertical coordinate
71      ! ---------------------------
[7188]72      ld_zco    = .TRUE.         ! GYRE case:  z-coordinate without ocean cavities
[6667]73      ld_zps    = .FALSE.
74      ld_sco    = .FALSE.
75      ld_isfcav = .FALSE.
76      !
77      !
78      ! Build the vertical coordinate system
79      ! ------------------------------------
[7188]80      CALL zgr_z( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! Reference z-coordinate system
[6667]81      !
[7188]82      CALL zgr_msk_top_bot( k_top , k_bot )                 ! masked top and bottom ocean t-level indices
[6667]83      !
[7188]84      !                                                     ! z-coordinate (3D arrays) from the 1D z-coord.
[6667]85      CALL zgr_zco( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d,   &   ! in  : 1D reference vertical coordinate
86         &          pdept   , pdepw   ,                     &   ! out : 3D t & w-points depth
87         &          pe3t    , pe3u    , pe3v   , pe3f   ,   &   !       vertical scale factors
88         &          pe3w    , pe3uw   , pe3vw             )     !           -      -      -
89      !
90   END SUBROUTINE usr_def_zgr
91
92
93   SUBROUTINE zgr_z( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! 1D reference vertical coordinate
94      !!----------------------------------------------------------------------
95      !!                   ***  ROUTINE zgr_z  ***
96      !!
[7164]97      !! ** Purpose :   set the 1D depth of model levels and the resulting
[6904]98      !!              vertical scale factors.
[6667]99      !!
[7188]100      !! ** Method  :   1D z-coordinate system (use in all type of coordinate)
101      !!       The depth of model levels is set from dep(k), an analytical function:
102      !!                   w-level: depw_1d  = dep(k)
103      !!                   t-level: dept_1d  = dep(k+0.5)
104      !!       The scale factors are the discrete derivative of the depth:
105      !!                   e3w_1d(jk) = dk[ dept_1d ]
106      !!                   e3t_1d(jk) = dk[ depw_1d ]
107      !!           with at top and bottom :
108      !!                   e3w_1d( 1 ) = 2 * ( dept_1d( 1 ) - depw_1d( 1 ) )
109      !!                   e3t_1d(jpk) = 2 * ( dept_1d(jpk) - depw_1d(jpk) )
110      !!       The depth are then re-computed from the sum of e3. This ensures
[7200]111      !!    that depths are identical when reading domain configuration file.
112      !!    Indeed, only e3. are saved in this file, depth are compute by a call
113      !!    to the e3_to_depth subroutine.
[6667]114      !!
[7188]115      !!       Here the Madec & Imbard (1996) function is used.
[6667]116      !!
117      !! ** Action  : - pdept_1d, pdepw_1d : depth of T- and W-point (m)
118      !!              - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
119      !!
120      !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
121      !!             Madec and Imbard, 1996, Clim. Dyn.
122      !!----------------------------------------------------------------------
123      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d   ! 1D grid-point depth        [m]
124      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d    ! 1D vertical scale factors  [m]
125      !
126      INTEGER  ::   jk       ! dummy loop indices
127      REAL(wp) ::   zt, zw   ! local scalars
128      REAL(wp) ::   zsur, za0, za1, zkth, zacr   ! Values for the Madec & Imbard (1996) function 
129      !!----------------------------------------------------------------------
130      !
[7164]131      ! Set parameters of z(k) function
132      ! -------------------------------
[6667]133      zsur = -2033.194295283385_wp       
134      za0  =   155.8325369664153_wp 
135      za1  =   146.3615918601890_wp
136      zkth =    17.28520372419791_wp   
137      zacr =     5.0_wp       
138      !
[7164]139      IF(lwp) THEN            ! Parameter print
[6667]140         WRITE(numout,*)
141         WRITE(numout,*) '    zgr_z   : Reference vertical z-coordinates '
142         WRITE(numout,*) '    ~~~~~~~'
143         WRITE(numout,*) '       GYRE case : MI96 function with the following coefficients :'
144         WRITE(numout,*) '                 zsur = ', zsur
145         WRITE(numout,*) '                 za0  = ', za0
146         WRITE(numout,*) '                 za1  = ', za1
147         WRITE(numout,*) '                 zkth = ', zkth
148         WRITE(numout,*) '                 zacr = ', zacr
149      ENDIF
150
[7164]151      !
152      ! 1D Reference z-coordinate    (using Madec & Imbard 1996 function)
153      ! -------------------------
154      !
155      DO jk = 1, jpk          ! depth at T and W-points
[6667]156         zw = REAL( jk , wp )
157         zt = REAL( jk , wp ) + 0.5_wp
158         pdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr *  LOG( COSH( (zw-zkth) / zacr ) )  )
159         pdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr *  LOG( COSH( (zt-zkth) / zacr ) )  )
160      END DO
[7188]161      !
162      !                       ! e3t and e3w from depth
163      CALL depth_to_e3( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d ) 
164      !
165      !                       ! recompute depths from SUM(e3)  <== needed
166      CALL e3_to_depth( pe3t_1d, pe3w_1d, pdept_1d, pdepw_1d ) 
167      !
[6667]168      IF(lwp) THEN                        ! control print
169         WRITE(numout,*)
170         WRITE(numout,*) '              Reference 1D z-coordinate depth and scale factors:'
171         WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
172         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk )
173      ENDIF
174      !
175   END SUBROUTINE zgr_z
176
177
[6904]178   SUBROUTINE zgr_msk_top_bot( k_top , k_bot )
[6667]179      !!----------------------------------------------------------------------
[6904]180      !!                    ***  ROUTINE zgr_msk_top_bot  ***
[6667]181      !!
[6904]182      !! ** Purpose :   set the masked top and bottom ocean t-levels
[6667]183      !!
184      !! ** Method  :   GYRE case = closed flat box ocean without ocean cavities
185      !!                   k_top = 1     except along north, south, east and west boundaries
186      !!                   k_bot = jpk-1 except along north, south, east and west boundaries
187      !!
[7164]188      !! ** Action  : - k_top : first wet ocean level index
189      !!              - k_bot : last  wet ocean level index
[6667]190      !!----------------------------------------------------------------------
[7164]191      INTEGER , DIMENSION(:,:), INTENT(out) ::   k_top , k_bot   ! first & last wet ocean level
[6667]192      !
193      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D local workspace
194      !!----------------------------------------------------------------------
195      !
196      IF(lwp) WRITE(numout,*)
[7164]197      IF(lwp) WRITE(numout,*) '    zgr_top_bot : defines the top and bottom wet ocean levels.'
[6667]198      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~'
199      IF(lwp) WRITE(numout,*) '       GYRE case : closed flat box ocean without ocean cavities'
200      !
[13286]201      z2d(:,:) = REAL( jpkm1 , wp )                              ! flat bottom
[6667]202      !
[12740]203      k_bot(:,:) = NINT( z2d(:,:) )          ! =jpkm1 over the ocean point, =0 elsewhere
[6667]204      !
[7753]205      k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere
206      !
[6904]207   END SUBROUTINE zgr_msk_top_bot
[6667]208   
209
210   SUBROUTINE zgr_zco( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d,   &   ! in : 1D reference vertical coordinate
211      &                pdept   , pdepw   ,                     &   ! out: 3D t & w-points depth
212      &                pe3t    , pe3u    , pe3v   , pe3f   ,   &   !      vertical scale factors
213      &                pe3w    , pe3uw   , pe3vw             )     !          -      -      -
214      !!----------------------------------------------------------------------
215      !!                  ***  ROUTINE zgr_zco  ***
216      !!
217      !! ** Purpose :   define the reference z-coordinate system
218      !!
219      !! ** Method  :   set 3D coord. arrays to reference 1D array
220      !!----------------------------------------------------------------------
221      REAL(wp), DIMENSION(:)    , INTENT(in   ) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth       [m]
222      REAL(wp), DIMENSION(:)    , INTENT(in   ) ::   pe3t_1d , pe3w_1d           ! 1D vertical scale factors [m]
223      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdept, pdepw                ! grid-point depth          [m]
[14219]224      REAL(dp), DIMENSION(:,:,:), INTENT(  out) ::   pe3t                        ! vertical scale factors    [m]
225      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::          pe3u , pe3v , pe3f   ! vertical scale factors    [m]
[6667]226      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3w , pe3uw, pe3vw         !    -       -      -
227      !
[7753]228      INTEGER  ::   jk
[6667]229      !!----------------------------------------------------------------------
230      !
231      DO jk = 1, jpk
[7753]232         pdept(:,:,jk) = pdept_1d(jk)
233         pdepw(:,:,jk) = pdepw_1d(jk)
234         pe3t (:,:,jk) = pe3t_1d (jk)
235         pe3u (:,:,jk) = pe3t_1d (jk)
236         pe3v (:,:,jk) = pe3t_1d (jk)
237         pe3f (:,:,jk) = pe3t_1d (jk)
238         pe3w (:,:,jk) = pe3w_1d (jk)
239         pe3uw(:,:,jk) = pe3w_1d (jk)
240         pe3vw(:,:,jk) = pe3w_1d (jk)
[6667]241      END DO
242      !
243   END SUBROUTINE zgr_zco
244
245   !!======================================================================
246END MODULE usrdef_zgr
Note: See TracBrowser for help on using the repository browser.