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.
diahth.F90 in trunk/NEMO/OPA_SRC/DIA – NEMO

source: trunk/NEMO/OPA_SRC/DIA/diahth.F90 @ 1485

Last change on this file since 1485 was 1485, checked in by smasson, 15 years ago

clean 20d, 28d and depth of the thermocline, see ticket:468
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 8.1 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   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module
11   !!   NEMO     3.2  !  2009-07  (S. Masson) hc300 bugfix + cleaning
12   !!----------------------------------------------------------------------
13
14#if   defined key_diahth   ||   defined key_esopa
15   !!----------------------------------------------------------------------
16   !!   'key_diahth' :                              thermocline depth diag.
17   !!----------------------------------------------------------------------
18   !!   dia_hth      : Compute diagnostics associated with the thermocline
19   !!----------------------------------------------------------------------
20   !! * Modules used
21   USE oce             ! ocean dynamics and tracers
22   USE dom_oce         ! ocean space and time domain
23   USE phycst          ! physical constants
24   USE in_out_manager  ! I/O manager
25   USE iom
26
27   IMPLICIT NONE
28   PRIVATE
29
30   !! * Routine accessibility
31   PUBLIC dia_hth    ! routine called by step.F90
32
33   !! * Shared module variables
34   LOGICAL , PUBLIC, PARAMETER ::   lk_diahth = .TRUE.   !: thermocline-20d depths flag
35   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !:
36      hth  ,      &  !: depth of the max vertical temperature gradient (m)
37      hd20 ,      &  !: depth of 20 C isotherm (m)
38      hd28 ,      &  !: depth of 28 C isotherm (m)
39      htc3           !: heat content of first 300 m
40
41   !! * Substitutions
42#  include "domzgr_substitute.h90"
43   !!----------------------------------------------------------------------
44   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
45   !! $Id$
46   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
47   !!----------------------------------------------------------------------
48
49CONTAINS
50
51   SUBROUTINE dia_hth( kt )
52      !!---------------------------------------------------------------------
53      !!                  ***  ROUTINE dia_hth  ***
54      !!
55      !! ** Purpose :
56      !!      Computes the depth of strongest vertical temperature gradient
57      !!      Computes the depth of the 20 degree isotherm
58      !!      Computes the depth of the 28 degree isotherm
59      !!      Computes the heat content of first 300 m
60      !!
61      !! ** Method :
62      !!
63      !!-------------------------------------------------------------------
64      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
65      !!
66      INTEGER                          ::   ji, jj, jk            ! dummy loop arguments
67      INTEGER                          ::   iid, iif, ilevel      ! temporary integers
68      INTEGER, DIMENSION(jpi,jpj)      ::   ikc                   ! levels
69      REAL(wp)                         ::   zd, zthick_0, zcoef   ! temporary scalars
70      REAL(wp), DIMENSION(jpi,jpj)     ::   zthick
71      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdzt
72      !!----------------------------------------------------------------------
73
74      IF( kt == nit000 ) THEN
75         IF(lwp) WRITE(numout,*)
76         IF(lwp) WRITE(numout,*) 'dia_hth : diagnostics of the thermocline depth'
77         IF(lwp) WRITE(numout,*) '~~~~~~~ '
78         IF(lwp) WRITE(numout,*)
79      ENDIF
80
81      ! -------------------------- !
82      !  Depth of the thermocline  !
83      ! -------------------------- !
84      ! The depth of the thermocline is defined as the depth of the
85      ! strongest vertical temperature gradient
86      zdzt(:,:,1) = 0.e0
87      DO jk = 2, jpk                      ! vertical gradient of temperature
88         zdzt(:,:,jk) = ( tn(:,:,jk-1) - tn(:,:,jk) ) / fse3w(:,:,jk) * tmask(:,:,jk)
89      END DO
90      DO jj = 1, jpj
91         DO ji = 1, jpi
92            ilevel = MAXLOC( zdzt(ji,jj,:), dim= 1 )      ! level of maximum vertical temperature gradient
93            hth(ji,jj) = fsdepw(ji,jj,ilevel)             ! depth of the thermocline
94         END DO         
95      END DO
96
97      CALL iom_put( "thermod", hth )      ! depth of the thermocline
98
99      ! ----------------------- !
100      !  Depth of 20C isotherm  !
101      ! ----------------------- !
102     
103      ! search last level above 20C
104      ikc(:,:) = COUNT( tn >= 20., dim = 3 )
105      ! Depth of 20C isotherm, linear interpolation
106      DO jj = 1, jpj
107         DO ji = 1, jpi
108            iid = MAX(1, ikc(ji,jj))
109            zd = fsdept(ji,jj,iid) + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid)                           )   &
110               &                   * ( 20.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid)                           )   &
111               &                   / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid) + ( 1. - tmask(ji,jj,1) ) )
112            ! bound by the ocean depth, minimum value, first T-point depth
113            iif = mbathy(ji,jj)
114            hd20(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif) )
115         END DO
116      END DO
117      WHERE(ikc == 0 )   hd20 = 0.e0
118      CALL iom_put( "20d", hd20 )         ! depth of the 20 isotherm
119
120      ! ----------------------- !
121      !  Depth of 28C isotherm  !
122      ! ----------------------- !
123     
124      ! search last level above 28C
125      ikc(:,:) = COUNT( tn >= 28., dim = 3 )
126      ! Depth of 28C isotherm, linear interpolation
127      DO jj = 1, jpj
128         DO ji = 1, jpi
129            iid = MAX(1, ikc(ji,jj))
130            zd = fsdept(ji,jj,iid) + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid)                           )   &
131               &                   * ( 28.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid)                           )   &
132               &                   / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid) + ( 1. - tmask(ji,jj,1) ) )
133            ! bound by the ocean depth, minimum value, first T-point depth
134            iif = mbathy(ji,jj)
135            hd28(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif) )
136         END DO
137      END DO
138      WHERE(ikc == 0 )   hd28 = 0.e0
139      CALL iom_put( "28d", hd28 )         ! depth of the 28 isotherm
140
141      ! ----------------------------- !
142      !  Heat content of first 300 m  !
143      ! ----------------------------- !
144
145      ! find ilevel with (ilevel+1) the deepest W-level above 300m (we assume we can use e3t_0 to do this search...)
146      ilevel = 0
147      zthick_0 = 0.e0
148      DO jk = 1, jpk-1                       
149         zthick_0 = zthick_0 + e3t_0(jk)
150         IF( zthick_0 < 300. )   ilevel = jk
151      END DO
152      ! surface boundary condition
153      IF( lk_vvl ) THEN   ;   zthick(:,:) = 0.e0        ;   htc3(:,:) = 0.e0                                     
154      ELSE                ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tn(:,:,jk) * sshn(:,:) * tmask(:,:,jk)   
155      ENDIF
156      ! integration down to ilevel
157      DO jk = 1, ilevel
158         zthick(:,:) = zthick(:,:) + fse3t(:,:,jk)
159         htc3  (:,:) = htc3  (:,:) + fse3t(:,:,jk) * tn(:,:,jk) * tmask(:,:,jk)
160      END DO
161      ! deepest layer
162      zthick(:,:) = 300. - zthick(:,:)   !   remaining thickness to reach 300m
163      htc3(:,:) = htc3(:,:) + tn(:,:,ilevel+1) * MIN( fse3t(:,:,ilevel+1), zthick(:,:) ) * tmask(:,:,ilevel+1)
164      ! from temperature to heat contain
165      zcoef = rau0 * rcp
166      htc3(:,:) = zcoef * htc3(:,:)
167      CALL iom_put( "hc300", htc3 )      ! first 300m heaat content
168
169
170   END SUBROUTINE dia_hth
171
172#else
173   !!----------------------------------------------------------------------
174   !!   Default option :                                       Empty module
175   !!----------------------------------------------------------------------
176   LOGICAL , PUBLIC, PARAMETER ::   lk_diahth = .FALSE.  !: thermocline-20d depths flag
177CONTAINS
178   SUBROUTINE dia_hth( kt )         ! Empty routine
179      WRITE(*,*) 'dia_hth: You should not have seen this print! error?', kt
180   END SUBROUTINE dia_hth
181#endif
182
183   !!======================================================================
184END MODULE diahth
Note: See TracBrowser for help on using the repository browser.