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 @ 3

Last change on this file since 3 was 3, checked in by opalod, 20 years ago

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.7 KB
Line 
1MODULE diahth
2   !!======================================================================
3   !!                       ***  MODULE  diahth  ***
4   !! Ocean diagnostics: thermocline and 20 degree depth
5   !!======================================================================
6#if   defined key_diahth   ||   defined key_esopa
7   !!----------------------------------------------------------------------
8   !!   'key_diahth' :                              thermocline depth diag.
9   !!----------------------------------------------------------------------
10   !!   dia_hth      : Compute diagnostics associated with the thermocline
11   !!----------------------------------------------------------------------
12   !! * Modules used
13   USE oce             ! ocean dynamics and tracers
14   USE dom_oce         ! ocean space and time domain
15   USE phycst          ! physical constants
16   USE in_out_manager  ! I/O manager
17
18   IMPLICIT NONE
19   PRIVATE
20
21   !! * Routine accessibility
22   PUBLIC dia_hth    ! routine called by step.F90
23
24   !! * Shared module variables
25   LOGICAL , PUBLIC, PARAMETER ::   &
26      lk_diahth = .TRUE.   ! thermocline-20d depths flag
27   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &
28      hth  ,      &  ! depth of the max vertical temperature gradient (m)
29      hd20 ,      &  ! depth of 20 C isotherm (m)
30      hd28 ,      &  ! depth of 28 C isotherm (m)
31      htc3           ! heat content of first 300 m
32
33   !! * Substitutions
34#  include "domzgr_substitute.h90"
35   !!----------------------------------------------------------------------
36   !!   OPA 9.0 , LODYC-IPSL  (2003)
37   !!----------------------------------------------------------------------
38
39CONTAINS
40
41   SUBROUTINE dia_hth( kt )
42      !!---------------------------------------------------------------------
43      !!                  ***  ROUTINE dia_hth  ***
44      !!
45      !! ** Purpose :
46      !!      Computes the depth of strongest vertical temperature gradient
47      !!      Computes the depth of the 20 degree isotherm
48      !!      Computes the depth of the 28 degree isotherm
49      !!      Computes the heat content of first 300 m
50      !!
51      !! ** Method :
52      !!
53      !! History :
54      !!        !  94-09  (J.-P. Boulanger)  Original code
55      !!        !  96-11  (E. Guilyardi)  OPA8
56      !!        !  97-08  (G. Madec)  optimization
57      !!        !  99-07  (E. Guilyardi)  hd28 + heat content
58      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
59      !!-------------------------------------------------------------------
60      !! * Arguments
61      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
62
63      !! * Local declarations
64      INTEGER :: ji, jj, jk         ! dummy loop arguments
65      INTEGER :: iid, iif, ilevel   ! temporary integers
66      INTEGER, DIMENSION(jpi) ::   idepth
67      INTEGER, DIMENSION(jpi,jpj) ::   ikc
68
69      REAL(wp) :: zd, zmoy              ! temporary scalars
70      REAL(wp), DIMENSION(jpi) ::   zmax
71      REAL(wp), DIMENSION(jpi,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      ! -------------------------- !
83      !  Depth of the thermocline  !
84      ! -------------------------- !
85      ! The depth of the thermocline is defined as the depth of the
86      ! strongest vertical temperature gradient
87     
88      DO jj = 1, jpj
89         
90         ! vertical gradient of temperature
91         DO jk = 2, jpkm1
92            zdzt(:,jk) = ( tn(:,jj,jk-1) - tn(:,jj,jk) ) / fse3w(:,jj,jk) * tmask(:,jj,jk)
93         END DO
94         
95         ! search the level of maximum vertical temperature gradient
96         zmax  (:) = 0.e0
97         idepth(:) = 1
98         DO jk = jpkm1, 2, -1
99            DO ji = 1, jpi
100               IF( zdzt(ji,jk) > zmax(ji) ) THEN
101                  zmax  (ji) = zdzt(ji,jk)
102                  idepth(ji) = jk
103               ENDIF
104            END DO
105         END DO
106
107         ! depth of the thermocline
108         DO ji = 1, jpi
109            hth(ji,jj) = fsdepw(ji,jj,idepth(ji))
110         END DO
111         
112      END DO
113
114
115      ! ----------------------- !
116      !  Depth of 20C isotherm  !
117      ! ----------------------- !
118
119      ! initialization to the number of ocean w-point mbathy
120      ! (cf dommsk, minimum value: 1)
121      ikc(:,:) = 1
122
123      ! search the depth of 20 degrees isotherm
124      ! ( starting from the top, last level above 20C, if not exist, = 1)
125      DO jk = 1, jpkm1
126         DO jj = 1, jpj
127            DO ji = 1, jpi
128               IF( tn(ji,jj,jk) >= 20. ) ikc(ji,jj) = jk
129            END DO
130         END DO
131      END DO
132     
133      ! Depth of 20C isotherm
134      DO jj = 1, jpj
135         DO ji = 1, jpi
136            iid = ikc(ji,jj)
137            iif = mbathy(ji,jj)
138            IF( iid /= 1 ) THEN 
139               ! linear interpolation
140               zd =  fsdept(ji,jj,iid)   &
141                  + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) )   &
142                  * ( 20.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid) )   &
143                  / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid)    &
144                  + (1.-tmask(ji,jj,1))                       )
145               ! bound by the ocean depth, minimum value, first T-point depth
146               hd20(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif))
147            ELSE
148               hd20(ji,jj)=0.
149            ENDIF
150         END DO
151      END DO
152
153      ! ----------------------- !
154      !  Depth of 28C isotherm  !
155      ! ----------------------- !
156     
157      ! initialization to the number of ocean w-point mbathy
158      ! (cf dommsk, minimum value: 1)
159      ikc(:,:) = 1
160     
161      ! search the depth of 28 degrees isotherm
162      ! ( starting from the top, last level above 28C, if not exist, = 1)
163      DO jk = 1, jpkm1
164         DO jj = 1, jpj
165            DO ji = 1, jpi
166               IF( tn(ji,jj,jk) >= 28. ) ikc(ji,jj) = jk
167            END DO
168         END DO
169      END DO
170     
171      ! Depth of 28C isotherm
172      DO jj = 1, jpj
173         DO ji = 1, jpi
174            iid = ikc(ji,jj)
175            iif = mbathy(ji,jj)
176            IF( iid /= 1 ) THEN 
177               ! linear interpolation
178               zd =  fsdept(ji,jj,iid)   &
179                  + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) )   &
180                  * ( 28.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid) )   &
181                  / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid)    &
182                  + ( 1. - tmask(ji,jj,1) )  )
183               ! bound by the ocean depth, minimum value, first T-point depth
184               hd28(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif) )
185            ELSE
186               hd28(ji,jj) = 0.
187            ENDIF
188         END DO
189      END DO
190
191      ! ----------------------------------------- !
192      !  Heat content of first 300 m (18 levels)  !
193      ! ----------------------------------------- !
194
195      htc3(:,:) = 0.e0
196      ilevel = 18
197      zmoy = rau0 * rcp * 0.5
198     
199      ! intregrate tn from surface to klevel
200
201      DO jk = 1, ilevel
202               htc3(:,:) = htc3(:,:)   &
203                         + zmoy * ( tn(:,:,jk) + tn(:,:,jk+1) ) * fse3w(:,:,jk) * tmask(:,:,jk)
204      END DO
205
206   END SUBROUTINE dia_hth
207
208#else
209   !!----------------------------------------------------------------------
210   !!   Default option :                                       Empty module
211   !!----------------------------------------------------------------------
212   LOGICAL , PUBLIC, PARAMETER ::   &
213      lk_diahth = .FALSE.   ! thermocline-20d depths flag
214CONTAINS
215   SUBROUTINE dia_hth( kt )         ! Empty routine
216      WRITE(*,*) kt
217   END SUBROUTINE dia_hth
218#endif
219
220   !!======================================================================
221END MODULE diahth
Note: See TracBrowser for help on using the repository browser.