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

Last change on this file since 32 was 32, checked in by opalod, 21 years ago

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