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.
trdicp.F90 in branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRD – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90 @ 2287

Last change on this file since 2287 was 2287, checked in by smasson, 14 years ago

update licence of all NEMO files...

  • Property svn:keywords set to Id
File size: 32.5 KB
Line 
1MODULE trdicp
2   !!======================================================================
3   !!                       ***  MODULE  trdicp  ***
4   !! Ocean diagnostics:  ocean tracers and dynamic trends
5   !!=====================================================================
6   !! History :  1.0  !  2004-08 (C. Talandier) New trends organization
7   !!----------------------------------------------------------------------
8#if  defined key_trdtra   ||   defined key_trddyn   ||   defined key_esopa
9   !!----------------------------------------------------------------------
10   !!   'key_trdtra'  or                  active tracers trends diagnostics
11   !!   'key_trddyn'                            momentum trends diagnostics
12   !!----------------------------------------------------------------------
13   !!   trd_icp          : compute the basin averaged properties for tra/dyn
14   !!   trd_dwr          : print dynmaic trends in ocean.output file
15   !!   trd_twr          : print tracers trends in ocean.output file
16   !!   trd_icp_init     : initialization step
17   !!----------------------------------------------------------------------
18   USE oce             ! ocean dynamics and tracers variables
19   USE dom_oce         ! ocean space and time domain variables
20   USE trdmod_oce      ! ocean variables trends
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   USE eosbn2          ! equation of state
27   USE phycst          ! physical constants
28
29   IMPLICIT NONE
30   PRIVATE
31
32   INTERFACE trd_icp
33      MODULE PROCEDURE trd_2d, trd_3d
34   END INTERFACE
35
36   PUBLIC   trd_icp       ! called by trdmod.F90
37   PUBLIC   trd_dwr       ! called by step.F90
38   PUBLIC   trd_twr       ! called by step.F90
39   PUBLIC   trd_icp_init  ! called by opa.F90
40
41   !! * Substitutions
42#  include "domzgr_substitute.h90"
43#  include "vectopt_loop_substitute.h90"
44   !!----------------------------------------------------------------------
45   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
46   !! $Id$
47   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
48   !!----------------------------------------------------------------------
49
50CONTAINS
51
52   SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype )
53      !!---------------------------------------------------------------------
54      !!                  ***  ROUTINE trd_2d  ***
55      !!
56      !! ** Purpose : verify the basin averaged properties of tracers and/or
57      !!              momentum equations at every time step frequency nn_trd.
58      !!----------------------------------------------------------------------
59      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dx             ! Temperature or U trend
60      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dy             ! Salinity    or V trend
61      INTEGER                     , INTENT(in   ) ::   ktrd                ! tracer trend index
62      CHARACTER(len=3)            , INTENT(in   ) ::   ctype               ! momentum ('DYN') or tracers ('TRA') trends
63      !!
64      INTEGER  ::   ji, jj                                                 ! loop indices
65      REAL(wp) ::   zmsku, zbtu, zbt                                       ! temporary scalars
66      REAL(wp) ::   zmskv, zbtv                                            !    "         "
67      !!----------------------------------------------------------------------
68
69
70      ! 1. Mask trends
71      ! --------------
72
73      SELECT CASE( ctype )
74      !
75      CASE( 'DYN' )              ! Momentum
76         DO jj = 1, jpjm1
77            DO ji = 1, jpim1
78               zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,1)
79               zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1)
80               ptrd2dx(ji,jj) = ptrd2dx(ji,jj) * zmsku
81               ptrd2dy(ji,jj) = ptrd2dy(ji,jj) * zmskv
82            END DO
83         END DO
84         ptrd2dx(jpi, : ) = 0.e0      ;      ptrd2dy(jpi, : ) = 0.e0
85         ptrd2dx( : ,jpj) = 0.e0      ;      ptrd2dy( : ,jpj) = 0.e0
86         !
87      CASE( 'TRA' )              ! Tracers
88         ptrd2dx(:,:) = ptrd2dx(:,:) * tmask_i(:,:)
89         ptrd2dy(:,:) = ptrd2dy(:,:) * tmask_i(:,:)
90         !
91      END SELECT
92     
93      ! 2. Basin averaged tracer/momentum trends
94      ! ----------------------------------------
95
96      SELECT CASE( ctype )
97      !
98      CASE( 'DYN' )              ! Momentum
99         umo(ktrd) = 0.e0
100         vmo(ktrd) = 0.e0
101         !
102         SELECT CASE( ktrd )
103         !
104         CASE( jpdyn_trd_swf )         ! surface forcing
105            DO jj = 1, jpj
106               DO ji = 1, jpi
107                  umo(ktrd) = umo(ktrd) + ptrd2dx(ji,jj) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1)
108                  vmo(ktrd) = vmo(ktrd) + ptrd2dy(ji,jj) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1)
109               END DO
110            END DO
111            !
112         END SELECT
113         !
114      CASE( 'TRA' )              ! Tracers
115         tmo(ktrd) = 0.e0
116         smo(ktrd) = 0.e0
117         DO jj = 1, jpj
118            DO ji = 1, jpi
119               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1)
120               tmo(ktrd) =  tmo(ktrd) + ptrd2dx(ji,jj) * zbt
121               smo(ktrd) =  smo(ktrd) + ptrd2dy(ji,jj) * zbt
122            END DO
123         END DO
124         !
125      END SELECT
126     
127      ! 3. Basin averaged tracer/momentum square trends
128      ! ----------------------------------------------
129      ! c a u t i o n: field now
130     
131      SELECT CASE( ctype )
132      !
133      CASE( 'DYN' )              ! Momentum
134         hke(ktrd) = 0.e0
135         DO jj = 1, jpj
136            DO ji = 1, jpi
137               zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1)
138               zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1)
139               hke(ktrd) = hke(ktrd)   &
140               &   + un(ji,jj,1) * ptrd2dx(ji,jj) * zbtu &
141               &   + vn(ji,jj,1) * ptrd2dy(ji,jj) * zbtv
142            END DO
143         END DO
144         !
145      CASE( 'TRA' )              ! Tracers
146         t2(ktrd) = 0.e0
147         s2(ktrd) = 0.e0
148         DO jj = 1, jpj
149            DO ji = 1, jpi
150               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1)
151               t2(ktrd) = t2(ktrd) + ptrd2dx(ji,jj) * zbt * tn(ji,jj,1)
152               s2(ktrd) = s2(ktrd) + ptrd2dy(ji,jj) * zbt * sn(ji,jj,1)
153            END DO
154         END DO
155         !     
156      END SELECT
157      !
158   END SUBROUTINE trd_2d
159
160
161   SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd, ctype )
162      !!---------------------------------------------------------------------
163      !!                  ***  ROUTINE trd_3d  ***
164      !!
165      !! ** Purpose : verify the basin averaged properties of tracers and/or
166      !!              momentum equations at every time step frequency nn_trd.
167      !!----------------------------------------------------------------------
168      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dx            ! Temperature or U trend
169      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dy            ! Salinity    or V trend
170      INTEGER,                          INTENT(in   ) ::   ktrd               ! momentum or tracer trend index
171      CHARACTER(len=3),                 INTENT(in   ) ::   ctype              ! momentum ('DYN') or tracers ('TRA') trends
172      !!
173      INTEGER ::   ji, jj, jk
174      REAL(wp) ::   zbt, zbtu, zbtv, zmsku, zmskv                             ! temporary scalars
175      !!----------------------------------------------------------------------
176
177      ! 1. Mask the trends
178      ! ------------------
179
180      SELECT CASE( ctype )
181      !
182      CASE( 'DYN' )              ! Momentum       
183         DO jk = 1, jpk
184            DO jj = 1, jpjm1
185               DO ji = 1, jpim1
186                  zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
187                  zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
188                  ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * zmsku
189                  ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * zmskv
190               END DO
191            END DO
192         END DO
193         ptrd3dx(jpi, : ,:) = 0.e0      ;      ptrd3dy(jpi, : ,:) = 0.e0
194         ptrd3dx( : ,jpj,:) = 0.e0      ;      ptrd3dy( : ,jpj,:) = 0.e0
195         !
196      CASE( 'TRA' )              ! Tracers
197         DO jk = 1, jpk
198            ptrd3dx(:,:,jk) = ptrd3dx(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)
199            ptrd3dy(:,:,jk) = ptrd3dy(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)
200         END DO
201         !
202      END SELECT   
203
204      ! 2. Basin averaged tracer/momentum trends
205      ! ----------------------------------------
206     
207      SELECT CASE( ctype )
208      !
209      CASE( 'DYN' )              ! Momentum
210         umo(ktrd) = 0.e0
211         vmo(ktrd) = 0.e0
212         DO jk = 1, jpk
213            DO jj = 1, jpj
214               DO ji = 1, jpi
215                  zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
216                  zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
217                  umo(ktrd) = umo(ktrd) + ptrd3dx(ji,jj,jk) * zbtu
218                  vmo(ktrd) = vmo(ktrd) + ptrd3dy(ji,jj,jk) * zbtv
219               END DO
220            END DO
221         END DO
222         !
223      CASE( 'TRA' )              ! Tracers
224         tmo(ktrd) = 0.e0
225         smo(ktrd) = 0.e0
226         DO jk = 1, jpkm1
227            DO jj = 1, jpj
228               DO ji = 1, jpi
229                  zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
230                  tmo(ktrd) =  tmo(ktrd) + ptrd3dx(ji,jj,jk) * zbt
231                  smo(ktrd) =  smo(ktrd) + ptrd3dy(ji,jj,jk) * zbt
232               END DO
233            END DO
234         END DO
235         !
236      END SELECT
237
238      ! 3. Basin averaged tracer/momentum square trends
239      ! -----------------------------------------------
240      ! c a u t i o n: field now
241     
242      SELECT CASE( ctype )
243      !
244      CASE( 'DYN' )              ! Momentum
245         hke(ktrd) = 0.e0
246         DO jk = 1, jpk
247            DO jj = 1, jpj
248               DO ji = 1, jpi
249                  zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
250                  zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
251                  hke(ktrd) = hke(ktrd)   &
252                  &   + un(ji,jj,jk) * ptrd3dx(ji,jj,jk) * zbtu &
253                  &   + vn(ji,jj,jk) * ptrd3dy(ji,jj,jk) * zbtv
254               END DO
255            END DO
256         END DO
257         !
258      CASE( 'TRA' )              ! Tracers
259         t2(ktrd) = 0.e0
260         s2(ktrd) = 0.e0
261         DO jk = 1, jpk
262            DO jj = 1, jpj
263               DO ji = 1, jpi
264                  zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
265                  t2(ktrd) = t2(ktrd) + ptrd3dx(ji,jj,jk) * zbt * tn(ji,jj,jk)
266                  s2(ktrd) = s2(ktrd) + ptrd3dy(ji,jj,jk) * zbt * sn(ji,jj,jk)
267               END DO
268            END DO
269         END DO
270         !
271      END SELECT
272      !
273   END SUBROUTINE trd_3d
274
275
276
277   SUBROUTINE trd_icp_init
278      !!---------------------------------------------------------------------
279      !!                  ***  ROUTINE trd_icp_init  ***
280      !!
281      !! ** Purpose :   Read the namtrd namelist
282      !!----------------------------------------------------------------------
283      INTEGER  ::   ji, jj, jk
284      REAL(wp) ::   zmskt
285#if  defined key_trddyn
286      REAL(wp) ::   zmsku, zmskv
287#endif
288      !!----------------------------------------------------------------------
289
290      IF(lwp) THEN
291         WRITE(numout,*)
292         WRITE(numout,*) 'trd_icp_init : integral constraints properties trends'
293         WRITE(numout,*) '~~~~~~~~~~~~~'
294      ENDIF
295
296      ! Total volume at t-points:
297      tvolt = 0.e0
298      DO jk = 1, jpkm1
299         DO jj = 2, jpjm1
300            DO ji = fs_2, fs_jpim1   ! vector opt.
301               zmskt = tmask(ji,jj,jk) * tmask_i(ji,jj)
302               tvolt = tvolt + zmskt * e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk)
303            END DO
304         END DO
305      END DO
306      IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain
307
308      IF(lwp) WRITE(numout,*) '                total ocean volume at T-point   tvolt = ',tvolt
309
310#if  defined key_trddyn
311      ! Initialization of potential to kinetic energy conversion
312      rpktrd = 0.e0
313
314      ! Total volume at u-, v- points:
315      tvolu = 0.e0
316      tvolv = 0.e0
317
318      DO jk = 1, jpk
319         DO jj = 2, jpjm1
320            DO ji = fs_2, fs_jpim1   ! vector opt.
321               zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
322               zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
323               tvolu = tvolu + zmsku * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
324               tvolv = tvolv + zmskv * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
325            END DO
326         END DO
327      END DO
328      IF( lk_mpp )   CALL mpp_sum( tvolu )   ! sums over the global domain
329      IF( lk_mpp )   CALL mpp_sum( tvolv )
330
331      IF(lwp) THEN
332         WRITE(numout,*) '                total ocean volume at U-point   tvolu = ',tvolu
333         WRITE(numout,*) '                total ocean volume at V-point   tvolv = ',tvolv
334      ENDIF
335#endif
336      !
337   END SUBROUTINE trd_icp_init
338
339
340   SUBROUTINE trd_dwr( kt )
341      !!---------------------------------------------------------------------
342      !!                  ***  ROUTINE trd_dwr  ***
343      !!
344      !! ** Purpose :  write dynamic trends in ocean.output
345      !!----------------------------------------------------------------------
346      INTEGER, INTENT(in) ::   kt                                  ! ocean time-step index
347      !!
348      INTEGER  ::   ji, jj, jk
349      REAL(wp) ::   ze1e2w, zcof, zbe1ru, zbe2rv, zbtr, ztz, zth   !    "      scalars
350      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zkepe, zkx, zky, zkz   ! temporary arrays
351      !!----------------------------------------------------------------------
352
353      ! I. Momentum trends
354      ! -------------------
355
356      IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN
357
358         ! I.1 Conversion potential energy - kinetic energy
359         ! --------------------------------------------------
360         ! c a u t i o n here, trends are computed at kt+1 (now , but after the swap)
361
362         zkx(:,:,:)   = 0.e0
363         zky(:,:,:)   = 0.e0
364         zkz(:,:,:)   = 0.e0
365         zkepe(:,:,:) = 0.e0
366   
367         CALL eos( tsn, rhd, rhop )       ! now potential and in situ densities
368
369         ! Density flux at w-point
370         DO jk = 2, jpk
371            DO jj = 1, jpj
372               DO ji = 1, jpi
373                  ze1e2w = 0.5 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) * tmask_i(ji,jj)
374                  zkz(ji,jj,jk) = ze1e2w / rau0 * ( rhop(ji,jj,jk) + rhop(ji,jj,jk-1) )
375               END DO
376            END DO
377         END DO
378         zkz(:,:,1) = 0.e0
379         
380         ! Density flux at u and v-points
381         DO jk = 1, jpk
382            DO jj = 1, jpjm1
383               DO ji = 1, jpim1
384                  zcof   = 0.5 / rau0
385                  zbe1ru = zcof * e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk)
386                  zbe2rv = zcof * e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk)
387                  zkx(ji,jj,jk) = zbe1ru * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) )
388                  zky(ji,jj,jk) = zbe2rv * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) )
389               END DO
390            END DO
391         END DO
392         
393         ! Density flux divergence at t-point
394         DO jk = 1, jpkm1
395            DO jj = 2, jpjm1
396               DO ji = 2, jpim1
397                  zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
398                  ztz = - zbtr * (    zkz(ji,jj,jk) - zkz(ji,jj,jk+1) )
399                  zth = - zbtr * (  ( zkx(ji,jj,jk) - zkx(ji-1,jj,jk) )   &
400                    &             + ( zky(ji,jj,jk) - zky(ji,jj-1,jk) )  )
401                  zkepe(ji,jj,jk) = (zth + ztz) * tmask(ji,jj,jk) * tmask_i(ji,jj)
402               END DO
403            END DO
404         END DO
405         zkepe( : , : ,jpk) = 0.e0
406         zkepe( : ,jpj, : ) = 0.e0
407         zkepe(jpi, : , : ) = 0.e0
408
409         ! I.2 Basin averaged kinetic energy trend
410         ! ----------------------------------------
411         peke = 0.e0
412         DO jk = 1,jpk
413            DO jj = 1, jpj
414               DO ji = 1, jpi
415                  peke = peke + zkepe(ji,jj,jk) * grav * fsdept(ji,jj,jk)   &
416                     &                     * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
417               END DO
418            END DO
419         END DO
420
421         ! I.3 Sums over the global domain
422         ! ---------------------------------
423         IF( lk_mpp ) THEN
424            CALL mpp_sum( peke )
425            CALL mpp_sum( umo , jptot_dyn )
426            CALL mpp_sum( vmo , jptot_dyn )
427            CALL mpp_sum( hke , jptot_dyn )
428         ENDIF
429
430         ! I.2 Print dynamic trends in the ocean.output file
431         ! --------------------------------------------------
432
433         IF(lwp) THEN
434            WRITE (numout,*)
435            WRITE (numout,*)
436            WRITE (numout,9500) kt
437            WRITE (numout,9501) umo(jpicpd_hpg) / tvolu, vmo(jpicpd_hpg) / tvolv
438            WRITE (numout,9502) umo(jpicpd_keg) / tvolu, vmo(jpicpd_keg) / tvolv
439            WRITE (numout,9503) umo(jpicpd_rvo) / tvolu, vmo(jpicpd_rvo) / tvolv
440            WRITE (numout,9504) umo(jpicpd_pvo) / tvolu, vmo(jpicpd_pvo) / tvolv
441            WRITE (numout,9505) umo(jpicpd_ldf) / tvolu, vmo(jpicpd_ldf) / tvolv
442            WRITE (numout,9506) umo(jpicpd_had) / tvolu, vmo(jpicpd_had) / tvolv
443            WRITE (numout,9507) umo(jpicpd_zad) / tvolu, vmo(jpicpd_zad) / tvolv
444            WRITE (numout,9508) umo(jpicpd_zdf) / tvolu, vmo(jpicpd_zdf) / tvolv
445            WRITE (numout,9509) umo(jpicpd_spg) / tvolu, vmo(jpicpd_spg) / tvolv
446            WRITE (numout,9510) umo(jpicpd_swf) / tvolu, vmo(jpicpd_swf) / tvolv
447            WRITE (numout,9511) umo(jpicpd_dat) / tvolu, vmo(jpicpd_dat) / tvolv
448            WRITE (numout,9512) umo(jpicpd_bfr) / tvolu, vmo(jpicpd_bfr) / tvolv
449            WRITE (numout,9513)
450            WRITE (numout,9514)                                                 &
451            &     (  umo(jpicpd_hpg) + umo(jpicpd_keg) + umo(jpicpd_rvo) + umo(jpicpd_pvo) + umo(jpicpd_ldf)   &
452            &      + umo(jpicpd_had) + umo(jpicpd_zad) + umo(jpicpd_zdf) + umo(jpicpd_spg) + umo(jpicpd_dat)   &
453            &      + umo(jpicpd_swf) + umo(jpicpd_bfr) ) / tvolu,   &
454            &     (  vmo(jpicpd_hpg) + vmo(jpicpd_keg) + vmo(jpicpd_rvo) + vmo(jpicpd_pvo) + vmo(jpicpd_ldf)   &
455            &      + vmo(jpicpd_had) + vmo(jpicpd_zad) + vmo(jpicpd_zdf) + vmo(jpicpd_spg) + vmo(jpicpd_dat)   &
456            &      + vmo(jpicpd_swf) + vmo(jpicpd_bfr) ) / tvolv
457         ENDIF
458
459 9500    FORMAT(' momentum trend at it= ', i6, ' :', /' ==============================')
460 9501    FORMAT(' pressure gradient          u= ', e20.13, '    v= ', e20.13)
461 9502    FORMAT(' ke gradient                u= ', e20.13, '    v= ', e20.13)
462 9503    FORMAT(' relative vorticity term    u= ', e20.13, '    v= ', e20.13)
463 9504    FORMAT(' coriolis term              u= ', e20.13, '    v= ', e20.13)
464 9505    FORMAT(' horizontal diffusion       u= ', e20.13, '    v= ', e20.13)
465 9506    FORMAT(' horizontal advection       u= ', e20.13, '    v= ', e20.13)
466 9507    FORMAT(' vertical advection         u= ', e20.13, '    v= ', e20.13)
467 9508    FORMAT(' vertical diffusion         u= ', e20.13, '    v= ', e20.13)
468 9509    FORMAT(' surface pressure gradient  u= ', e20.13, '    v= ', e20.13)
469 9510    FORMAT(' surface wind forcing       u= ', e20.13, '    v= ', e20.13)
470 9511    FORMAT(' dampimg term               u= ', e20.13, '    v= ', e20.13)
471 9512    FORMAT(' bottom flux                u= ', e20.13, '    v= ', e20.13)
472 9513    FORMAT(' -----------------------------------------------------------------------------')
473 9514    FORMAT(' total trend                u= ', e20.13, '    v= ', e20.13)
474
475         IF(lwp) THEN
476            WRITE (numout,*)
477            WRITE (numout,*)
478            WRITE (numout,9520) kt
479            WRITE (numout,9521) hke(jpicpd_hpg) / tvolt
480            WRITE (numout,9522) hke(jpicpd_keg) / tvolt
481            WRITE (numout,9523) hke(jpicpd_rvo) / tvolt
482            WRITE (numout,9524) hke(jpicpd_pvo) / tvolt
483            WRITE (numout,9525) hke(jpicpd_ldf) / tvolt
484            WRITE (numout,9526) hke(jpicpd_had) / tvolt
485            WRITE (numout,9527) hke(jpicpd_zad) / tvolt
486            WRITE (numout,9528) hke(jpicpd_zdf) / tvolt
487            WRITE (numout,9529) hke(jpicpd_spg) / tvolt
488            WRITE (numout,9530) hke(jpicpd_swf) / tvolt
489            WRITE (numout,9531) hke(jpicpd_dat) / tvolt
490            WRITE (numout,9532) hke(jpicpd_bfr) / tvolt
491            WRITE (numout,9533)
492            WRITE (numout,9534)   &
493            &     (  hke(jpicpd_hpg) + hke(jpicpd_keg) + hke(jpicpd_rvo) + hke(jpicpd_pvo) + hke(jpicpd_ldf)   &
494            &      + hke(jpicpd_had) + hke(jpicpd_zad) + hke(jpicpd_zdf) + hke(jpicpd_spg) + hke(jpicpd_dat)   &
495            &      + hke(jpicpd_swf) + hke(jpicpd_bfr) ) / tvolt
496         ENDIF
497
498 9520    FORMAT(' kinetic energy trend at it= ', i6, ' :', /' ====================================')
499 9521    FORMAT(' pressure gradient         u2= ', e20.13)
500 9522    FORMAT(' ke gradient               u2= ', e20.13)
501 9523    FORMAT(' relative vorticity term   u2= ', e20.13)
502 9524    FORMAT(' coriolis term             u2= ', e20.13)
503 9525    FORMAT(' horizontal diffusion      u2= ', e20.13)
504 9526    FORMAT(' horizontal advection      u2= ', e20.13)
505 9527    FORMAT(' vertical advection        u2= ', e20.13)
506 9528    FORMAT(' vertical diffusion        u2= ', e20.13)
507 9529    FORMAT(' surface pressure gradient u2= ', e20.13)
508 9530    FORMAT(' surface wind forcing      u2= ', e20.13)
509 9531    FORMAT(' dampimg term              u2= ', e20.13)
510 9532    FORMAT(' bottom flux               u2= ', e20.13)
511 9533    FORMAT(' --------------------------------------------------')
512 9534    FORMAT(' total trend               u2= ', e20.13)
513
514         IF(lwp) THEN
515            WRITE (numout,*)
516            WRITE (numout,*)
517            WRITE (numout,9540) kt
518            WRITE (numout,9541) ( hke(jpicpd_keg) + hke(jpicpd_rvo) + hke(jpicpd_had) + hke(jpicpd_zad) ) / tvolt
519            WRITE (numout,9542) ( hke(jpicpd_keg) + hke(jpicpd_had) + hke(jpicpd_zad) ) / tvolt
520            WRITE (numout,9543) ( hke(jpicpd_pvo) ) / tvolt
521            WRITE (numout,9544) ( hke(jpicpd_rvo) ) / tvolt
522            WRITE (numout,9545) ( hke(jpicpd_spg) ) / tvolt
523            WRITE (numout,9546) ( hke(jpicpd_ldf) ) / tvolt
524            WRITE (numout,9547) ( hke(jpicpd_zdf) ) / tvolt
525            WRITE (numout,9548) ( hke(jpicpd_hpg) ) / tvolt, rpktrd / tvolt
526            WRITE (numout,*)
527            WRITE (numout,*)
528         ENDIF
529
530 9540    FORMAT(' energetic consistency at it= ', i6, ' :', /' =========================================')
531 9541    FORMAT(' 0 = non linear term(true if key_vorenergy or key_combined): ', e20.13)
532 9542    FORMAT(' 0 = ke gradient + horizontal + vertical advection         : ', e20.13)
533 9543    FORMAT(' 0 = coriolis term  (true if key_vorenergy or key_combined): ', e20.13)
534 9544    FORMAT(' 0 = uh.( rot(u) x uh ) (true if enstrophy conser.)        : ', e20.13)
535 9545    FORMAT(' 0 = surface pressure gradient                             : ', e20.13)
536 9546    FORMAT(' 0 > horizontal diffusion                                  : ', e20.13)
537 9547    FORMAT(' 0 > vertical diffusion                                    : ', e20.13)
538 9548    FORMAT(' pressure gradient u2 = - 1/rau0 u.dz(rhop)                : ', e20.13, '  u.dz(rhop) =', e20.13)
539         !
540         ! Save potential to kinetic energy conversion for next time step
541         rpktrd = peke
542         !
543      ENDIF
544      !
545   END SUBROUTINE trd_dwr
546
547
548   SUBROUTINE trd_twr( kt )
549      !!---------------------------------------------------------------------
550      !!                  ***  ROUTINE trd_twr  ***
551      !!
552      !! ** Purpose :  write active tracers trends in ocean.output
553      !!----------------------------------------------------------------------
554      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
555      !!----------------------------------------------------------------------
556
557      ! I. Tracers trends
558      ! -----------------
559
560      IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN
561
562         ! I.1 Sums over the global domain
563         ! -------------------------------
564         IF( lk_mpp ) THEN
565            CALL mpp_sum( tmo, jptot_tra )   
566            CALL mpp_sum( smo, jptot_tra )
567            CALL mpp_sum( t2 , jptot_tra )
568            CALL mpp_sum( s2 , jptot_tra )
569         ENDIF
570
571         ! I.2 Print tracers trends in the ocean.output file
572         ! --------------------------------------------------
573         
574         IF(lwp) THEN
575            WRITE (numout,*)
576            WRITE (numout,*)
577            WRITE (numout,9400) kt
578            WRITE (numout,9401)  tmo(jpicpt_xad) / tvolt, smo(jpicpt_xad) / tvolt
579            WRITE (numout,9411)  tmo(jpicpt_yad) / tvolt, smo(jpicpt_yad) / tvolt
580            WRITE (numout,9402)  tmo(jpicpt_zad) / tvolt, smo(jpicpt_zad) / tvolt
581            WRITE (numout,9403)  tmo(jpicpt_ldf) / tvolt, smo(jpicpt_ldf) / tvolt
582            WRITE (numout,9404)  tmo(jpicpt_zdf) / tvolt, smo(jpicpt_zdf) / tvolt
583            WRITE (numout,9405)  tmo(jpicpt_npc) / tvolt, smo(jpicpt_npc) / tvolt
584            WRITE (numout,9406)  tmo(jpicpt_dmp) / tvolt, smo(jpicpt_dmp) / tvolt
585            WRITE (numout,9407)  tmo(jpicpt_qsr) / tvolt
586            WRITE (numout,9408)  tmo(jpicpt_nsr) / tvolt, smo(jpicpt_nsr) / tvolt
587            WRITE (numout,9409) 
588            WRITE (numout,9410) (  tmo(jpicpt_xad) + tmo(jpicpt_yad) + tmo(jpicpt_zad) + tmo(jpicpt_ldf) + tmo(jpicpt_zdf)   &
589            &                    + tmo(jpicpt_npc) + tmo(jpicpt_dmp) + tmo(jpicpt_qsr) + tmo(jpicpt_nsr) ) / tvolt,   &
590            &                   (  smo(jpicpt_xad) + smo(jpicpt_yad) + smo(jpicpt_zad) + smo(jpicpt_ldf) + smo(jpicpt_zdf)   &
591            &                    + smo(jpicpt_npc) + smo(jpicpt_dmp)                   + smo(jpicpt_nsr) ) / tvolt
592         ENDIF
593
5949400     FORMAT(' tracer trend at it= ',i6,' :     temperature',   &
595              '              salinity',/' ============================')
5969401     FORMAT(' zonal      advection        ',e20.13,'     ',e20.13)
5979411     FORMAT(' meridional advection        ',e20.13,'     ',e20.13)
5989402     FORMAT(' vertical advection          ',e20.13,'     ',e20.13)
5999403     FORMAT(' horizontal diffusion        ',e20.13,'     ',e20.13)
6009404     FORMAT(' vertical diffusion          ',e20.13,'     ',e20.13)
6019405     FORMAT(' static instability mixing   ',e20.13,'     ',e20.13)
6029406     FORMAT(' damping term                ',e20.13,'     ',e20.13)
6039407     FORMAT(' penetrative qsr             ',e20.13)
6049408     FORMAT(' non solar radiation         ',e20.13,'     ',e20.13)
6059409     FORMAT(' -------------------------------------------------------------------------')
6069410     FORMAT(' total trend                 ',e20.13,'     ',e20.13)
607
608
609         IF(lwp) THEN
610            WRITE (numout,*)
611            WRITE (numout,*)
612            WRITE (numout,9420) kt
613            WRITE (numout,9421)   t2(jpicpt_xad) / tvolt, s2(jpicpt_xad) / tvolt
614            WRITE (numout,9431)   t2(jpicpt_yad) / tvolt, s2(jpicpt_yad) / tvolt
615            WRITE (numout,9422)   t2(jpicpt_zad) / tvolt, s2(jpicpt_zad) / tvolt
616            WRITE (numout,9423)   t2(jpicpt_ldf) / tvolt, s2(jpicpt_ldf) / tvolt
617            WRITE (numout,9424)   t2(jpicpt_zdf) / tvolt, s2(jpicpt_zdf) / tvolt
618            WRITE (numout,9425)   t2(jpicpt_npc) / tvolt, s2(jpicpt_npc) / tvolt
619            WRITE (numout,9426)   t2(jpicpt_dmp) / tvolt, s2(jpicpt_dmp) / tvolt
620            WRITE (numout,9427)   t2(jpicpt_qsr) / tvolt
621            WRITE (numout,9428)   t2(jpicpt_nsr) / tvolt, s2(jpicpt_nsr) / tvolt
622            WRITE (numout,9429)
623            WRITE (numout,9430) (  t2(jpicpt_xad) + t2(jpicpt_yad) + t2(jpicpt_zad) + t2(jpicpt_ldf) + t2(jpicpt_zdf)   &
624            &                    + t2(jpicpt_npc) + t2(jpicpt_dmp) + t2(jpicpt_qsr) + t2(jpicpt_nsr) ) / tvolt,   &
625            &                   (  s2(jpicpt_xad) + s2(jpicpt_yad) + s2(jpicpt_zad) + s2(jpicpt_ldf) + s2(jpicpt_zdf)   &
626            &                    + s2(jpicpt_npc) + s2(jpicpt_dmp)                  + s2(jpicpt_nsr) ) / tvolt
627         ENDIF
628
6299420     FORMAT(' tracer**2 trend at it= ', i6, ' :      temperature',   &
630            '               salinity', /, ' ===============================')
6319421     FORMAT(' zonal      advection      * t   ', e20.13, '     ', e20.13)
6329431     FORMAT(' meridional advection      * t   ', e20.13, '     ', e20.13)
6339422     FORMAT(' vertical advection        * t   ', e20.13, '     ', e20.13)
6349423     FORMAT(' horizontal diffusion      * t   ', e20.13, '     ', e20.13)
6359424     FORMAT(' vertical diffusion        * t   ', e20.13, '     ', e20.13)
6369425     FORMAT(' static instability mixing * t   ', e20.13, '     ', e20.13)
6379426     FORMAT(' damping term              * t   ', e20.13, '     ', e20.13)
6389427     FORMAT(' penetrative qsr           * t   ', e20.13)
6399428     FORMAT(' non solar radiation       * t   ', e20.13, '     ', e20.13)
6409429     FORMAT(' -----------------------------------------------------------------------------')
6419430     FORMAT(' total trend                *t = ', e20.13, '  *s = ', e20.13)
642
643
644         IF(lwp) THEN
645            WRITE (numout,*)
646            WRITE (numout,*)
647            WRITE (numout,9440) kt
648            WRITE (numout,9441) ( tmo(jpicpt_xad)+tmo(jpicpt_yad)+tmo(jpicpt_zad) )/tvolt,   &
649            &                   ( smo(jpicpt_xad)+smo(jpicpt_yad)+smo(jpicpt_zad) )/tvolt
650            WRITE (numout,9442)   tmo(jpicpt_zl1)/tvolt,  smo(jpicpt_zl1)/tvolt
651            WRITE (numout,9443)   tmo(jpicpt_ldf)/tvolt,  smo(jpicpt_ldf)/tvolt
652            WRITE (numout,9444)   tmo(jpicpt_zdf)/tvolt,  smo(jpicpt_zdf)/tvolt
653            WRITE (numout,9445)   tmo(jpicpt_npc)/tvolt,  smo(jpicpt_npc)/tvolt
654            WRITE (numout,9446) ( t2(jpicpt_xad)+t2(jpicpt_yad)+t2(jpicpt_zad) )/tvolt,    &
655            &                   ( s2(jpicpt_xad)+s2(jpicpt_yad)+s2(jpicpt_zad) )/tvolt
656            WRITE (numout,9447)   t2(jpicpt_ldf)/tvolt,   s2(jpicpt_ldf)/tvolt
657            WRITE (numout,9448)   t2(jpicpt_zdf)/tvolt,   s2(jpicpt_zdf)/tvolt
658            WRITE (numout,9449)   t2(jpicpt_npc)/tvolt,   s2(jpicpt_npc)/tvolt
659         ENDIF
660
6619440     FORMAT(' tracer consistency at it= ',i6,   &
662            ' :         temperature','                salinity',/,   &
663            ' ==================================')
6649441     FORMAT(' 0 = horizontal+vertical advection +    ',e20.13,'       ',e20.13)
6659442     FORMAT('     1st lev vertical advection         ',e20.13,'       ',e20.13)
6669443     FORMAT(' 0 = horizontal diffusion               ',e20.13,'       ',e20.13)
6679444     FORMAT(' 0 = vertical diffusion                 ',e20.13,'       ',e20.13)
6689445     FORMAT(' 0 = static instability mixing          ',e20.13,'       ',e20.13)
6699446     FORMAT(' 0 = horizontal+vertical advection * t  ',e20.13,'       ',e20.13)
6709447     FORMAT(' 0 > horizontal diffusion          * t  ',e20.13,'       ',e20.13)
6719448     FORMAT(' 0 > vertical diffusion            * t  ',e20.13,'       ',e20.13)
6729449     FORMAT(' 0 > static instability mixing     * t  ',e20.13,'       ',e20.13)
673         !
674      ENDIF
675      !
676   END SUBROUTINE trd_twr
677
678#   else
679   !!----------------------------------------------------------------------
680   !!   Default case :                                         Empty module
681   !!----------------------------------------------------------------------
682   INTERFACE trd_icp
683      MODULE PROCEDURE trd_2d, trd_3d
684   END INTERFACE
685
686CONTAINS
687   SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype )       ! Empty routine
688      REAL, DIMENSION(:,:) ::   ptrd2dx, ptrd2dy
689      INTEGER                     , INTENT(in   ) ::   ktrd         ! tracer trend index
690      CHARACTER(len=3)            , INTENT(in   ) ::   ctype        ! momentum ('DYN') or tracers ('TRA') trends
691      WRITE(*,*) 'trd_2d: You should not have seen this print! error ?', &
692          &       ptrd2dx(1,1), ptrd2dy(1,1), ktrd, ctype
693   END SUBROUTINE trd_2d
694   SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd , ctype )       ! Empty routine
695      REAL, DIMENSION(:,:,:) ::   ptrd3dx, ptrd3dy
696      INTEGER                     , INTENT(in   ) ::   ktrd         ! tracer trend index
697      CHARACTER(len=3)            , INTENT(in   ) ::   ctype        ! momentum ('DYN') or tracers ('TRA') trends
698      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', &
699          &       ptrd3dx(1,1,1), ptrd3dy(1,1,1), ktrd, ctype
700   END SUBROUTINE trd_3d
701   SUBROUTINE trd_icp_init               ! Empty routine
702   END SUBROUTINE trd_icp_init
703   SUBROUTINE trd_dwr( kt )          ! Empty routine
704      WRITE(*,*) 'trd_dwr: You should not have seen this print! error ?', kt
705   END SUBROUTINE trd_dwr
706   SUBROUTINE trd_twr( kt )          ! Empty routine
707      WRITE(*,*) 'trd_twr: You should not have seen this print! error ?', kt
708   END SUBROUTINE trd_twr
709#endif
710
711   !!======================================================================
712END MODULE trdicp
Note: See TracBrowser for help on using the repository browser.