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/UKMO/NEMO_4.0-TRUNK_r14960_HPG/tests/SEAMOUNT/MY_SRC – NEMO

source: NEMO/branches/UKMO/NEMO_4.0-TRUNK_r14960_HPG/tests/SEAMOUNT/MY_SRC/usrdef_zgr.F90 @ 15719

Last change on this file since 15719 was 15719, checked in by dbruciaferri, 2 years ago

updating tests from git repo
File size: 23.0 KB
Line 
1MODULE usrdef_zgr
2   !!======================================================================
3   !!                       ***  MODULE  usrdef_zgr  ***
4   !!
5   !!                       ===  SEAMOUNT 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   USE depth_e3       ! depth <=> e3
21   !
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
25   USE usrdef_nam
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC   usr_def_zgr        ! called by domzgr.F90
31
32   !!----------------------------------------------------------------------
33   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
34   !! $Id: usrdef_zgr.F90 13286 2020-07-09 15:48:29Z smasson $
35   !! Software governed by the CeCILL license (see ./LICENSE)
36   !!----------------------------------------------------------------------
37CONTAINS             
38
39   SUBROUTINE usr_def_zgr( ld_zco  , ld_zps  , ld_sco  , ld_isfcav,    &   ! type of vertical coordinate
40      &                    pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d  ,    &   ! 1D reference vertical coordinate
41      &                    pdept , pdepw ,                             &   ! 3D t & w-points depth
42      &                    pe3t  , pe3u  , pe3v   , pe3f ,             &   ! vertical scale factors
43      &                    pe3w  , pe3uw , pe3vw         ,             &   !     -      -      -
44      &                    k_top  , k_bot    )                             ! top & bottom ocean level
45      !!---------------------------------------------------------------------
46      !!              ***  ROUTINE usr_def_zgr  ***
47      !!
48      !! ** Purpose :   User defined the vertical coordinates
49      !!
50      !!----------------------------------------------------------------------
51      LOGICAL                   , INTENT(in ) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags
52      LOGICAL                   , INTENT(in ) ::   ld_isfcav                   ! under iceshelf cavity flag
53      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m]
54      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m]
55      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m]
56      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m]
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  ::   ji, jj, jk        ! dummy indices
61      INTEGER  ::   ik                ! local integers
62      REAL(wp) ::   zfact, z1_jpkm1   ! local scalar
63      REAL(wp) ::   ze3min            ! local scalar
64      REAL(wp) ::   zlam_mid, zphi_mid! local scalar
65      REAL(wp), DIMENSION(jpi,jpj) ::   zht, zhu, zhv, z2d   ! 2D workspace
66      !
67      !!----------------------------------------------------------------------
68      !
69      !
70      ! ------------------------------------
71      ! Build the vertical coordinate system
72      ! ------------------------------------
73      !
74      !                       !==  Unmasked meter bathymetry  ==!
75      !
76      !
77      !
78      IF(lwp) WRITE(numout,*)
79      IF(lwp) WRITE(numout,*) 'usr_def_zgr (SEAMOUNT) : Isolated Gaussian bump in E-W periodic channel'
80      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
81      !
82      zlam_mid = 0.5_wp * 1000._wp * rn_length
83      zphi_mid = 0.5_wp * 1000._wp * rn_width
84      zht = 0._wp
85      DO jj = 1, jpj
86         DO ji = 1, jpi
87            zht(ji,jj) = rn_bathy - rn_seamountheight * EXP( &
88                    &  - ( ( 1000._wp * glamt(ji,jj) - zlam_mid) ** 2 + ( 1000._wp * gphit(ji,jj) - zphi_mid) ** 2) & 
89                    &  / rn_l ** 2)
90         END DO
91      END DO
92      !
93      ! ------------------------------------
94      CALL zgr_z( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! Reference z-coordinate system
95      !
96      CALL zgr_msk_top_bot( k_top , k_bot )                 ! masked top and bottom ocean t-level indices
97      !
98      !                                                     ! z-coordinate (3D arrays) from the 1D z-coord.
99      IF ( ln_zco ) CALL zgr_zco( zht, pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d,   &   ! in  : 1D reference vertical coordinate
100            &          pdept   , pdepw   ,                     &   ! out : 3D t & w-points depth
101            &          pe3t    , pe3u    , pe3v   , pe3f   ,   &   !       vertical scale factors
102            &          pe3w    , pe3uw   , pe3vw, k_bot, k_top             )     !           -      -      -
103      !                                                     ! z-coordinate (3D arrays) from the 1D z-coord.
104      IF ( ln_zps ) CALL zgr_zps( zht, pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d,   &   ! in  : 1D reference vertical coordinate
105            &          pdept   , pdepw   ,                     &   ! out : 3D t & w-points depth
106            &          pe3t    , pe3u    , pe3v   , pe3f   ,   &   !       vertical scale factors
107            &          pe3w    , pe3uw   , pe3vw, k_bot, k_top             )     !           -      -      -
108      !                                                     ! z-coordinate (3D arrays) from the 1D z-coord.
109      IF ( ln_sco ) CALL zgr_sco( zht,   &                  ! in  : reference bathymetry
110            &          pdept   , pdepw   ,                     &   ! out : 3D t & w-points depth
111            &          pe3t    , pe3u    , pe3v   , pe3f   ,   &   !       vertical scale factors
112            &          pe3w    , pe3uw   , pe3vw, k_bot, k_top            )     !           -      -      -
113
114      !
115   END SUBROUTINE usr_def_zgr
116
117
118   SUBROUTINE zgr_z( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! 1D reference vertical coordinate
119      !!----------------------------------------------------------------------
120      !!                   ***  ROUTINE zgr_z  ***
121      !!
122      !! ** Purpose :   set the 1D depth of model levels and the resulting
123      !!              vertical scale factors.
124      !!
125      !! ** Method  :   1D z-coordinate system (use in all type of coordinate)
126      !!       The depth of model levels is set from dep(k), an analytical function:
127      !!                   w-level: depw_1d  = dep(k)
128      !!                   t-level: dept_1d  = dep(k+0.5)
129      !!       The scale factors are the discrete derivative of the depth:
130      !!                   e3w_1d(jk) = dk[ dept_1d ]
131      !!                   e3t_1d(jk) = dk[ depw_1d ]
132      !!           with at top and bottom :
133      !!                   e3w_1d( 1 ) = 2 * ( dept_1d( 1 ) - depw_1d( 1 ) )
134      !!                   e3t_1d(jpk) = 2 * ( dept_1d(jpk) - depw_1d(jpk) )
135      !!       The depth are then re-computed from the sum of e3. This ensures
136      !!    that depths are identical when reading domain configuration file.
137      !!    Indeed, only e3. are saved in this file, depth are compute by a call
138      !!    to the e3_to_depth subroutine.
139      !!
140      !!       Here the Madec & Imbard (1996) function is used.
141      !!
142      !! ** Action  : - pdept_1d, pdepw_1d : depth of T- and W-point (m)
143      !!              - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
144      !!
145      !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
146      !!             Madec and Imbard, 1996, Clim. Dyn.
147      !!----------------------------------------------------------------------
148      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d   ! 1D grid-point depth        [m]
149      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d    ! 1D vertical scale factors  [m]
150      !
151      INTEGER  ::   jk       ! dummy loop indices
152      REAL(wp) ::   zt, zw   ! local scalars
153      !!----------------------------------------------------------------------
154      !
155      !
156      IF(lwp) THEN            ! Parameter print
157         WRITE(numout,*)
158         WRITE(numout,*) '    zgr_z   : Reference vertical z-coordinates '
159         WRITE(numout,*) '    ~~~~~~~'
160      ENDIF
161
162      !
163      ! 1D Reference z-coordinate    (using Madec & Imbard 1996 function)
164      ! -------------------------
165      !
166      DO jk = 1, jpk          ! depth at T and W-points
167         zw = REAL( jk , wp ) - 1.0_wp
168         zt = REAL( jk , wp ) - 0.5_wp
169         pdepw_1d(jk) = zw * rn_bathy / ( REAL(jpk,wp) - 1.0_wp )
170         pdept_1d(jk) = zt * rn_bathy / ( REAL(jpk,wp) - 1.0_wp )
171      END DO
172      !
173      !                       ! e3t and e3w from depth
174      CALL depth_to_e3( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d ) 
175      !
176      !                       ! recompute depths from SUM(e3)  <== needed
177      CALL e3_to_depth( pe3t_1d, pe3w_1d, pdept_1d, pdepw_1d ) 
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      !
186   END SUBROUTINE zgr_z
187
188
189   SUBROUTINE zgr_msk_top_bot( k_top , k_bot )
190      !!----------------------------------------------------------------------
191      !!                    ***  ROUTINE zgr_msk_top_bot  ***
192      !!
193      !! ** Purpose :   set the masked top and bottom ocean t-levels
194      !!
195      !! ** Method  :   GYRE case = closed flat box ocean without ocean cavities
196      !!                   k_top = 1     except along north, south, east and west boundaries
197      !!                   k_bot = jpk-1 except along north, south, east and west boundaries
198      !!
199      !! ** Action  : - k_top : first wet ocean level index
200      !!              - k_bot : last  wet ocean level index
201      !!----------------------------------------------------------------------
202      INTEGER , DIMENSION(:,:), INTENT(out) ::   k_top , k_bot   ! first & last wet ocean level
203      !
204      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D local workspace
205      !!----------------------------------------------------------------------
206      !
207      IF(lwp) WRITE(numout,*)
208      IF(lwp) WRITE(numout,*) '    zgr_top_bot : defines the top and bottom wet ocean levels.'
209      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~'
210      IF(lwp) WRITE(numout,*) '       SEAMOUNT case : terrain-following k_bot = jpkm1 for ocean points'
211      !
212      z2d(:,:) = REAL( jpkm1 , wp )                              ! flat bottom
213      !
214      k_bot(:,:) = NINT( z2d(:,:) )          ! =jpkm1 over the ocean point, =0 elsewhere
215      !
216      k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere
217      !
218   END SUBROUTINE zgr_msk_top_bot
219   
220
221   SUBROUTINE zgr_zco( pht, pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d,   &            ! in : 1D reference vertical coordinate
222      &                pdept   , pdepw   ,                     &                 ! out: 3D t & w-points depth
223      &                pe3t    , pe3u    , pe3v , pe3f,        &                 ! out: 3D vertical scale factors
224      &                pe3w    , pe3uw   , pe3vw,              &                 !          -      -      -
225      &                pk_bot  , pk_top                      )                   ! out: 2D Top and bottom level arrays
226      !!----------------------------------------------------------------------
227      !!                  ***  ROUTINE zgr_zco  ***
228      !!
229      !! ** Purpose :   define the reference z-coordinate system
230      !!
231      !! ** Method  :   set 3D coord. arrays to reference 1D array
232      !!----------------------------------------------------------------------
233      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pht                         ! 1D grid-point depth       [m]
234      REAL(wp), DIMENSION(:)    , INTENT(in   ) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth       [m]
235      REAL(wp), DIMENSION(:)    , INTENT(in   ) ::   pe3t_1d , pe3w_1d           ! 1D vertical scale factors [m]
236      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdept, pdepw                ! 3D grid-point depth       [m]
237      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3t , pe3u , pe3v , pe3f   ! 3D vertical scale factors [m]
238      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3w , pe3uw, pe3vw         !    -       -      -
239      INTEGER , DIMENSION(:,:)  , INTENT(inout) ::   pk_bot, pk_top              ! 2D Top and bottom level arrays
240      !
241      INTEGER  ::   jk
242      !!----------------------------------------------------------------------
243      !
244      DO jk = 1, jpkm1
245         WHERE( pdept_1d(jk) < pht(:,:) .AND. pht(:,:) <= pdept_1d(jk+1) )   pk_bot(:,:) = jk * pk_top(:,:)
246      END DO
247      !                                !* horizontally uniform coordinate (reference z-co everywhere)
248      DO jk = 1, jpk
249         pdept(:,:,jk) = pdept_1d(jk)
250         pdepw(:,:,jk) = pdepw_1d(jk)
251         pe3t (:,:,jk) = pe3t_1d (jk)
252         pe3u (:,:,jk) = pe3t_1d (jk)
253         pe3v (:,:,jk) = pe3t_1d (jk)
254         pe3f (:,:,jk) = pe3t_1d (jk)
255         pe3w (:,:,jk) = pe3w_1d (jk)
256         pe3uw(:,:,jk) = pe3w_1d (jk)
257         pe3vw(:,:,jk) = pe3w_1d (jk)
258      END DO
259      !
260   END SUBROUTINE zgr_zco
261
262   SUBROUTINE zgr_zps( pht, pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d,   &            ! in : 1D reference vertical coordinate
263      &                pdept   , pdepw   ,                     &                 ! out: 3D t & w-points depth
264      &                pe3t    , pe3u    , pe3v , pe3f,        &                 ! out: 3D vertical scale factors
265      &                pe3w    , pe3uw   , pe3vw,              &                 !          -      -      -
266      &                pk_bot  , pk_top                      )                   ! out: 2D Top and bottom level arrays
267      !!----------------------------------------------------------------------
268      !!                  ***  ROUTINE zgr_zps  ***
269      !!
270      !! ** Purpose :   define the z-coordinate system
271      !!
272      !! ** Method  :   as per zco but with partial steps at lowest wet level
273      !!----------------------------------------------------------------------
274      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pht                         ! 1D grid-point depth       [m]
275      REAL(wp), DIMENSION(:)    , INTENT(in   ) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth       [m]
276      REAL(wp), DIMENSION(:)    , INTENT(in   ) ::   pe3t_1d , pe3w_1d           ! 1D vertical scale factors [m]
277      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdept, pdepw                ! 3D grid-point depth       [m]
278      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3t , pe3u , pe3v , pe3f   ! 3D vertical scale factors [m]
279      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3w , pe3uw, pe3vw         !    -       -      -
280      INTEGER , DIMENSION(:,:)  , INTENT(inout) ::   pk_bot, pk_top              ! 2D Top and bottom level arrays
281      !
282      INTEGER  ::   ji,jj,jk,ik
283      REAL(wp) ::   ze3min
284      !!----------------------------------------------------------------------
285      !
286      !
287      ze3min = 0.1_wp * rn_dz
288      IF(lwp) WRITE(numout,*) '   minimum thickness of the partial cells = 10 % of e3 = ', ze3min
289      !
290      !
291      !                                !* bottom ocean compute from the depth of grid-points
292      pk_bot(:,:) = jpkm1
293      DO jk = jpkm1, 1, -1
294         WHERE( pht(:,:) < pdepw_1d(jk) + ze3min )   pk_bot(:,:) = jk-1
295      END DO
296      !
297      !                                !* vertical coordinate system
298      DO jk = 1, jpk                      ! initialization to the reference z-coordinate
299         pdept(:,:,jk) = pdept_1d(jk)
300         pdepw(:,:,jk) = pdepw_1d(jk)
301         pe3t (:,:,jk) = pe3t_1d (jk)
302         pe3u (:,:,jk) = pe3t_1d (jk)
303         pe3v (:,:,jk) = pe3t_1d (jk)
304         pe3f (:,:,jk) = pe3t_1d (jk)
305         pe3w (:,:,jk) = pe3w_1d (jk)
306         pe3uw(:,:,jk) = pe3w_1d (jk)
307         pe3vw(:,:,jk) = pe3w_1d (jk)
308      END DO
309      DO jj = 1, jpj                      ! bottom scale factors and depth at T- and W-points
310         DO ji = 1, jpi
311            ik = pk_bot(ji,jj)
312               pdepw(ji,jj,ik+1) = MIN( pht(ji,jj) , pdepw_1d(ik+1) )
313               pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
314               pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  )
315               !
316               pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp
317               pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp
318               pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)              ! = pe3t (ji,jj,ik  )
319         END DO
320      END DO
321
322      ! Scale factors and depth at U-, V-, UW and VW-points
323      DO jk = 1, jpk                        ! initialisation to z-scale factors
324         e3u_0 (:,:,jk) = e3t_1d(jk)
325         e3v_0 (:,:,jk) = e3t_1d(jk)
326         e3uw_0(:,:,jk) = e3w_1d(jk)
327         e3vw_0(:,:,jk) = e3w_1d(jk)
328      END DO
329
330      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
331         DO jj = 1, jpjm1
332            DO ji = 1, jpim1   ! vector opt.
333               pe3u (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji+1,jj,jk) )
334               pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) )
335               pe3uw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji+1,jj,jk) )
336               pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) )
337            END DO
338         END DO
339      END DO
340      CALL lbc_lnk('domzgr', e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk('domzgr', e3uw_0, 'U', 1._wp )   ! lateral boundary conditions
341      CALL lbc_lnk('domzgr', e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk('domzgr', e3vw_0, 'V', 1._wp )
342      ! Scale factor at F-point
343      DO jk = 1, jpk                        ! initialisation to z-scale factors
344         e3f_0(:,:,jk) = e3t_1d(jk)
345      END DO
346      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors
347         DO jj = 1, jpjm1
348            DO ji = 1, jpim1   ! vector opt.
349               e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) )
350            END DO
351         END DO
352      END DO
353      CALL lbc_lnk('domzgr', e3f_0, 'F', 1._wp )       ! Lateral boundary conditions
354      !     
355      !
356   END SUBROUTINE zgr_zps
357
358   SUBROUTINE zgr_sco( pht,   &   ! in : reference bathymetry
359      &                pdept   , pdepw   ,                     &   ! out: 3D t & w-points depth
360      &                pe3t    , pe3u    , pe3v   , pe3f   ,   &   !      vertical scale factors
361      &                pe3w    , pe3uw   , pe3vw,              &   !
362      &                pk_bot  , pk_top                        )   !          -      -      -
363      !!----------------------------------------------------------------------
364      !!                  ***  ROUTINE zgr_sco  ***
365      !!
366      !! ** Purpose :   define the z-coordinate system
367      !!
368      !! ** Method  :   
369      !!----------------------------------------------------------------------
370      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pht                         ! 1D grid-point depth       [m]
371      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdept, pdepw                ! grid-point depth          [m]
372      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors    [m]
373      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3w , pe3uw, pe3vw         !    -       -      -
374      INTEGER , DIMENSION(:,:)  , INTENT(inout) ::   pk_bot, pk_top              !    -       -      -
375      !
376      INTEGER  ::   ji,jj,jk
377      REAL(wp) ::   z1_jpkm1, zmax
378      REAL(wp), DIMENSION(jpi, jpj) ::   zhu, zhv 
379      REAL(wp), DIMENSION(jpk) ::   sigt_1d, sigw_1d 
380      !!----------------------------------------------------------------------
381      !
382      DO jj = 1, jpjm1
383         DO ji = 1, jpim1
384         zhu(ji,jj) = 0.5_wp * ( pht(ji,jj) + pht(ji+1,jj) )
385         zhv(ji,jj) = 0.5_wp * ( pht(ji,jj) + pht(ji,jj+1) )
386         END DO
387      END DO
388      CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. )
389      CALL lbc_lnk( 'usrdef_zgr', zhv, 'V', 1. )
390      z1_jpkm1 = 1._wp / REAL( jpkm1 , wp)
391      DO jk = 1, jpk
392         sigt_1d(jk) = ( REAL (jk-1, wp) + 0.5_wp ) / REAL ( jpkm1 )
393         sigw_1d(jk) =   REAL (jk-1, wp)            / REAL ( jpkm1 )
394         IF( lwp ) WRITE(numout, *) 'sigt_1d(jk), sigw_1d(jk)', jk, sigt_1d(jk), sigw_1d(jk)
395      END DO
396      DO jj = 1, jpj
397         DO ji = 1, jpi
398            DO jk = 1, jpk
399               pdept(ji,jj,jk) = pht(ji,jj) * sigt_1d(jk)
400               pdepw(ji,jj,jk) = pht(ji,jj) * sigw_1d(jk)
401            END DO
402            DO jk = 1, jpkm1
403               pe3t (ji,jj,jk  ) = pdepw(ji,jj,jk+1) - pdepw(ji,jj,jk)
404               pe3w (ji,jj,jk+1) = pdept(ji,jj,jk+1) - pdept(ji,jj,jk)
405            END DO
406            pe3t (ji,jj,jpk) = 2._wp * ( pdept(ji,jj,jpk) - pdepw(ji,jj,jpk) )
407            pe3w (ji,jj,1  ) = 2._wp * ( pdept(ji,jj,1  ) - pdepw(ji,jj,1  ) )
408         END DO
409      END DO
410      DO jk = 1, jpk
411         DO jj = 1, jpjm1
412            DO ji = 1, jpim1
413               pe3u (ji,jj,jk) = 0.5_wp  * ( pe3t (ji,jj,jk)   + pe3t (ji+1,jj,  jk) )
414               pe3v (ji,jj,jk) = 0.5_wp  * ( pe3w (ji,jj,jk)   + pe3t (ji,jj+1,  jk) )
415               pe3uw(ji,jj,jk) = 0.5_wp  * ( pe3w (ji,jj,jk)   + pe3t (ji+1,jj,  jk) )
416               pe3vw(ji,jj,jk) = 0.5_wp  * ( pe3w (ji,jj,jk)   + pe3t (ji,jj+1,  jk) )
417               pe3f (ji,jj,jk) = 0.25 * ( pe3t (ji,jj,jk)   + pe3t (ji+1,jj,  jk) &
418                                     &  + pe3t (ji,jj+1,jk) + pe3t (ji+1,jj+1,jk) ) 
419            END DO
420         END DO
421      END DO
422      CALL lbc_lnk( 'usrdef_zgr', pdept, 'T', 1. )
423      CALL lbc_lnk( 'usrdef_zgr', pdepw, 'T', 1. )
424      CALL lbc_lnk( 'usrdef_zgr', pe3t , 'T', 1. )
425      CALL lbc_lnk( 'usrdef_zgr', pe3w , 'T', 1. )
426      CALL lbc_lnk( 'usrdef_zgr', pe3u , 'U', 1. )
427      CALL lbc_lnk( 'usrdef_zgr', pe3uw, 'U', 1. )
428      CALL lbc_lnk( 'usrdef_zgr', pe3f , 'F', 1. )
429      CALL lbc_lnk( 'usrdef_zgr', pe3v , 'V', 1. )
430      CALL lbc_lnk( 'usrdef_zgr', pe3vw, 'V', 1. )
431      WHERE( pe3t (:,:,:) == 0._wp )   pe3t (:,:,:) = 1._wp
432      WHERE( pe3u (:,:,:) == 0._wp )   pe3u (:,:,:) = 1._wp
433      WHERE( pe3v (:,:,:) == 0._wp )   pe3v (:,:,:) = 1._wp
434      WHERE( pe3f (:,:,:) == 0._wp )   pe3f (:,:,:) = 1._wp
435      WHERE( pe3w (:,:,:) == 0._wp )   pe3w (:,:,:) = 1._wp
436      WHERE( pe3uw(:,:,:) == 0._wp )   pe3uw(:,:,:) = 1._wp
437      WHERE( pe3vw(:,:,:) == 0._wp )   pe3vw(:,:,:) = 1._wp
438      !
439   END SUBROUTINE zgr_sco
440
441 
442
443   !!======================================================================
444END MODULE usrdef_zgr
Note: See TracBrowser for help on using the repository browser.