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.
zdfmxl.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/ZDF – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 5 years ago

The Dr Hook changes from my perl code.

File size: 24.3 KB
Line 
1MODULE zdfmxl
2   !!======================================================================
3   !!                       ***  MODULE  zdfmxl  ***
4   !! Ocean physics: mixed layer depth
5   !!======================================================================
6   !! History :  1.0  ! 2003-08  (G. Madec)  original code
7   !!            3.2  ! 2009-07  (S. Masson, G. Madec)  IOM + merge of DO-loop
8   !!            3.7  ! 2012-03  (G. Madec)  make public the density criteria for trdmxl
9   !!             -   ! 2014-02  (F. Roquet)  mixed layer depth calculated using N2 instead of rhop
10   !!----------------------------------------------------------------------
11   !!   zdf_mxl      : Compute the turbocline and mixed layer depths.
12   !!----------------------------------------------------------------------
13   USE oce             ! ocean dynamics and tracers variables
14   USE dom_oce         ! ocean space and time domain variables
15   USE zdf_oce         ! ocean vertical physics
16   USE in_out_manager  ! I/O manager
17   USE prtctl          ! Print control
18   USE phycst          ! physical constants
19   USE iom             ! I/O library
20   USE eosbn2          ! for zdf_mxl_zint
21   USE lib_mpp         ! MPP library
22   USE wrk_nemo        ! work arrays
23   USE timing          ! Timing
24   USE trc_oce, ONLY : lk_offline ! offline flag
25
26   USE yomhook, ONLY: lhook, dr_hook
27   USE parkind1, ONLY: jprb, jpim
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   zdf_mxl       ! called by step.F90
33   PUBLIC   zdf_mxl_alloc ! Used in zdf_tke_init
34
35   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP)
36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m]
37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m]
38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: mixed layer depth at t-points        [m]
39   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:,:) ::   hmld_zint  !: vertically-interpolated mixed layer depth   [m]
40   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:,:) ::   htc_mld    ! Heat content of hmld_zint
41   LOGICAL, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)    :: ll_found   ! Is T_b to be found by interpolation ?
42   LOGICAL, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: ll_belowml ! Flag points below mixed layer when ll_found=F
43
44   REAL(wp), PUBLIC ::   rho_c = 0.01_wp    !: density criterion for mixed layer depth
45   REAL(wp)         ::   avt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth
46
47   TYPE, PUBLIC :: MXL_ZINT   !: Structure for MLD defs
48      INTEGER   :: mld_type   ! mixed layer type     
49      REAL(wp)  :: zref       ! depth of initial T_ref
50      REAL(wp)  :: dT_crit    ! Critical temp diff
51      REAL(wp)  :: iso_frac   ! Fraction of rn_dT_crit used
52   END TYPE MXL_ZINT
53
54   !! * Substitutions
55#  include "domzgr_substitute.h90"
56   !!----------------------------------------------------------------------
57   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
58   !! $Id$
59   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
60   !!----------------------------------------------------------------------
61CONTAINS
62
63   INTEGER FUNCTION zdf_mxl_alloc()
64   INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
65   INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
66   REAL(KIND=jprb)               :: zhook_handle
67
68   CHARACTER(LEN=*), PARAMETER :: RoutineName='ZDF_MXL_ALLOC'
69
70   IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
71
72      !!----------------------------------------------------------------------
73      !!               ***  FUNCTION zdf_mxl_alloc  ***
74      !!----------------------------------------------------------------------
75      zdf_mxl_alloc = 0      ! set to zero if no array to be allocated
76      IF( .NOT. ALLOCATED( nmln ) ) THEN
77         ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), hmld_zint(jpi,jpj),       &
78        &          htc_mld(jpi,jpj),                                                                    &
79        &          ll_found(jpi,jpj), ll_belowml(jpi,jpj,jpk), STAT= zdf_mxl_alloc )
80         !
81         IF( lk_mpp             )   CALL mpp_sum ( zdf_mxl_alloc )
82         IF( zdf_mxl_alloc /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.')
83         !
84      ENDIF
85   IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
86   END FUNCTION zdf_mxl_alloc
87
88
89   SUBROUTINE zdf_mxl( kt )
90      !!----------------------------------------------------------------------
91      !!                  ***  ROUTINE zdfmxl  ***
92      !!                   
93      !! ** Purpose :   Compute the turbocline depth and the mixed layer depth
94      !!              with density criteria.
95      !!
96      !! ** Method  :   The mixed layer depth is the shallowest W depth with
97      !!      the density of the corresponding T point (just bellow) bellow a
98      !!      given value defined locally as rho(10m) + rho_c
99      !!               The turbocline depth is the depth at which the vertical
100      !!      eddy diffusivity coefficient (resulting from the vertical physics
101      !!      alone, not the isopycnal part, see trazdf.F) fall below a given
102      !!      value defined locally (avt_c here taken equal to 5 cm/s2 by default)
103      !!
104      !! ** Action  :   nmln, hmld, hmlp, hmlpt
105      !!----------------------------------------------------------------------
106      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
107      !
108      INTEGER  ::   ji, jj, jk      ! dummy loop indices
109      INTEGER  ::   iikn, iiki, ikt ! local integer
110      REAL(wp) ::   zN2_c           ! local scalar
111      INTEGER, POINTER, DIMENSION(:,:) ::   imld   ! 2D workspace
112      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
113      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
114      REAL(KIND=jprb)               :: zhook_handle
115
116      CHARACTER(LEN=*), PARAMETER :: RoutineName='ZDF_MXL'
117
118      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
119
120      !!----------------------------------------------------------------------
121      !
122      IF( nn_timing == 1 )  CALL timing_start('zdf_mxl')
123      !
124      CALL wrk_alloc( jpi,jpj, imld )
125
126      IF( kt <= nit000 ) THEN
127         IF(lwp) WRITE(numout,*)
128         IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth'
129         IF(lwp) WRITE(numout,*) '~~~~~~~ '
130         !                             ! allocate zdfmxl arrays
131         IF( zdf_mxl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl : unable to allocate arrays' )
132      ENDIF
133
134      ! w-level of the mixing and mixed layers
135      nmln(:,:)  = nlb10               ! Initialization to the number of w ocean point
136      hmlp(:,:)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2
137      zN2_c = grav * rho_c * r1_rau0   ! convert density criteria into N^2 criteria
138      DO jk = nlb10, jpkm1
139         DO jj = 1, jpj                ! Mixed layer level: w-level
140            DO ji = 1, jpi
141               ikt = mbkt(ji,jj)
142               hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * fse3w(ji,jj,jk)
143               IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level
144            END DO
145         END DO
146      END DO
147      !
148      ! w-level of the turbocline
149      imld(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point
150      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10
151         DO jj = 1, jpj
152            DO ji = 1, jpi
153               IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline
154            END DO
155         END DO
156      END DO
157      ! depth of the mixing and mixed layers
158      DO jj = 1, jpj
159         DO ji = 1, jpi
160            iiki = imld(ji,jj)
161            iikn = nmln(ji,jj)
162            hmld (ji,jj) = fsdepw(ji,jj,iiki  ) * ssmask(ji,jj)    ! Turbocline depth
163            hmlp (ji,jj) = fsdepw(ji,jj,iikn  ) * ssmask(ji,jj)    ! Mixed layer depth
164            hmlpt(ji,jj) = fsdept(ji,jj,iikn-1) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer
165         END DO
166      END DO
167      ! no need to output in offline mode
168      IF( .NOT.lk_offline ) THEN   
169         IF ( iom_use("mldr10_1") ) THEN
170            IF( ln_isfcav ) THEN
171               CALL iom_put( "mldr10_1", hmlp - risfdep)   ! mixed layer thickness
172            ELSE
173               CALL iom_put( "mldr10_1", hmlp )            ! mixed layer depth
174            END IF
175         END IF
176         IF ( iom_use("mldkz5") ) THEN
177            IF( ln_isfcav ) THEN
178               CALL iom_put( "mldkz5"  , hmld - risfdep )   ! turbocline thickness
179            ELSE
180               CALL iom_put( "mldkz5"  , hmld )             ! turbocline depth
181            END IF
182         END IF
183      ENDIF
184     
185      ! Vertically-interpolated mixed-layer depth diagnostic
186      CALL zdf_mxl_zint( kt )
187
188      IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 )
189      !
190      CALL wrk_dealloc( jpi,jpj, imld )
191      !
192      IF( nn_timing == 1 )  CALL timing_stop('zdf_mxl')
193      !
194      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
195   END SUBROUTINE zdf_mxl
196
197   SUBROUTINE zdf_mxl_zint_mld( sf ) 
198      !!----------------------------------------------------------------------------------
199      !!                    ***  ROUTINE zdf_mxl_zint_mld  ***
200      !                                                                       
201      !   Calculate vertically-interpolated mixed layer depth diagnostic.
202      !           
203      !   This routine can calculate the mixed layer depth diagnostic suggested by
204      !   Kara et al, 2000, JGR, 105, 16803, but is more general and can calculate
205      !   vertically-interpolated mixed-layer depth diagnostics with other parameter
206      !   settings set in the namzdf_mldzint namelist. 
207      !
208      !   If mld_type=1 the mixed layer depth is calculated as the depth at which the 
209      !   density has increased by an amount equivalent to a temperature difference of 
210      !   0.8C at the surface.
211      !
212      !   For other values of mld_type the mixed layer is calculated as the depth at 
213      !   which the temperature differs by 0.8C from the surface temperature. 
214      !                                                                       
215      !   David Acreman, Daley Calvert                                     
216      !
217      !!-----------------------------------------------------------------------------------
218
219      TYPE(MXL_ZINT), INTENT(in)  :: sf
220
221      ! Diagnostic criteria
222      INTEGER   :: nn_mld_type   ! mixed layer type     
223      REAL(wp)  :: rn_zref       ! depth of initial T_ref
224      REAL(wp)  :: rn_dT_crit    ! Critical temp diff
225      REAL(wp)  :: rn_iso_frac   ! Fraction of rn_dT_crit used
226
227      ! Local variables
228      REAL(wp), PARAMETER :: zepsilon = 1.e-30          ! local small value
229      INTEGER, POINTER, DIMENSION(:,:) :: ikmt          ! number of active tracer levels
230      INTEGER, POINTER, DIMENSION(:,:) :: ik_ref        ! index of reference level
231      INTEGER, POINTER, DIMENSION(:,:) :: ik_iso        ! index of last uniform temp level
232      REAL, POINTER, DIMENSION(:,:,:)  :: zT            ! Temperature or density
233      REAL, POINTER, DIMENSION(:,:)    :: ppzdep        ! depth for use in calculating d(rho)
234      REAL, POINTER, DIMENSION(:,:)    :: zT_ref        ! reference temperature
235      REAL    :: zT_b                                   ! base temperature
236      REAL, POINTER, DIMENSION(:,:,:)  :: zdTdz         ! gradient of zT
237      REAL, POINTER, DIMENSION(:,:,:)  :: zmoddT        ! Absolute temperature difference
238      REAL    :: zdz                                    ! depth difference
239      REAL    :: zdT                                    ! temperature difference
240      REAL, POINTER, DIMENSION(:,:)    :: zdelta_T      ! difference critereon
241      REAL, POINTER, DIMENSION(:,:)    :: zRHO1, zRHO2  ! Densities
242      INTEGER :: ji, jj, jk                             ! loop counter
243      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
244      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
245      REAL(KIND=jprb)               :: zhook_handle
246
247      CHARACTER(LEN=*), PARAMETER :: RoutineName='ZDF_MXL_ZINT_MLD'
248
249      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
250
251
252      !!-------------------------------------------------------------------------------------
253     
254      CALL wrk_alloc( jpi, jpj, ikmt, ik_ref, ik_iso) 
255      CALL wrk_alloc( jpi, jpj, ppzdep, zT_ref, zdelta_T, zRHO1, zRHO2 ) 
256      CALL wrk_alloc( jpi, jpj, jpk, zT, zdTdz, zmoddT ) 
257
258      ! Unpack structure
259      nn_mld_type = sf%mld_type
260      rn_zref     = sf%zref
261      rn_dT_crit  = sf%dT_crit
262      rn_iso_frac = sf%iso_frac
263
264      ! Set the mixed layer depth criterion at each grid point
265      IF( nn_mld_type == 0 ) THEN
266         zdelta_T(:,:) = rn_dT_crit
267         zT(:,:,:) = rhop(:,:,:)
268      ELSE IF( nn_mld_type == 1 ) THEN
269         ppzdep(:,:)=0.0 
270         call eos ( tsn(:,:,1,:), ppzdep(:,:), zRHO1(:,:) ) 
271! Use zT temporarily as a copy of tsn with rn_dT_crit added to SST
272! [assumes number of tracers less than number of vertical levels]
273         zT(:,:,1:jpts)=tsn(:,:,1,1:jpts) 
274         zT(:,:,jp_tem)=zT(:,:,1)+rn_dT_crit 
275         CALL eos( zT(:,:,1:jpts), ppzdep(:,:), zRHO2(:,:) ) 
276         zdelta_T(:,:) = abs( zRHO1(:,:) - zRHO2(:,:) ) * rau0 
277         ! RHO from eos (2d version) doesn't calculate north or east halo:
278         CALL lbc_lnk( zdelta_T, 'T', 1. ) 
279         zT(:,:,:) = rhop(:,:,:) 
280      ELSE
281         zdelta_T(:,:) = rn_dT_crit                     
282         zT(:,:,:) = tsn(:,:,:,jp_tem)                           
283      END IF 
284
285      ! Calculate the gradient of zT and absolute difference for use later
286      DO jk = 1 ,jpk-2 
287         zdTdz(:,:,jk)  =    ( zT(:,:,jk+1) - zT(:,:,jk) ) / fse3w(:,:,jk+1) 
288         zmoddT(:,:,jk) = abs( zT(:,:,jk+1) - zT(:,:,jk) ) 
289      END DO 
290
291      ! Find density/temperature at the reference level (Kara et al use 10m).         
292      ! ik_ref is the index of the box centre immediately above or at the reference level
293      ! Find rn_zref in the array of model level depths and find the ref   
294      ! density/temperature by linear interpolation.                                   
295      DO jk = jpkm1, 2, -1 
296         WHERE ( fsdept(:,:,jk) > rn_zref ) 
297           ik_ref(:,:) = jk - 1 
298           zT_ref(:,:) = zT(:,:,jk-1) + zdTdz(:,:,jk-1) * ( rn_zref - fsdept(:,:,jk-1) ) 
299         END WHERE
300      END DO 
301
302      ! If the first grid box centre is below the reference level then use the
303      ! top model level to get zT_ref
304      WHERE ( fsdept(:,:,1) > rn_zref ) 
305         zT_ref = zT(:,:,1) 
306         ik_ref = 1 
307      END WHERE 
308
309      ! The number of active tracer levels is 1 less than the number of active w levels
310      ikmt(:,:) = mbathy(:,:) - 1 
311
312      ! Initialize / reset
313      ll_found(:,:) = .false.
314
315      IF ( rn_iso_frac - zepsilon > 0. ) THEN
316         ! Search for a uniform density/temperature region where adjacent levels         
317         ! differ by less than rn_iso_frac * deltaT.                                     
318         ! ik_iso is the index of the last level in the uniform layer 
319         ! ll_found indicates whether the mixed layer depth can be found by interpolation
320         ik_iso(:,:)   = ik_ref(:,:) 
321         DO jj = 1, nlcj 
322            DO ji = 1, nlci 
323!CDIR NOVECTOR
324               DO jk = ik_ref(ji,jj), ikmt(ji,jj)-1 
325                  IF ( zmoddT(ji,jj,jk) > ( rn_iso_frac * zdelta_T(ji,jj) ) ) THEN
326                     ik_iso(ji,jj)   = jk 
327                     ll_found(ji,jj) = ( zmoddT(ji,jj,jk) > zdelta_T(ji,jj) ) 
328                     EXIT
329                  END IF
330               END DO
331            END DO
332         END DO 
333
334         ! Use linear interpolation to find depth of mixed layer base where possible
335         hmld_zint(:,:) = rn_zref 
336         DO jj = 1, jpj 
337            DO ji = 1, jpi 
338               IF (ll_found(ji,jj) .and. tmask(ji,jj,1) == 1.0) THEN
339                  zdz =  abs( zdelta_T(ji,jj) / zdTdz(ji,jj,ik_iso(ji,jj)) ) 
340                  hmld_zint(ji,jj) = fsdept(ji,jj,ik_iso(ji,jj)) + zdz 
341               END IF
342            END DO
343         END DO
344      END IF
345
346      ! If ll_found = .false. then calculate MLD using difference of zdelta_T   
347      ! from the reference density/temperature
348 
349! Prevent this section from working on land points
350      WHERE ( tmask(:,:,1) /= 1.0 ) 
351         ll_found = .true. 
352      END WHERE
353 
354      DO jk=1, jpk 
355         ll_belowml(:,:,jk) = abs( zT(:,:,jk) - zT_ref(:,:) ) >= zdelta_T(:,:) 
356      END DO 
357 
358! Set default value where interpolation cannot be used (ll_found=false) 
359      DO jj = 1, jpj 
360         DO ji = 1, jpi 
361            IF ( .not. ll_found(ji,jj) )  hmld_zint(ji,jj) = fsdept(ji,jj,ikmt(ji,jj)) 
362         END DO
363      END DO
364
365      DO jj = 1, jpj 
366         DO ji = 1, jpi 
367!CDIR NOVECTOR
368            DO jk = ik_ref(ji,jj)+1, ikmt(ji,jj) 
369               IF ( ll_found(ji,jj) ) EXIT
370               IF ( ll_belowml(ji,jj,jk) ) THEN               
371                  zT_b = zT_ref(ji,jj) + zdelta_T(ji,jj) * SIGN(1.0, zdTdz(ji,jj,jk-1) ) 
372                  zdT  = zT_b - zT(ji,jj,jk-1)                                     
373                  zdz  = zdT / zdTdz(ji,jj,jk-1)                                       
374                  hmld_zint(ji,jj) = fsdept(ji,jj,jk-1) + zdz 
375                  EXIT                                                   
376               END IF
377            END DO
378         END DO
379      END DO
380
381      hmld_zint(:,:) = hmld_zint(:,:)*tmask(:,:,1) 
382     
383      CALL wrk_dealloc( jpi, jpj, ikmt, ik_ref, ik_iso) 
384      CALL wrk_dealloc( jpi, jpj, ppzdep, zT_ref, zdelta_T, zRHO1, zRHO2 ) 
385      CALL wrk_dealloc( jpi,jpj, jpk, zT, zdTdz, zmoddT ) 
386      !
387      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
388   END SUBROUTINE zdf_mxl_zint_mld
389
390   SUBROUTINE zdf_mxl_zint_htc( kt )
391      !!----------------------------------------------------------------------
392      !!                  ***  ROUTINE zdf_mxl_zint_htc  ***
393      !!
394      !! ** Purpose :   
395      !!
396      !! ** Method  :   
397      !!----------------------------------------------------------------------
398
399      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
400
401      INTEGER :: ji, jj, jk
402      INTEGER :: ikmax
403      REAL(wp) :: zc, zcoef
404      !
405      INTEGER,  ALLOCATABLE, DIMENSION(:,:) ::   ilevel
406      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zthick_0, zthick
407      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
408      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
409      REAL(KIND=jprb)               :: zhook_handle
410
411      CHARACTER(LEN=*), PARAMETER :: RoutineName='ZDF_MXL_ZINT_HTC'
412
413      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
414
415
416      !!----------------------------------------------------------------------
417
418      IF( .NOT. ALLOCATED(ilevel) ) THEN
419         ALLOCATE( ilevel(jpi,jpj), zthick_0(jpi,jpj), &
420         &         zthick(jpi,jpj), STAT=ji )
421         IF( lk_mpp  )   CALL mpp_sum(ji)
422         IF( ji /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl_zint_htc : unable to allocate arrays' )
423      ENDIF
424
425      ! Find last whole model T level above the MLD
426      ilevel(:,:)   = 0
427      zthick_0(:,:) = 0._wp
428
429      DO jk = 1, jpkm1 
430         DO jj = 1, jpj
431            DO ji = 1, jpi                   
432               zthick_0(ji,jj) = zthick_0(ji,jj) + fse3t(ji,jj,jk)
433               IF( zthick_0(ji,jj) < hmld_zint(ji,jj) )   ilevel(ji,jj) = jk
434            END DO
435         END DO
436         WRITE(numout,*) 'zthick_0(jk =',jk,') =',zthick_0(2,2)
437         WRITE(numout,*) 'fsdepw(jk+1 =',jk+1,') =',fsdepw(2,2,jk+1)
438      END DO
439
440      ! Surface boundary condition
441      IF( lk_vvl ) THEN   ;   zthick(:,:) = 0._wp       ;   htc_mld(:,:) = 0._wp                                   
442      ELSE                ;   zthick(:,:) = sshn(:,:)   ;   htc_mld(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1)   
443      ENDIF
444
445      ! Deepest whole T level above the MLD
446      ikmax = MIN( MAXVAL( ilevel(:,:) ), jpkm1 )
447
448      ! Integration down to last whole model T level
449      DO jk = 1, ikmax
450         DO jj = 1, jpj
451            DO ji = 1, jpi
452               zc = fse3t(ji,jj,jk) * REAL( MIN( MAX( 0, ilevel(ji,jj) - jk + 1 ) , 1  )  )    ! 0 below ilevel
453               zthick(ji,jj) = zthick(ji,jj) + zc
454               htc_mld(ji,jj) = htc_mld(ji,jj) + zc * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
455            END DO
456         END DO
457      END DO
458
459      ! Subsequent partial T level
460      zthick(:,:) = hmld_zint(:,:) - zthick(:,:)   !   remaining thickness to reach MLD
461
462      DO jj = 1, jpj
463         DO ji = 1, jpi
464            htc_mld(ji,jj) = htc_mld(ji,jj) + tsn(ji,jj,ilevel(ji,jj)+1,jp_tem)  & 
465      &                      * MIN( fse3t(ji,jj,ilevel(ji,jj)+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel(ji,jj)+1)
466         END DO
467      END DO
468
469      WRITE(numout,*) 'htc_mld(after) =',htc_mld(2,2)
470
471      ! Convert to heat content
472      zcoef = rau0 * rcp
473      htc_mld(:,:) = zcoef * htc_mld(:,:)
474
475      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
476   END SUBROUTINE zdf_mxl_zint_htc
477
478   SUBROUTINE zdf_mxl_zint( kt )
479      !!----------------------------------------------------------------------
480      !!                  ***  ROUTINE zdf_mxl_zint  ***
481      !!
482      !! ** Purpose :   
483      !!
484      !! ** Method  :   
485      !!----------------------------------------------------------------------
486
487      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
488
489      INTEGER :: ios
490      INTEGER :: jn
491
492      INTEGER :: nn_mld_diag = 0    ! number of diagnostics
493
494      CHARACTER(len=1) :: cmld
495
496      TYPE(MXL_ZINT) :: sn_mld1, sn_mld2, sn_mld3, sn_mld4, sn_mld5
497      TYPE(MXL_ZINT), SAVE, DIMENSION(5) ::   mld_diags
498
499      NAMELIST/namzdf_mldzint/ nn_mld_diag, sn_mld1, sn_mld2, sn_mld3, sn_mld4, sn_mld5
500      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
501      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
502      REAL(KIND=jprb)               :: zhook_handle
503
504      CHARACTER(LEN=*), PARAMETER :: RoutineName='ZDF_MXL_ZINT'
505
506      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
507
508
509      !!----------------------------------------------------------------------
510     
511      IF( kt == nit000 ) THEN
512         REWIND( numnam_ref )              ! Namelist namzdf_mldzint in reference namelist
513         READ  ( numnam_ref, namzdf_mldzint, IOSTAT = ios, ERR = 901)
514901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_mldzint in reference namelist', lwp )
515
516         REWIND( numnam_cfg )              ! Namelist namzdf_mldzint in configuration namelist
517         READ  ( numnam_cfg, namzdf_mldzint, IOSTAT = ios, ERR = 902 )
518902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_mldzint in configuration namelist', lwp )
519         IF(lwm) WRITE ( numond, namzdf_mldzint )
520
521         IF( nn_mld_diag > 5 )   CALL ctl_stop( 'STOP', 'zdf_mxl_ini: Specify no more than 5 MLD definitions' )
522
523         mld_diags(1) = sn_mld1
524         mld_diags(2) = sn_mld2
525         mld_diags(3) = sn_mld3
526         mld_diags(4) = sn_mld4
527         mld_diags(5) = sn_mld5
528
529         IF( lwp .AND. (nn_mld_diag > 0) ) THEN
530            WRITE(numout,*) '=============== Vertically-interpolated mixed layer ================'
531            WRITE(numout,*) '(Diagnostic number, nn_mld_type, rn_zref, rn_dT_crit, rn_iso_frac)'
532            DO jn = 1, nn_mld_diag
533               WRITE(numout,*) 'MLD criterion',jn,':'
534               WRITE(numout,*) '    nn_mld_type =', mld_diags(jn)%mld_type
535               WRITE(numout,*) '    rn_zref ='    , mld_diags(jn)%zref
536               WRITE(numout,*) '    rn_dT_crit =' , mld_diags(jn)%dT_crit
537               WRITE(numout,*) '    rn_iso_frac =', mld_diags(jn)%iso_frac
538            END DO
539            WRITE(numout,*) '===================================================================='
540         ENDIF
541      ENDIF
542
543      IF( nn_mld_diag > 0 ) THEN
544         DO jn = 1, nn_mld_diag
545            WRITE(cmld,'(I1)') jn
546            IF( iom_use( "mldzint_"//cmld ) .OR. iom_use( "mldhtc_"//cmld ) ) THEN
547               CALL zdf_mxl_zint_mld( mld_diags(jn) )
548
549               IF( iom_use( "mldzint_"//cmld ) ) THEN
550                  CALL iom_put( "mldzint_"//cmld, hmld_zint(:,:) )
551               ENDIF
552
553               IF( iom_use( "mldhtc_"//cmld ) )  THEN
554                  CALL zdf_mxl_zint_htc( kt )
555                  CALL iom_put( "mldhtc_"//cmld , htc_mld(:,:)   )
556               ENDIF
557            ENDIF
558         END DO
559      ENDIF
560
561      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
562   END SUBROUTINE zdf_mxl_zint
563
564   !!======================================================================
565END MODULE zdfmxl
Note: See TracBrowser for help on using the repository browser.