source: NEMO/branches/2019/dev_r12072_TOP-01_ENHANCE-11_CEthe/src/OCE/DIA/diahth.F90 @ 12109

Last change on this file since 12109 was 12109, checked in by cetlod, 4 months ago

check out & merge dev_r11643_ENHANCE-11_CEthe_Shaconemo_diags branch onto dev_r12072_TOP-01_ENHANCE-11_CEthe

  • Property svn:keywords set to Id
File size: 18.7 KB
Line 
1MODULE diahth
2   !!======================================================================
3   !!                       ***  MODULE  diahth  ***
4   !! Ocean diagnostics: thermocline and 20 degree depth
5   !!======================================================================
6   !! History :  OPA  !  1994-09  (J.-P. Boulanger)  Original code
7   !!                 !  1996-11  (E. Guilyardi)  OPA8
8   !!                 !  1997-08  (G. Madec)  optimization
9   !!                 !  1999-07  (E. Guilyardi)  hd28 + heat content
10   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
11   !!            3.2  !  2009-07  (S. Masson) hc300 bugfix + cleaning + add new diag
12   !!----------------------------------------------------------------------
13   !!   dia_hth      : Compute varius diagnostics associated with the mixed layer
14   !!----------------------------------------------------------------------
15   USE oce             ! ocean dynamics and tracers
16   USE dom_oce         ! ocean space and time domain
17   USE phycst          ! physical constants
18   !
19   USE in_out_manager  ! I/O manager
20   USE lib_mpp         ! MPP library
21   USE iom             ! I/O library
22   USE timing          ! preformance summary
23
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC   dia_hth       ! routine called by step.F90
28   PUBLIC   dia_hth_alloc ! routine called by nemogcm.F90
29
30   LOGICAL, SAVE  ::   l_hth     !: thermocline-20d depths flag
31   
32   ! note: following variables should move to local variables once iom_put is always used
33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hth    !: depth of the max vertical temperature gradient [m]
34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd20   !: depth of 20 C isotherm                         [m]
35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd26   !: depth of 26 C isotherm                         [m]
36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd28   !: depth of 28 C isotherm                         [m]
37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc3   !: heat content of first 300 m                    [W]
38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc7   !: heat content of first 700 m                    [W]
39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc20  !: heat content of first 2000 m                   [W]
40
41
42   !!----------------------------------------------------------------------
43   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
44   !! $Id$
45   !! Software governed by the CeCILL license (see ./LICENSE)
46   !!----------------------------------------------------------------------
47CONTAINS
48
49   FUNCTION dia_hth_alloc()
50      !!---------------------------------------------------------------------
51      INTEGER :: dia_hth_alloc
52      !!---------------------------------------------------------------------
53      !
54      ALLOCATE( hth(jpi,jpj), hd20(jpi,jpj), hd26(jpi,jpj), hd28(jpi,jpj), &
55         &      htc3(jpi,jpj), htc7(jpi,jpj), htc20(jpi,jpj), STAT=dia_hth_alloc )
56      !
57      CALL mpp_sum ( 'diahth', dia_hth_alloc )
58      IF(dia_hth_alloc /= 0)   CALL ctl_stop( 'STOP', 'dia_hth_alloc: failed to allocate arrays.' )
59      !
60   END FUNCTION dia_hth_alloc
61
62
63   SUBROUTINE dia_hth( kt )
64      !!---------------------------------------------------------------------
65      !!                  ***  ROUTINE dia_hth  ***
66      !!
67      !! ** Purpose : Computes
68      !!      the mixing layer depth (turbocline): avt = 5.e-4
69      !!      the depth of strongest vertical temperature gradient
70      !!      the mixed layer depth with density     criteria: rho = rho(10m or surf) + 0.03(or 0.01)
71      !!      the mixed layer depth with temperature criteria: abs( tn - tn(10m) ) = 0.2       
72      !!      the top of the thermochine: tn = tn(10m) - ztem2
73      !!      the pycnocline depth with density criteria equivalent to a temperature variation
74      !!                rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)
75      !!      the barrier layer thickness
76      !!      the maximal verical inversion of temperature and its depth max( 0, max of tn - tn(10m) )
77      !!      the depth of the 20 degree isotherm (linear interpolation)
78      !!      the depth of the 28 degree isotherm (linear interpolation)
79      !!      the heat content of first 300 m
80      !!
81      !! ** Method :
82      !!-------------------------------------------------------------------
83      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
84      !!
85      INTEGER                      ::   ji, jj, jk            ! dummy loop arguments
86      REAL(wp)                     ::   zrho3 = 0.03_wp       ! density     criterion for mixed layer depth
87      REAL(wp)                     ::   zrho1 = 0.01_wp       ! density     criterion for mixed layer depth
88      REAL(wp)                     ::   ztem2 = 0.2_wp        ! temperature criterion for mixed layer depth
89      REAL(wp)                     ::   zztmp, zzdep          ! temporary scalars inside do loop
90      REAL(wp)                     ::   zu, zv, zw, zut, zvt  ! temporary workspace
91      REAL(wp), DIMENSION(jpi,jpj) ::   zabs2      ! MLD: abs( tn - tn(10m) ) = ztem2
92      REAL(wp), DIMENSION(jpi,jpj) ::   ztm2       ! Top of thermocline: tn = tn(10m) - ztem2     
93      REAL(wp), DIMENSION(jpi,jpj) ::   zrho10_3   ! MLD: rho = rho10m + zrho3     
94      REAL(wp), DIMENSION(jpi,jpj) ::   zpycn      ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)
95      REAL(wp), DIMENSION(jpi,jpj) ::   ztinv      ! max of temperature inversion
96      REAL(wp), DIMENSION(jpi,jpj) ::   zdepinv    ! depth of temperature inversion
97      REAL(wp), DIMENSION(jpi,jpj) ::   zrho0_3    ! MLD rho = rho(surf) = 0.03
98      REAL(wp), DIMENSION(jpi,jpj) ::   zrho0_1    ! MLD rho = rho(surf) = 0.01
99      REAL(wp), DIMENSION(jpi,jpj) ::   zmaxdzT    ! max of dT/dz
100      REAL(wp), DIMENSION(jpi,jpj) ::   zdelr      ! delta rho equivalent to deltaT = 0.2
101      !!----------------------------------------------------------------------
102      IF( ln_timing )   CALL timing_start('dia_hth')
103
104      IF( kt == nit000 ) THEN
105         l_hth = .FALSE.
106         IF(   iom_use( 'mlddzt'   ) .OR. iom_use( 'mldr0_3'  ) .OR. iom_use( 'mldr0_1'  )    .OR.  & 
107            &  iom_use( 'mld_dt02' ) .OR. iom_use( 'topthdep' ) .OR. iom_use( 'mldr10_3' )    .OR.  &   
108            &  iom_use( '20d'      ) .OR. iom_use( '26d'      ) .OR. iom_use( '28d'      )    .OR.  &   
109            &  iom_use( 'hc300'    ) .OR. iom_use( 'hc700'    ) .OR. iom_use( 'hc2000'   )    .OR.  &   
110            &  iom_use( 'pycndep'  ) .OR. iom_use( 'tinv'     ) .OR. iom_use( 'depti'    )  ) l_hth = .TRUE.
111         !                                      ! allocate dia_hth array
112         IF( l_hth ) THEN
113            IF( dia_hth_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard arrays' )
114            IF(lwp) WRITE(numout,*)
115            IF(lwp) WRITE(numout,*) 'dia_hth : diagnostics of the thermocline depth'
116            IF(lwp) WRITE(numout,*) '~~~~~~~ '
117            IF(lwp) WRITE(numout,*)
118         ENDIF
119      ENDIF
120
121      IF( l_hth ) THEN
122         !
123         IF( iom_use( 'mlddzt' ) .OR. iom_use( 'mldr0_3' ) .OR. iom_use( 'mldr0_1' ) ) THEN
124            ! initialization
125            ztinv  (:,:) = 0._wp 
126            zdepinv(:,:) = 0._wp 
127            zmaxdzT(:,:) = 0._wp 
128            DO jj = 1, jpj
129               DO ji = 1, jpi
130                  zztmp = gdepw_n(ji,jj,mbkt(ji,jj)+1) 
131                  hth     (ji,jj) = zztmp
132                  zabs2   (ji,jj) = zztmp
133                  ztm2    (ji,jj) = zztmp
134                  zrho10_3(ji,jj) = zztmp
135                  zpycn   (ji,jj) = zztmp
136                 END DO
137            END DO
138            IF( nla10 > 1 ) THEN
139               DO jj = 1, jpj
140                  DO ji = 1, jpi
141                     zztmp = gdepw_n(ji,jj,mbkt(ji,jj)+1) 
142                     zrho0_3(ji,jj) = zztmp
143                     zrho0_1(ji,jj) = zztmp
144                  END DO
145               END DO
146            ENDIF
147     
148            ! Preliminary computation
149            ! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC)
150            DO jj = 1, jpj
151               DO ji = 1, jpi
152                  IF( tmask(ji,jj,nla10) == 1. ) THEN
153                     zu  =  1779.50 + 11.250 * tsn(ji,jj,nla10,jp_tem) - 3.80   * tsn(ji,jj,nla10,jp_sal)  &
154                        &           - 0.0745 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_tem)   &
155                        &           - 0.0100 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_sal)
156                     zv  =  5891.00 + 38.000 * tsn(ji,jj,nla10,jp_tem) + 3.00   * tsn(ji,jj,nla10,jp_sal)  &
157                        &           - 0.3750 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_tem)
158                     zut =    11.25 -  0.149 * tsn(ji,jj,nla10,jp_tem) - 0.01   * tsn(ji,jj,nla10,jp_sal)
159                     zvt =    38.00 -  0.750 * tsn(ji,jj,nla10,jp_tem)
160                     zw  = (zu + 0.698*zv) * (zu + 0.698*zv)
161                     zdelr(ji,jj) = ztem2 * (1000.*(zut*zv - zvt*zu)/zw)
162                  ELSE
163                     zdelr(ji,jj) = 0._wp
164                  ENDIF
165               END DO
166            END DO
167
168            ! ------------------------------------------------------------- !
169            ! thermocline depth: strongest vertical gradient of temperature !
170            ! turbocline depth (mixing layer depth): avt = zavt5            !
171            ! MLD: rho = rho(1) + zrho3                                     !
172            ! MLD: rho = rho(1) + zrho1                                     !
173            ! ------------------------------------------------------------- !
174            DO jk = jpkm1, 2, -1   ! loop from bottom to 2
175               DO jj = 1, jpj
176                  DO ji = 1, jpi
177                     !
178                     zzdep = gdepw_n(ji,jj,jk)
179                     zztmp = ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) &
180                            & / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz)
181                     zzdep = zzdep * tmask(ji,jj,1)
182
183                     IF( zztmp > zmaxdzT(ji,jj) ) THEN                       
184                         zmaxdzT(ji,jj) = zztmp   
185                         hth    (ji,jj) = zzdep                ! max and depth of dT/dz
186                     ENDIF
187               
188                     IF( nla10 > 1 ) THEN
189                        zztmp = rhop(ji,jj,jk) - rhop(ji,jj,1)                       ! delta rho(1)
190                        IF( zztmp > zrho3 )   zrho0_3(ji,jj) = zzdep                ! > 0.03
191                        IF( zztmp > zrho1 )   zrho0_1(ji,jj) = zzdep                ! > 0.01
192                     ENDIF
193                  END DO
194               END DO
195            END DO
196         
197            CALL iom_put( 'mlddzt', hth )            ! depth of the thermocline
198            IF( nla10 > 1 ) THEN
199               CALL iom_put( 'mldr0_3', zrho0_3 )   ! MLD delta rho(surf) = 0.03
200               CALL iom_put( 'mldr0_1', zrho0_1 )   ! MLD delta rho(surf) = 0.01
201            ENDIF
202            !
203         ENDIF
204         !
205         IF(  iom_use( 'mld_dt02' ) .OR. iom_use( 'topthdep' ) .OR. iom_use( 'mldr10_3' ) .OR.  &   
206            &  iom_use( 'pycndep' ) .OR. iom_use( 'tinv'     ) .OR. iom_use( 'depti'    )  ) THEN
207            ! ------------------------------------------------------------- !
208            ! MLD: abs( tn - tn(10m) ) = ztem2                              !
209            ! Top of thermocline: tn = tn(10m) - ztem2                      !
210            ! MLD: rho = rho10m + zrho3                                     !
211            ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)       !
212            ! temperature inversion: max( 0, max of tn - tn(10m) )          !
213            ! depth of temperature inversion                                !
214            ! ------------------------------------------------------------- !
215            DO jk = jpkm1, nlb10, -1   ! loop from bottom to nlb10
216               DO jj = 1, jpj
217                  DO ji = 1, jpi
218                     !
219                     zzdep = gdepw_n(ji,jj,jk) * tmask(ji,jj,1)
220                     !
221                     zztmp = tsn(ji,jj,nla10,jp_tem) - tsn(ji,jj,jk,jp_tem)  ! - delta T(10m)
222                     IF( ABS(zztmp) > ztem2 )      zabs2   (ji,jj) = zzdep   ! abs > 0.2
223                     IF(     zztmp  > ztem2 )      ztm2    (ji,jj) = zzdep   ! > 0.2
224                     zztmp = -zztmp                                          ! delta T(10m)
225                     IF( zztmp >  ztinv(ji,jj) ) THEN                        ! temperature inversion
226                        ztinv(ji,jj) = zztmp   
227                        zdepinv (ji,jj) = zzdep   ! max value and depth
228                     ENDIF
229
230                     zztmp = rhop(ji,jj,jk) - rhop(ji,jj,nla10)              ! delta rho(10m)
231                     IF( zztmp > zrho3        )    zrho10_3(ji,jj) = zzdep   ! > 0.03
232                     IF( zztmp > zdelr(ji,jj) )    zpycn   (ji,jj) = zzdep   ! > equi. delta T(10m) - 0.2
233                     !
234                  END DO
235               END DO
236            END DO
237
238            CALL iom_put( 'mld_dt02', zabs2    )   ! MLD abs(delta t) - 0.2
239            CALL iom_put( 'topthdep', ztm2     )   ! T(10) - 0.2
240            CALL iom_put( 'mldr10_3', zrho10_3 )   ! MLD delta rho(10m) = 0.03
241            CALL iom_put( 'pycndep' , zpycn    )   ! MLD delta rho equi. delta T(10m) = 0.2
242            CALL iom_put( 'tinv'    , ztinv    )   ! max. temp. inv. (t10 ref)
243            CALL iom_put( 'depti'   , zdepinv  )   ! depth of max. temp. inv. (t10 ref)
244            !
245         ENDIF
246 
247         ! ------------------------------- !
248         !  Depth of 20C/26C/28C isotherm  !
249         ! ------------------------------- !
250         IF( iom_use ('20d') ) THEN  ! depth of the 20 isotherm
251            ztem2 = 20.
252            CALL dia_hth_dep( ztem2, hd20 ) 
253            CALL iom_put( '20d', hd20 )   
254         ENDIF
255         !
256         IF( iom_use ('26d') ) THEN  ! depth of the 26 isotherm
257            ztem2 = 26.
258            CALL dia_hth_dep( ztem2, hd26 ) 
259            CALL iom_put( '26d', hd26 )   
260         ENDIF
261         !
262         IF( iom_use ('28d') ) THEN  ! depth of the 28 isotherm
263            ztem2 = 28.
264            CALL dia_hth_dep( ztem2, hd28 ) 
265            CALL iom_put( '28d', hd28 )   
266         ENDIF
267       
268         ! ----------------------------- !
269         !  Heat content of first 300 m  !
270         ! ----------------------------- !
271         IF( iom_use ('hc300') ) THEN 
272            zzdep = 300.
273            CALL  dia_hth_htc( zzdep, tsn(:,:,:,jp_tem), htc3 )
274            CALL iom_put( 'hc300', rau0_rcp * htc3 )  ! vertically integrated heat content (J/m2)
275         ENDIF
276         !
277         ! ----------------------------- !
278         !  Heat content of first 700 m  !
279         ! ----------------------------- !
280         IF( iom_use ('hc700') ) THEN 
281            zzdep = 700.
282            CALL  dia_hth_htc( zzdep, tsn(:,:,:,jp_tem), htc7 )
283            CALL iom_put( 'hc700', rau0_rcp * htc7 )  ! vertically integrated heat content (J/m2)
284 
285         ENDIF
286         !
287         ! ----------------------------- !
288         !  Heat content of first 2000 m  !
289         ! ----------------------------- !
290         IF( iom_use ('hc2000') ) THEN 
291            zzdep = 2000.
292            CALL  dia_hth_htc( zzdep, tsn(:,:,:,jp_tem), htc20 )
293            CALL iom_put( 'hc2000', rau0_rcp * htc20 )  ! vertically integrated heat content (J/m2) 
294         ENDIF
295         !
296      ENDIF
297
298      !
299      IF( ln_timing )   CALL timing_stop('dia_hth')
300      !
301   END SUBROUTINE dia_hth
302
303   SUBROUTINE dia_hth_dep( ptem, pdept )
304      !
305      REAL(wp), INTENT(in) :: ptem
306      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pdept     
307      !
308      INTEGER  :: ji, jj, jk, iid
309      REAL(wp) :: zztmp, zzdep
310      INTEGER, DIMENSION(jpi,jpj) :: iktem
311     
312      ! --------------------------------------- !
313      ! search deepest level above ptem         !
314      ! --------------------------------------- !
315      iktem(:,:) = 1
316      DO jk = 1, jpkm1   ! beware temperature is not always decreasing with depth => loop from top to bottom
317         DO jj = 1, jpj
318            DO ji = 1, jpi
319               zztmp = tsn(ji,jj,jk,jp_tem)
320               IF( zztmp >= ptem )   iktem(ji,jj) = jk
321            END DO
322         END DO
323      END DO
324
325      ! ------------------------------- !
326      !  Depth of ptem isotherm         !
327      ! ------------------------------- !
328      DO jj = 1, jpj
329         DO ji = 1, jpi
330            !
331            zzdep = gdepw_n(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean bottom
332            !
333            iid = iktem(ji,jj)
334            IF( iid /= 1 ) THEN
335                zztmp =     gdept_n(ji,jj,iid  )   &                     ! linear interpolation
336                  &  + (    gdept_n(ji,jj,iid+1) - gdept_n(ji,jj,iid)                       )   &
337                  &  * ( 20.*tmask(ji,jj,iid+1) - tsn(ji,jj,iid,jp_tem)                       )   &
338                  &  / ( tsn(ji,jj,iid+1,jp_tem) - tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) )
339               pdept(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1)       ! bound by the ocean depth
340            ELSE
341               pdept(ji,jj) = 0._wp
342            ENDIF
343         END DO
344      END DO
345      !
346   END SUBROUTINE dia_hth_dep
347
348
349   SUBROUTINE dia_hth_htc( pdep, ptn, phtc )
350      !
351      REAL(wp), INTENT(in) :: pdep     ! depth over the heat content
352      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: ptn   
353      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: phtc 
354      !
355      INTEGER  :: ji, jj, jk, ik
356      REAL(wp), DIMENSION(jpi,jpj) :: zthick
357      INTEGER , DIMENSION(jpi,jpj) :: ilevel
358
359
360      ! surface boundary condition
361     
362      IF( .NOT. ln_linssh ) THEN   ;   zthick(:,:) = 0._wp       ;   phtc(:,:) = 0._wp                                   
363      ELSE                         ;   zthick(:,:) = sshn(:,:)   ;   phtc(:,:) = ptn(:,:,1) * sshn(:,:) * tmask(:,:,1)   
364      ENDIF
365      !
366      ilevel(:,:) = 1
367      DO jk = 2, jpkm1
368         DO jj = 1, jpj
369            DO ji = 1, jpi
370               IF( ( gdept_n(ji,jj,jk) < pdep ) .AND. ( tmask(ji,jj,jk) == 1 ) ) THEN
371                   ilevel(ji,jj) = jk
372                   zthick(ji,jj) = zthick(ji,jj) + e3t_n(ji,jj,jk)
373                   phtc  (ji,jj) = phtc  (ji,jj) + e3t_n(ji,jj,jk) * ptn(ji,jj,jk)
374               ENDIF
375            ENDDO
376         ENDDO
377      ENDDO
378      !
379      DO jj = 1, jpj
380         DO ji = 1, jpi
381            ik = ilevel(ji,jj)
382            zthick(ji,jj) = pdep - zthick(ji,jj)   !   remaining thickness to reach depht pdep
383            phtc(ji,jj)   = phtc(ji,jj) + ptn(ji,jj,ik+1) * MIN( e3t_n(ji,jj,ik+1), zthick(ji,jj) ) &
384                                                          * tmask(ji,jj,ik+1)
385         END DO
386      ENDDO
387      !
388      !
389   END SUBROUTINE dia_hth_htc
390
391   !!======================================================================
392END MODULE diahth
Note: See TracBrowser for help on using the repository browser.