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

source: trunk/NEMO/OPA_SRC/TRD/trdtra.F90 @ 163

Last change on this file since 163 was 16, checked in by opalod, 20 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: 15.0 KB
Line 
1MODULE trdtra
2   !!======================================================================
3   !!                       ***  MODULE  trdtra  ***
4   !! Ocean diagnostics:  ocean tracer trends
5   !!=====================================================================
6#if  defined key_trdtra   ||   defined key_esopa
7   !!----------------------------------------------------------------------
8   !!   'key_trdtra'  or                           tracer trend diagnostics
9   !!   'key_trdmld'                          mixed layer trend diagnostics
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   trd_tra      : verify the basin averaged properties for tracers
14   !!   trd_tra_init : ???
15   !!----------------------------------------------------------------------
16   !! * Modules used
17   USE oce             ! ocean dynamics and tracers variables
18   USE dom_oce         ! ocean space and time domain variables
19   USE trdtra_oce      ! ocean active tracer trend variables
20   USE trddyn_oce      ! ocean dynamics trend variables
21   USE ldftra_oce      ! ocean active tracers: lateral physics
22   USE ldfdyn_oce      ! ocean dynamics: lateral physics
23   USE zdf_oce         ! ocean vertical physics
24   USE in_out_manager  ! I/O manager
25   USE lib_mpp         ! distibuted memory computing library
26
27   IMPLICIT NONE
28   PRIVATE
29
30   !! * Routine accessibility
31   PUBLIC trd_tra      ! called by step.F90
32   PUBLIC trd_tra_init ! called by opa.F90
33
34   !! * Shared module variables
35   LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .TRUE.    !: momentum trend flag
36
37   !! * Substitutions
38#  include "domzgr_substitute.h90"
39#  include "vectopt_loop_substitute.h90"
40   !!----------------------------------------------------------------------
41   !!   OPA 9.0 , LODYC-IPSL  (2003)
42   !!----------------------------------------------------------------------
43
44CONTAINS
45
46   SUBROUTINE trd_tra( kt )
47      !!---------------------------------------------------------------------
48      !!                  ***  ROUTINE trd_tra  ***
49      !!
50      !! ** Purpose :   verify the basin averaged properties of the tracers
51      !!   equations at every time step frequency ntrd.
52      !!
53      !!   Method :
54      !!
55      !! History :
56      !!        !  91-12 (G. Madec)
57      !!        !  92-06 (M. Imbard) add time step frequency
58      !!        !  96-01 (G. Madec) terrain following coordinates
59      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
60      !!----------------------------------------------------------------------
61      !! * Arguments
62      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
63
64      !! * Local declarations
65      INTEGER :: ji, jj, jk, jn
66      REAL(wp)                ::   zbt 
67      REAL(wp), DIMENSION(10) ::   ztmo, zsmo, zt2, zs2
68
69      NAMELIST/namtrd/ ntrd, nctls
70      !!----------------------------------------------------------------------
71
72      ! 0. Initialization
73      ! -----------------
74
75      IF( kt == nit000 ) THEN
76
77         ! namelist namtrd : trend diagnostic
78         REWIND( numnam )
79         READ  ( numnam, namtrd )
80
81         IF(lwp) THEN
82            WRITE(numout,*) 'trd_tra : read namelist namtrd'
83            WRITE(numout,*) '~~~~~~~'
84            WRITE(numout,*) ' time step frequency trend       ntrd  = ', ntrd
85            WRITE(numout,*) ' '
86         ENDIF
87
88         ! Total volume at t-points:
89         tvolt = 0.
90         DO jk = 1, jpkm1
91            DO jj = 2, jpjm1
92               DO ji = fs_2, fs_jpim1   ! vector opt.
93                  tvolt = tvolt + e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk)* tmask(ji,jj,jk) * tmask_i(ji,jj)
94               END DO
95            END DO
96         END DO
97         IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain
98
99         IF(lwp) THEN
100            WRITE(numout,*)
101            WRITE(numout,*) '***trd_tra'
102            WRITE(numout,*) ' frequency ntrd = ',ntrd
103            WRITE(numout,*) ' '
104            WRITE(numout,*) ' tvolt = ',tvolt
105            WRITE(numout,*) ' '
106         ENDIF
107
108      ENDIF
109
110
111      ! 1. Advective trends and forcing trend
112      ! -------------------------------------
113
114      IF( MOD(kt,ntrd) == 0 .OR. kt  == nit000 .OR. kt == nitend ) THEN
115         
116         ! 1.1 Mask the forcing trend and substract it from the vertical diffusion trend
117         flxtrd(:,:,1) = flxtrd(:,:,1) * tmask_i(:,:)
118         flxtrd(:,:,2) = flxtrd(:,:,2) * tmask_i(:,:)
119         
120         ! 1.2 Mask the trends
121         DO jn = 1, 6
122            DO jk = 1, jpk
123               ttrd(:,:,jk,jn) = ttrd(:,:,jk,jn)* tmask(:,:,jk) * tmask_i(:,:)
124               strd(:,:,jk,jn) = strd(:,:,jk,jn)* tmask(:,:,jk) * tmask_i(:,:)
125            END DO
126         END DO
127         
128         DO jk = 1, jpk
129            ttrd(:,:,jk,7) = ttrd(:,:,jk,7) * tmask(:,:,jk) * tmask_i(:,:)
130         END DO
131
132
133         ! 2. Basin averaged tracer trend
134         ! ------------------------------
135         
136         DO jn = 1, 6
137            ztmo(jn) = 0.
138            zsmo(jn) = 0.
139            DO jk = 1, jpkm1
140               DO jj = 1, jpj
141                  DO ji = 1, jpi
142                     zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
143                     ztmo(jn) =  ztmo(jn) + ttrd(ji,jj,jk,jn) * zbt
144                     zsmo(jn) =  zsmo(jn) + strd(ji,jj,jk,jn) * zbt
145                  END DO
146               END DO
147            END DO
148         END DO
149         
150         ztmo(7) = 0.
151         DO jk = 1, jpk
152            DO jj = 1, jpj
153               DO ji = 1, jpi
154                  zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
155                  ztmo(7) =  ztmo(7) + ttrd(ji,jj,jk,7) * zbt
156               END DO
157            END DO
158         END DO
159         
160         ztmo(8) = 0.
161         zsmo(8) = 0.
162         DO jj = 1, jpj
163            DO ji = 1, jpi
164               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1)
165               ztmo(8) =  ztmo(8) + flxtrd(ji,jj,1) * zbt
166               zsmo(8) =  zsmo(8) + flxtrd(ji,jj,2) * zbt
167            END DO
168         END DO
169         
170         
171         ! 3. Basin averaged tracer square trend
172         ! -------------------------------------
173         ! c a u t i o n: field before, because after the array swap
174         
175         DO jn = 1, 6
176            zt2(jn) = 0.e0
177            zs2(jn) = 0.e0
178            DO jk = 1, jpk
179               DO jj = 1, jpj
180                  DO ji = 1, jpi
181                     zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
182                     zt2(jn) = zt2(jn) + ttrd(ji,jj,jk,jn) * zbt * tb(ji,jj,jk)
183                     zs2(jn) = zs2(jn) + strd(ji,jj,jk,jn) * zbt * sb(ji,jj,jk)
184                  END DO
185               END DO
186            END DO
187         END DO
188         
189         zt2(7) = 0.e0
190         DO jk = 1, jpk
191            DO jj = 1, jpj
192               DO ji = 1, jpi
193                  zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
194                  zt2(7) = zt2(7) + ttrd(ji,jj,jk,7) * zbt * tb(ji,jj,jk)
195               END DO
196            END DO
197         END DO
198         
199         zt2(8) = 0.e0
200         zs2(8) = 0.e0
201         DO jj = 1, jpj
202            DO ji = 1, jpi
203               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1)
204               zt2(8) = zt2(8) + flxtrd(ji,jj,1) * zbt * tb(ji,jj,1)
205               zs2(8) = zs2(8) + flxtrd(ji,jj,2) * zbt * sb(ji,jj,1)
206            END DO
207         END DO
208         
209         IF( lk_mpp ) THEN
210            CALL mpp_sum( ztmo, 10 )   ! sums over the global domain
211            CALL mpp_sum( zsmo, 10 )
212            CALL mpp_sum( zt2 , 10 )
213            CALL mpp_sum( zs2 , 10 )
214         ENDIF
215         
216         ! 4. Print
217         ! --------
218         
219         IF(lwp) THEN
220            WRITE (numout,*)
221            WRITE (numout,*)
222            WRITE (numout,9400) kt
223            WRITE (numout,9401) ztmo(1) / tvolt, zsmo(1) / tvolt
224            WRITE (numout,9402) ztmo(2) / tvolt, zsmo(2) / tvolt
225            WRITE (numout,9403) ztmo(3) / tvolt, zsmo(3) / tvolt
226            WRITE (numout,9404) ztmo(4) / tvolt, zsmo(4) / tvolt
227            WRITE (numout,9405) ztmo(5) / tvolt, zsmo(5) / tvolt
228            WRITE (numout,9406) ztmo(6) / tvolt, zsmo(6) / tvolt
229            WRITE (numout,9407) ztmo(7) / tvolt
230            WRITE (numout,9408) ztmo(8) / tvolt, zsmo(8) / tvolt
231            WRITE (numout,9409)
232            WRITE (numout,9410) (  ztmo(1) + ztmo(2) + ztmo(3) + ztmo(4)              &
233            &                    + ztmo(5) + ztmo(6) + ztmo(7) + ztmo(8) ) / tvolt,   &
234            &                   (  zsmo(1) + zsmo(2) + zsmo(3) + zsmo(4)              &
235            &                    + zsmo(5) + zsmo(6)           + zsmo(8) ) / tvolt
236         ENDIF
237
2389400     FORMAT(' tracer trend at it= ',i6,' :     temperature',   &
239              '              salinity',/' ============================')
2409401     FORMAT(' horizontal advection        ',e20.13,'     ',e20.13)
2419402     FORMAT(' vertical advection          ',e20.13,'     ',e20.13)
2429403     FORMAT(' horizontal diffusion        ',e20.13,'     ',e20.13)
2439404     FORMAT(' vertical diffusion          ',e20.13,'     ',e20.13)
2449405     FORMAT(' STATIC instability mixing   ',e20.13,'     ',e20.13)
2459406     FORMAT(' damping term                ',e20.13,'     ',e20.13)
2469407     FORMAT(' penetrative qsr             ',e20.13,'     ',e20.13)
2479408     FORMAT(' forcing term                ',e20.13,'     ',e20.13)
2489409     FORMAT(' -------------------------------------------------------------------------')
2499410     FORMAT(' total trend                 ',e20.13,'     ',e20.13)
250
251
252         IF(lwp) THEN
253            WRITE (numout,*)
254            WRITE (numout,*)
255            WRITE (numout,9420) kt
256            WRITE (numout,9421) zt2(1) / tvolt, zs2(1) / tvolt
257            WRITE (numout,9422) zt2(2) / tvolt, zs2(2) / tvolt
258            WRITE (numout,9423) zt2(3) / tvolt, zs2(3) / tvolt
259            WRITE (numout,9424) zt2(4) / tvolt, zs2(4) / tvolt
260            WRITE (numout,9425) zt2(5) / tvolt, zs2(5) / tvolt
261            WRITE (numout,9426) zt2(6) / tvolt, zs2(6) / tvolt
262            WRITE (numout,9427) zt2(7) / tvolt
263            WRITE (numout,9428) zt2(8) / tvolt, zs2(8) / tvolt
264            WRITE (numout,9429)
265            WRITE (numout,9430) (  zt2(1) + zt2(2) + zt2(3) + zt2(4)              &
266            &                    + zt2(5) + zt2(6) + zt2(7) + zt2(8) ) / tvolt,   &
267            &                   (  zs2(1) + zs2(2) + zs2(3) + zs2(4)              &
268            &                    + zs2(5) + zs2(6)          + zs2(8) ) / tvolt
269         ENDIF
270
2719420     FORMAT(' tracer**2 trend at it= ', i6, ' :      temperature',   &
272            '               salinity', /, ' ===============================')
2739421     FORMAT(' horizontal advection      * t   ', e20.13, '     ', e20.13)
2749422     FORMAT(' vertical advection        * t   ', e20.13, '     ', e20.13)
2759423     FORMAT(' horizontal diffusion      * t   ', e20.13, '     ', e20.13)
2769424     FORMAT(' vertical diffusion        * t   ', e20.13, '     ', e20.13)
2779425     FORMAT(' STATIC instability mixing * t   ', e20.13, '     ', e20.13)
2789426     FORMAT(' damping term              * t   ', e20.13, '     ', e20.13)
2799427     FORMAT(' penetrative qsr           * t   ', e20.13, '     ', e20.13)
2809428     FORMAT(' forcing term              * t   ', e20.13, '     ', e20.13)
2819429     FORMAT(' -----------------------------------------------------------------------------')
2829430     FORMAT(' total trend                *t = ', e20.13, '  *s = ', e20.13)
283
284
285         IF(lwp) THEN
286            WRITE (numout,*)
287            WRITE (numout,*)
288            WRITE (numout,9440) kt
289            WRITE (numout,9441) ( ztmo(1)+ztmo(2) )/tvolt, ( zsmo(1)+zsmo(2) )/tvolt
290            WRITE (numout,9442)   ztmo(3)/tvolt,  zsmo(3)/tvolt
291            WRITE (numout,9443)   ztmo(4)/tvolt,  zsmo(4)/tvolt
292            WRITE (numout,9444)   ztmo(5)/tvolt,  zsmo(5)/tvolt
293            WRITE (numout,9445) ( zt2(1)+zt2(2) )/tvolt, ( zs2(1)+zs2(2) )/tvolt
294            WRITE (numout,9446)   zt2(3)/tvolt,   zs2(3)/tvolt
295            WRITE (numout,9447)   zt2(4)/tvolt,   zs2(4)/tvolt
296            WRITE (numout,9448)   zt2(5)/tvolt,   zs2(5)/tvolt
297         ENDIF
298
2999440     FORMAT(' tracer consistency at it= ',i6,   &
300            ' :         temperature','                salinity',/,   &
301            ' ==================================')
3029441     FORMAT(' 0 = horizontal+vertical advection      ',e20.13,'       ',e20.13)
3039442     FORMAT(' 0 = horizontal diffusion               ',e20.13,'       ',e20.13)
3049443     FORMAT(' 0 = vertical diffusion                 ',e20.13,'       ',e20.13)
3059444     FORMAT(' 0 = static instability mixing          ',e20.13,'       ',e20.13)
3069445     FORMAT(' 0 = horizontal+vertical advection * t  ',e20.13,'       ',e20.13)
3079446     FORMAT(' 0 > horizontal diffusion          * t  ',e20.13,'       ',e20.13)
3089447     FORMAT(' 0 > vertical diffusion            * t  ',e20.13,'       ',e20.13)
3099448     FORMAT(' 0 > static instability mixing     * t  ',e20.13,'       ',e20.13)
310      ENDIF
311
312   END SUBROUTINE trd_tra
313
314
315   SUBROUTINE trd_tra_init
316      !!---------------------------------------------------------------------
317      !!                  ***  ROUTINE trd_tra_init  ***
318      !!
319      !! ** Purpose :   
320      !!
321      !! ** Method  :
322      !!
323      !! History :
324      !!   9.0  !  03-09  (G. Madec)  Original code
325      !!----------------------------------------------------------------------
326      !! * Local declarations
327      INTEGER :: ji, jj, jk
328
329      NAMELIST/namtrd/ ntrd, nctls
330      !!----------------------------------------------------------------------
331
332      ! set to zero the tracers trends
333      ttrd  (:,:,:,:) = 0.e0
334      strd  (:,:,:,:) = 0.e0
335      ttrdh (:,:,:,:) = 0.e0
336      strdh (:,:,:,:) = 0.e0
337      flxtrd(:,:,  :) = 0.e0
338
339      ! namelist namtrd : trend diagnostic
340      REWIND( numnam )
341      READ  ( numnam, namtrd )
342
343      IF(lwp) THEN
344         WRITE(numout,*)
345         WRITE(numout,*) 'trd_tra : read namelist namtrd'
346         WRITE(numout,*) '~~~~~~~'
347         WRITE(numout,*) '          time step frequency trend       ntrd  = ', ntrd
348      ENDIF
349
350      ! Total volume at t-points:
351      tvolt = 0.
352      DO jk = 1, jpkm1
353         DO jj = 2, jpjm1
354            DO ji = fs_2, fs_jpim1   ! vector opt.
355               tvolt = tvolt + e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk)* tmask(ji,jj,jk) * tmask_i(ji,jj)
356            END DO
357         END DO
358      END DO
359      IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain
360
361      IF(lwp) WRITE(numout,*) '          total ocean volume at T-point   tvolt = ',tvolt
362
363   END SUBROUTINE trd_tra_init
364
365#   else
366   !!----------------------------------------------------------------------
367   !!   Default case :                                         Empty module
368   !!----------------------------------------------------------------------
369   LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .FALSE.   !: momentum trend flag
370CONTAINS
371   SUBROUTINE trd_tra( kt )        ! Empty routine
372      WRITE(*,*) 'trd_tra: You should not have seen this print! error?', kt
373   END SUBROUTINE trd_tra
374   SUBROUTINE trd_tra_init         ! Empty routine
375   END SUBROUTINE trd_tra_init
376#endif
377
378   !!======================================================================
379END MODULE trdtra
Note: See TracBrowser for help on using the repository browser.