source: trunk/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_zgr.F90 @ 8018

Last change on this file since 8018 was 8018, checked in by flavoni, 4 years ago

add missing key iomput for GYRE_PISCES, and add needed values for ISOMIP when compiler checking bound activated

File size: 12.9 KB
Line 
1MODULE usrdef_zgr
2   !!======================================================================
3   !!                     ***  MODULE usrdef_zgr  ***
4   !!
5   !!                       ===  ISOMIP case  ===
6   !!
7   !! user defined :  vertical coordinate system of a user configuration
8   !!======================================================================
9   !! History :  4.0  ! 2016-08  (G. Madec,   S. Flavoni)  Original code
10   !!                 ! 2017-02  (P. Mathiot, S. Flavoni)  Adapt code to ISOMIP case
11   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   usr_def_zgr   : user defined vertical coordinate system (required)
15   !!       zgr_z1d   : reference 1D z-coordinate
16   !!---------------------------------------------------------------------
17   USE oce            ! ocean variables
18   USE dom_oce ,  ONLY: ln_zco, ln_zps, ln_sco          ! ocean space and time domain
19   USE dom_oce ,  ONLY: mj0   , mj1   , nimpp , njmpp   ! ocean space and time domain
20   USE dom_oce ,  ONLY: glamt , gphit                   ! ocean space and time domain
21   USE usrdef_nam     ! User defined : namelist variables
22   !
23   USE in_out_manager ! I/O manager
24   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
25   USE lib_mpp        ! distributed memory computing library
26   USE wrk_nemo       ! Memory allocation
27   USE timing         ! Timing
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   usr_def_zgr   ! called by domzgr.F90
33
34  !! * Substitutions
35#  include "vectopt_loop_substitute.h90"
36   !!----------------------------------------------------------------------
37   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
38   !! $Id$
39   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
40   !!----------------------------------------------------------------------
41CONTAINS             
42
43   SUBROUTINE usr_def_zgr( ld_zco  , ld_zps  , ld_sco  , ld_isfcav,    &   ! type of vertical coordinate
44      &                    pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d  ,    &   ! 1D reference vertical coordinate
45      &                    pdept , pdepw ,                             &   ! 3D t & w-points depth
46      &                    pe3t  , pe3u  , pe3v , pe3f ,               &   ! vertical scale factors
47      &                    pe3w  , pe3uw , pe3vw,                      &   !     -      -      -
48      &                    k_top  , k_bot    )                             ! top & bottom ocean level
49      !!---------------------------------------------------------------------
50      !!              ***  ROUTINE usr_def_zgr  ***
51      !!
52      !! ** Purpose :   User defined the vertical coordinates
53      !!
54      !!----------------------------------------------------------------------
55      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags
56      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag
57      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m]
58      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m]
59      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m]
60      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m]
61      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors
62      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level
63      !
64      INTEGER  ::   ji , jj, jk       ! dummy indices
65      INTEGER  ::   ij0, ij1          ! dummy indices 
66      INTEGER  ::   ik                ! local integers
67      REAL(wp) ::   zfact, z1_jpkm1   ! local scalar
68      REAL(wp) ::   ze3min, zdepth    ! local scalar
69      REAL(wp), DIMENSION(jpi,jpj) ::   zht  , zhu         ! bottom depth
70      REAL(wp), DIMENSION(jpi,jpj) ::   zhisf, zhisfu      ! top depth
71      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk 
72      REAL(wp), DIMENSION(jpi,jpj) ::   z2d                ! 2d workspace
73      !!----------------------------------------------------------------------
74      !
75      IF(lwp) WRITE(numout,*)
76      IF(lwp) WRITE(numout,*) 'usr_def_zgr : ISOMIP configuration (z(ps)- or s-coordinate closed box ocean without cavities)'
77      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
78      !
79      !
80      ! type of vertical coordinate
81      ! ---------------------------
82      ! set in usrdef_nam.F90 by reading the namusr_def namelist except for ISF
83      ln_zco    = .FALSE.      ! z-partial-step coordinate
84      ln_zps    = .TRUE.       ! z-partial-step coordinate
85      ln_sco    = .FALSE.      ! s-coordinate
86      ld_isfcav = .TRUE.       ! ISF Ice Shelves Flag
87      !
88      !
89      ! Build the vertical coordinate system
90      ! ------------------------------------
91      !
92      !                       !==  isfdraft  ==!
93      !
94      ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=0
95      z2d(:,:) = 1._wp                    ! surface ocean is the 1st level
96      CALL lbc_lnk( z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90)
97      zmsk(:,:) = NINT( z2d(:,:) )
98      !
99      !
100      zht  (:,:) = rbathy 
101      zhisf(:,:) = 200._wp
102      ij0 = 1 ; ij1 = 40
103      DO jj = mj0(ij0), mj1(ij1)
104         zhisf(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp
105      END DO
106      zhisf(:,:) = zhisf(:,:) * zmsk(:,:)
107      !
108      CALL zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! Reference z-coordinate system
109      !
110      !                       !==  top masked level bathymetry  ==!  (all coordinates)
111      !
112      IF ( ln_zps ) THEN      !==  zps-coordinate  ==!   (partial bottom-steps)
113         !
114         ze3min = 0.1_wp * rn_e3
115         IF(lwp) WRITE(numout,*) '   minimum thickness of the partial cells = 10 % of e3 = ', ze3min
116         !
117         !                                !* bottom ocean compute from the depth of grid-points
118         k_bot(:,:) = jpkm1
119         DO jk = jpkm1, 1, -1
120            WHERE( zht(:,:) < pdepw_1d(jk) + ze3min )   k_bot(:,:) = jk-1
121         END DO
122         !                                !* top ocean compute from the depth of grid-points
123         k_top(:,:) = 1                   !
124         DO jk = 2, jpkm1
125            zdepth = pdepw_1d(jk+1) - ze3min
126            WHERE( zhisf(:,:) > 0.0 .AND. zhisf(:,:) >= zdepth )   k_top(:,:) = (jk + 1) 
127         END DO
128         !
129         !                                   !* vertical coordinate system
130         DO jk = 1, jpk                      ! initialization to the reference z-coordinate
131            pdept(:,:,jk) = pdept_1d(jk)
132            pdepw(:,:,jk) = pdepw_1d(jk)
133            pe3t (:,:,jk) = pe3t_1d (jk)
134            pe3u (:,:,jk) = pe3t_1d (jk)
135            pe3v (:,:,jk) = pe3t_1d (jk)
136            pe3f (:,:,jk) = pe3t_1d (jk)
137            pe3w (:,:,jk) = pe3w_1d (jk)
138            pe3uw(:,:,jk) = pe3w_1d (jk)
139            pe3vw(:,:,jk) = pe3w_1d (jk)
140         END DO
141         DO jj = 1, jpj                      ! top scale factors and depth at T- and W-points
142            DO ji = 1, jpi
143               ik = k_top(ji,jj)
144               IF ( ik > 2 ) THEN
145                  ! pdeptw at the interface
146                  pdepw(ji,jj,ik  ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) )
147                  ! e3t in both side of the interface
148                  pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
149                  ! pdept in both side of the interface (from previous e3t)
150                  pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp
151                  pdept(ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pe3t (ji,jj,ik  ) * 0.5_wp
152                  ! pe3w on both side of the interface
153                  pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik  )
154                  pe3w (ji,jj,ik  ) = pdept(ji,jj,ik  ) - pdept(ji,jj,ik-1)
155                  ! e3t into the ice shelf
156                  pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pdepw(ji,jj,ik-1)
157               END IF
158            END DO
159         END DO         
160         DO jj = 1, jpj                      ! bottom scale factors and depth at T- and W-points
161            DO ji = 1, jpi
162               ik = k_bot(ji,jj)
163               pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) )
164               pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
165               pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  ) 
166               !
167               pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp
168               pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp
169               pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)
170            END DO
171         END DO         
172         !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points
173         DO jk = 1,jpkm1                     ! Computed as the minimum of neighbooring scale factors
174            DO jj = 1, jpjm1
175               DO ji = 1, fs_jpim1   ! vector opt.
176                  pe3u (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji+1,jj,jk) )
177                  pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) )
178                  pe3uw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji+1,jj,jk) )
179                  pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) )
180               END DO
181            END DO
182            DO jj = 1, jpjm1
183               DO ji = 1, fs_jpim1   ! vector opt.
184                 pe3f(ji,jj,jk) = MIN( pe3v(ji,jj,jk), pe3v(ji+1,jj,jk) )
185               END DO
186            END DO
187         END DO
188         CALL lbc_lnk( pe3u , 'U', 1._wp )   ;   CALL lbc_lnk( pe3uw, 'U', 1._wp )   ! lateral boundary conditions
189         CALL lbc_lnk( pe3v , 'V', 1._wp )   ;   CALL lbc_lnk( pe3vw, 'V', 1._wp )
190         CALL lbc_lnk( pe3f , 'F', 1._wp )
191         DO jk = 1,jpkm1
192            ! set to z-scale factor if zero (i.e. along closed boundaries) because of lbclnk
193            WHERE( pe3u (:,:,jk) == 0._wp )   pe3u (:,:,jk) = pe3t_1d(jk)
194            WHERE( pe3v (:,:,jk) == 0._wp )   pe3v (:,:,jk) = pe3t_1d(jk)
195            WHERE( pe3uw(:,:,jk) == 0._wp )   pe3uw(:,:,jk) = pe3w_1d(jk)
196            WHERE( pe3vw(:,:,jk) == 0._wp )   pe3vw(:,:,jk) = pe3w_1d(jk)
197         END DO
198         !
199      ENDIF
200      !
201   END SUBROUTINE usr_def_zgr
202
203
204   SUBROUTINE zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! 1D reference vertical coordinate
205      !!----------------------------------------------------------------------
206      !!                   ***  ROUTINE zgr_z1d  ***
207      !!
208      !! ** Purpose :   set the depth of model levels and the resulting
209      !!      vertical scale factors.
210      !!
211      !! ** Method  :   1D z-coordinate system (use in all type of coordinate)
212      !!       The depth of model levels is set from dep(k), an analytical function:
213      !!                   w-level: depw_1d  = dep(k)
214      !!                   t-level: dept_1d  = dep(k+0.5)
215      !!       The scale factors are the discrete derivative of the depth:
216      !!                   e3w_1d(jk) = dk[ dept_1d ]
217      !!                   e3t_1d(jk) = dk[ depw_1d ]
218      !!
219      !!            ===    Here constant vertical resolution   ===
220      !!
221      !! ** Action  : - pdept_1d, pdepw_1d : depth of T- and W-point (m)
222      !!              - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
223      !!----------------------------------------------------------------------
224      REAL(wp), DIMENSION(:), INTENT(out) ::   pdept_1d, pdepw_1d   ! 1D grid-point depth        [m]
225      REAL(wp), DIMENSION(:), INTENT(out) ::   pe3t_1d , pe3w_1d    ! 1D vertical scale factors  [m]
226      !
227      INTEGER  ::   jk       ! dummy loop indices
228      REAL(wp) ::   zt, zw   ! local scalar
229      !!----------------------------------------------------------------------
230      !
231      IF(lwp) THEN                         ! Parameter print
232         WRITE(numout,*)
233         WRITE(numout,*) '    zgr_z1d : Reference vertical z-coordinates: uniform dz = ', rn_e3
234         WRITE(numout,*) '    ~~~~~~~'
235      ENDIF
236      !
237      ! Reference z-coordinate (depth - scale factor at T- and W-points)   ! Madec & Imbard 1996 function
238      ! ----------------------
239      DO jk = 1, jpk
240         zw = REAL( jk , wp )
241         zt = REAL( jk , wp ) + 0.5_wp
242         pdepw_1d(jk) =    rn_e3 *   REAL( jk-1 , wp )
243         pdept_1d(jk) =    rn_e3 * ( REAL( jk-1 , wp ) + 0.5_wp )
244         pe3w_1d (jk) =    rn_e3
245         pe3t_1d (jk) =    rn_e3
246      END DO
247      !
248      IF(lwp) THEN                        ! control print
249         WRITE(numout,*)
250         WRITE(numout,*) '              Reference 1D z-coordinate depth and scale factors:'
251         WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
252         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk )
253      ENDIF
254      !
255   END SUBROUTINE zgr_z1d
256   
257   !!======================================================================
258END MODULE usrdef_zgr
Note: See TracBrowser for help on using the repository browser.