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 trunk/NEMO/OPA_SRC/TRD – NEMO

source: trunk/NEMO/OPA_SRC/TRD/trdicp.F90 @ 215

Last change on this file since 215 was 215, checked in by opalod, 19 years ago

CT : UPDATE151 : New trends organization

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 33.4 KB
Line 
1MODULE trdicp
2   !!======================================================================
3   !!                       ***  MODULE  trdicp  ***
4   !! Ocean diagnostics:  ocean tracers and dynamic trends
5   !!=====================================================================
6#if  defined key_trdtra   ||   defined key_trddyn   ||   defined key_esopa
7   !!----------------------------------------------------------------------
8   !!   'key_trdtra'  or                  active tracers trends diagnostics
9   !!   'key_trddyn'                            momentum trends diagnostics
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   trd              : verify 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   !! * Modules used
19   USE oce             ! ocean dynamics and tracers variables
20   USE dom_oce         ! ocean space and time domain variables
21   USE trdmod_oce      ! ocean variables trends
22   USE ldftra_oce      ! ocean active tracers: lateral physics
23   USE ldfdyn_oce      ! ocean dynamics: lateral physics
24   USE zdf_oce         ! ocean vertical physics
25   USE in_out_manager  ! I/O manager
26   USE lib_mpp         ! distibuted memory computing library
27   USE eosbn2          ! equation of state
28   USE phycst          ! physical constants
29
30   IMPLICIT NONE
31   PRIVATE
32
33   !! * Interfaces
34   INTERFACE trd
35      MODULE PROCEDURE trd_2d, trd_3d
36   END INTERFACE
37
38   !! * Routine accessibility
39   PUBLIC trd                   ! called by step.F90
40   PUBLIC trd_dwr               ! called by step.F90
41   PUBLIC trd_twr               ! called by step.F90
42   PUBLIC trd_icp_init          ! called by opa.F90
43
44   !! * Shared module variables
45#if  defined key_trdtra   &&   defined key_trddyn
46   LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .TRUE.    !: tracers  trend flag
47   LOGICAL, PUBLIC, PARAMETER ::   lk_trddyn = .TRUE.    !: momentum trend flag
48#elif  defined key_trdtra
49   LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .TRUE.    !: tracers  trend flag
50   LOGICAL, PUBLIC, PARAMETER ::   lk_trddyn = .FALSE.   !: momentum trend flag
51#elif  defined key_trddyn
52   LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .FALSE.   !: tracers  trend flag
53   LOGICAL, PUBLIC, PARAMETER ::   lk_trddyn = .TRUE.    !: momentum trend flag
54#endif
55
56   !! * Substitutions
57#  include "domzgr_substitute.h90"
58#  include "vectopt_loop_substitute.h90"
59   !!----------------------------------------------------------------------
60   !!   OPA 9.0 , LODYC-IPSL  (2004)
61   !!----------------------------------------------------------------------
62
63CONTAINS
64
65   SUBROUTINE trd_2d(ptrd2dx, ptrd2dy, ktrd , ctype)
66      !!---------------------------------------------------------------------
67      !!                  ***  ROUTINE trd_2d  ***
68      !!
69      !! ** Purpose : verify the basin averaged properties of tracers and/or
70      !!              momentum equations at every time step frequency ntrd.
71      !!
72      !! ** Method :
73      !!
74      !! History :
75      !!        !  91-12 (G. Madec)
76      !!        !  92-06 (M. Imbard) add time step frequency
77      !!        !  96-01 (G. Madec)  terrain following coordinates
78      !!   8.5  !  02-06 (G. Madec)  F90: Free form and module
79      !!   9.0  !  04-08 (C. Talandier) New trends organization
80      !!----------------------------------------------------------------------
81      !! * Arguments
82      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
83         ptrd2dx,                      &   ! Temperature or U trend
84         ptrd2dy                           ! Salinity    or V trend
85
86      INTEGER, INTENT( in ) ::   ktrd      ! tracer trend index
87
88      CHARACTER(len=3), INTENT( in ) ::   &
89         ctype                             ! momentum or tracers trends type
90         !                                 ! 'DYN' or 'TRA'
91
92      !! * Local declarations
93      INTEGER ::   ji, jj        ! loop indices
94      REAL(wp) ::   &
95         zbt, zbtu, zbtv,     &  ! temporary scalars
96         zmsku, zmskv            !    "         "
97      !!----------------------------------------------------------------------
98
99      ! 1. Advective trends and forcing trend
100      ! -------------------------------------
101
102      ! 1.1 Mask the forcing trend and substract it from the vertical diffusion trend
103      SELECT CASE (ctype)
104
105      CASE ('DYN')              ! Momentum
106         DO jj = 1, jpjm1
107            DO ji = 1, jpim1
108               zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,1)
109               zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1)
110               ptrd2dx(ji,jj) = ptrd2dx(ji,jj) * zmsku
111               ptrd2dy(ji,jj) = ptrd2dy(ji,jj) * zmskv
112            END DO
113         END DO
114         ptrd2dx(jpi, : ) = 0.e0      ;      ptrd2dy(jpi, : ) = 0.e0
115         ptrd2dx( : ,jpj) = 0.e0      ;      ptrd2dy( : ,jpj) = 0.e0
116
117      CASE ('TRA')              ! Tracers
118         ptrd2dx(:,:) = ptrd2dx(:,:) * tmask_i(:,:)
119         ptrd2dy(:,:) = ptrd2dy(:,:) * tmask_i(:,:)
120
121      END SELECT
122     
123      ! 2. Basin averaged tracer trend
124      ! ------------------------------
125
126      SELECT CASE (ctype)
127
128      CASE ('DYN')              ! Momentum
129         umo(ktrd) = 0.e0
130         vmo(ktrd) = 0.e0
131
132         SELECT CASE (ktrd)
133
134         CASE (jpdtdswf)         ! surface forcing
135            DO jj = 1, jpj
136               DO ji = 1, jpi
137                  umo(ktrd) = umo(ktrd) + ptrd2dx(ji,jj) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1)
138                  vmo(ktrd) = vmo(ktrd) + ptrd2dy(ji,jj) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1)
139               END DO
140            END DO
141
142         CASE (jpdtdbfr)         ! bottom friction fluxes
143            DO jj = 1, jpj
144               DO ji = 1, jpi
145                  umo(ktrd) = umo(ktrd) + ptrd2dx(ji,jj)
146                  vmo(ktrd) = vmo(ktrd) + ptrd2dy(ji,jj)
147               END DO
148            END DO
149
150         END SELECT
151
152      CASE ('TRA')              ! Tracers
153         tmo(ktrd) = 0.e0
154         smo(ktrd) = 0.e0
155         DO jj = 1, jpj
156            DO ji = 1, jpi
157               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1)
158               tmo(ktrd) =  tmo(ktrd) + ptrd2dx(ji,jj) * zbt
159               smo(ktrd) =  smo(ktrd) + ptrd2dy(ji,jj) * zbt
160            END DO
161         END DO
162
163      END SELECT
164     
165      ! 3. Basin averaged tracer square trend
166      ! -------------------------------------
167      ! c a u t i o n: field now
168     
169      SELECT CASE (ctype)
170
171      CASE ('DYN')              ! Momentum
172         hke(ktrd) = 0.e0
173         DO jj = 1, jpj
174            DO ji = 1, jpi
175               zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1)
176               zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1)
177               hke(ktrd) = hke(ktrd)   &
178               &   + un(ji,jj,1) * ptrd2dx(ji,jj) * zbtu &
179               &   + vn(ji,jj,1) * ptrd2dy(ji,jj) * zbtv
180            END DO
181         END DO
182
183      CASE ('TRA')              ! Tracers
184         t2(ktrd) = 0.e0
185         s2(ktrd) = 0.e0
186         DO jj = 1, jpj
187            DO ji = 1, jpi
188               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1)
189               t2(ktrd) = t2(ktrd) + ptrd2dx(ji,jj) * zbt * tn(ji,jj,1)
190               s2(ktrd) = s2(ktrd) + ptrd2dy(ji,jj) * zbt * sn(ji,jj,1)
191            END DO
192         END DO
193     
194      END SELECT
195
196   END SUBROUTINE trd_2d
197
198
199
200   SUBROUTINE trd_3d(ptrd3dx, ptrd3dy, ktrd, ctype)
201      !!---------------------------------------------------------------------
202      !!                  ***  ROUTINE trd_3d  ***
203      !!
204      !! ** Purpose : verify the basin averaged properties of tracers and/or
205      !!              momentum equations at every time step frequency ntrd.
206      !!
207      !! ** Method :
208      !!
209      !! History :
210      !!        !  91-12 (G. Madec)
211      !!        !  92-06 (M. Imbard) add time step frequency
212      !!        !  96-01 (G. Madec)  terrain following coordinates
213      !!   8.5  !  02-06 (G. Madec)  F90: Free form and module
214      !!   9.0  !  04-08 (C. Talandier) New trends organization
215      !!----------------------------------------------------------------------
216      !! * Arguments
217      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
218          ptrd3dx,                     &   ! Temperature or U trend
219          ptrd3dy                          ! Salinity    or V trend
220
221      INTEGER, INTENT( in ) ::   ktrd      ! momentum or tracer trend index
222
223      CHARACTER(len=3), INTENT( in ) ::   &
224         ctype                             ! momentum or tracers trends type
225         !                                 ! 'DYN' or 'TRA'
226
227      !! * Local declarations
228      INTEGER ::   ji, jj, jk
229      REAL(wp) ::   &
230         zbt, zbtu, zbtv,               &  ! temporary scalars
231         zmsku, zmskv
232      !!----------------------------------------------------------------------
233
234      ! 1. Advective trends and forcing trend
235      ! -------------------------------------
236
237      ! Mask the trends
238      SELECT CASE (ctype)
239
240      CASE ('DYN')              ! Momentum       
241         DO jk = 1, jpk
242            DO jj = 1, jpjm1
243               DO ji = 1, jpim1
244                  zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
245                  zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
246                  ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * zmsku
247                  ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * zmskv
248               ENDDO
249            ENDDO
250         ENDDO
251
252         ptrd3dx(jpi, : ,:) = 0.e0      ;      ptrd3dy(jpi, : ,:) = 0.e0
253         ptrd3dx( : ,jpj,:) = 0.e0      ;      ptrd3dy( : ,jpj,:) = 0.e0
254
255      CASE ('TRA')              ! Tracers
256         DO jk = 1, jpk
257            ptrd3dx(:,:,jk) = ptrd3dx(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)
258            ptrd3dy(:,:,jk) = ptrd3dy(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)
259         ENDDO
260
261      END SELECT   
262
263      ! 2. Basin averaged tracer/momentum trend
264      ! ---------------------------------------
265     
266      SELECT CASE (ctype)
267
268      CASE ('DYN')              ! Momentum
269         umo(ktrd) = 0.e0
270         vmo(ktrd) = 0.e0
271         DO jk = 1, jpk
272            DO jj = 1, jpj
273               DO ji = 1, jpi
274                  zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
275                  zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
276                  umo(ktrd) = umo(ktrd) + ptrd3dx(ji,jj,jk) * zbtu
277                  vmo(ktrd) = vmo(ktrd) + ptrd3dy(ji,jj,jk) * zbtv
278               END DO
279            END DO
280         END DO
281
282      CASE ('TRA')              ! Tracers
283         tmo(ktrd) = 0.e0
284         smo(ktrd) = 0.e0
285         DO jk = 1, jpkm1
286            DO jj = 1, jpj
287               DO ji = 1, jpi
288                  zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
289                  tmo(ktrd) =  tmo(ktrd) + ptrd3dx(ji,jj,jk) * zbt
290                  smo(ktrd) =  smo(ktrd) + ptrd3dy(ji,jj,jk) * zbt
291               END DO
292            END DO
293         END DO
294
295      END SELECT
296
297      ! 3. Basin averaged tracer/momentum square trend
298      ! ----------------------------------------------
299      ! c a u t i o n: field now
300     
301      SELECT CASE (ctype)
302
303      CASE ('DYN')              ! Momentum
304         hke(ktrd) = 0.e0
305         DO jk = 1, jpk
306            DO jj = 1, jpj
307               DO ji = 1, jpi
308                  zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
309                  zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
310                  hke(ktrd) = hke(ktrd)   &
311                  &   + un(ji,jj,jk) * ptrd3dx(ji,jj,jk) * zbtu &
312                  &   + vn(ji,jj,jk) * ptrd3dy(ji,jj,jk) * zbtv
313               END DO
314            END DO
315         END DO
316
317      CASE ('TRA')              ! Tracers
318         t2(ktrd) = 0.e0
319         s2(ktrd) = 0.e0
320         DO jk = 1, jpk
321            DO jj = 1, jpj
322               DO ji = 1, jpi
323                  zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
324                  t2(ktrd) = t2(ktrd) + ptrd3dx(ji,jj,jk) * zbt * tn(ji,jj,jk)
325                  s2(ktrd) = s2(ktrd) + ptrd3dy(ji,jj,jk) * zbt * sn(ji,jj,jk)
326               END DO
327            END DO
328         END DO
329
330      END SELECT
331
332   END SUBROUTINE trd_3d
333
334
335
336   SUBROUTINE trd_icp_init
337      !!---------------------------------------------------------------------
338      !!                  ***  ROUTINE trd_icp_init  ***
339      !!
340      !! ** Purpose :   
341      !!
342      !! ** Method  :
343      !!
344      !! History :
345      !!   9.0  !  03-09 (G. Madec)  Original code
346      !!        !  04-08 (C. Talandier) New trends organization
347      !!----------------------------------------------------------------------
348      !! * Local declarations
349      INTEGER :: ji, jj, jk
350
351      REAL(wp) ::   zmskt
352#if  defined key_trddyn
353      REAL(wp) ::   zmsku,zmskv
354#endif
355
356      NAMELIST/namtrd/ ntrd, nctls
357      !!----------------------------------------------------------------------
358
359      ! namelist namtrd : trend diagnostic
360      REWIND( numnam )
361      READ  ( numnam, namtrd )
362
363      IF(lwp) THEN
364         WRITE(numout,*)
365         WRITE(numout,*) 'trd_icp_init : integral constraints properties trends'
366         WRITE(numout,*) '~~~~~~~~~~~~~'
367         WRITE(numout,*) ' '
368         WRITE(numout,*) '          Namelist namtrd : '
369         WRITE(numout,*) '             time step frequency trend       ntrd  = ', ntrd
370      ENDIF
371
372      ! initialisation of BBL tracers lateral diffusion to zero
373      tldfbbl(:,:) = 0.e0   ;   sldfbbl(:,:) = 0.e0 
374      ! initialisation of BBL tracers lateral advection to zero
375      tladbbl(:,:) = 0.e0   ;   sladbbl(:,:) = 0.e0 
376      ! initialisation of workspace
377      tladi(:,:,:) = 0.e0  ;  tladj(:,:,:) = 0.e0
378      sladi(:,:,:) = 0.e0  ;  sladj(:,:,:) = 0.e0
379
380      ! Total volume at t-points:
381      tvolt = 0.e0
382      DO jk = 1, jpkm1
383         DO jj = 2, jpjm1
384            DO ji = fs_2, fs_jpim1   ! vector opt.
385               zmskt = tmask(ji,jj,jk) * tmask_i(ji,jj)
386               tvolt = tvolt + zmskt * e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk)
387            END DO
388         END DO
389      END DO
390      IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain
391
392      IF(lwp) THEN
393         WRITE(numout,*)
394         WRITE(numout,*) '          total ocean volume at T-point   tvolt = ',tvolt
395      ENDIF
396
397#if  defined key_trddyn
398      ! Initialization of potential to kinetic energy conversion
399      rpktrd = 0.e0
400
401      ! Total volume at u-, v- points:
402      tvolu = 0.e0
403      tvolv = 0.e0
404
405      DO jk = 1, jpk
406         DO jj = 2, jpjm1
407            DO ji = fs_2, fs_jpim1   ! vector opt.
408               zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
409               zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
410               tvolu = tvolu + zmsku * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
411               tvolv = tvolv + zmskv * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
412            END DO
413         END DO
414      END DO
415      IF( lk_mpp )   CALL mpp_sum( tvolu )   ! sums over the global domain
416      IF( lk_mpp )   CALL mpp_sum( tvolv )
417
418      IF(lwp) THEN
419         WRITE(numout,*) '          total ocean volume at U-point   tvolu = ',tvolu
420         WRITE(numout,*) '          total ocean volume at V-point   tvolv = ',tvolv
421         WRITE(numout,*) ' '
422      ENDIF
423#endif
424
425   END SUBROUTINE trd_icp_init
426
427
428
429   SUBROUTINE trd_dwr( kt )
430      !!---------------------------------------------------------------------
431      !!                  ***  ROUTINE trd_dwr  ***
432      !!
433      !! ** Purpose :  write dynamic trends in ocean.output
434      !!
435      !! ** Method  :
436      !!
437      !! History :
438      !!   9.0  !  03-09  (G. Madec)  Original code
439      !!        !  04-08  (C. Talandier)  New trends organization
440      !!----------------------------------------------------------------------
441      !! * Arguments
442      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
443      INTEGER ::   ji, jj, jk
444      REAL(wp) ::   &
445         ze1e2w,zcof,        &  !    "         "
446         zbe1ru, zbe2rv,     &  !    "         "
447         zbtr, ztz, zth 
448
449      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
450               zkepe, zkx, zky, zkz              ! temporary arrays
451      !!----------------------------------------------------------------------
452
453      ! I. Momentum trends
454      ! -------------------
455
456      IF( MOD(kt,ntrd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN
457
458         ! I.1 Conversion potential energy - kinetic energy
459         ! --------------------------------------------------
460         ! c a u t i o n here, trends are computed at kt+1 (now , but after the swap)
461
462         zkx(:,:,:) = 0.e0
463         zky(:,:,:) = 0.e0
464         zkz(:,:,:) = 0.e0
465         zkepe(:,:,:) = 0.e0
466   
467         CALL eos( tn, sn, rhd, rhop )       ! now potential and in situ densities
468
469         ! 4.1 Density flux at w-point
470         DO jk = 2, jpk
471            DO jj = 1, jpj
472               DO ji = 1, jpi
473                  ze1e2w = 0.5 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) * tmask_i(ji,jj)
474                  zkz(ji,jj,jk) = ze1e2w / rau0 * ( rhop(ji,jj,jk) + rhop(ji,jj,jk-1) )
475               END DO
476            END DO
477         END DO
478         zkz  (:,:, 1 ) = 0.e0
479         
480         ! Density flux at u and v-points
481         DO jk = 1, jpk
482            DO jj = 1, jpjm1
483               DO ji = 1, jpim1
484                  zcof   = 0.5 / rau0
485                  zbe1ru = zcof * e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk)
486                  zbe2rv = zcof * e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk)
487                  zkx(ji,jj,jk) = zbe1ru * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) )
488                  zky(ji,jj,jk) = zbe2rv * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) )
489               END DO
490            END DO
491         END DO
492         
493         ! Density flux divergence at t-point
494         DO jk = 1, jpkm1
495            DO jj = 2, jpjm1
496               DO ji = 2, jpim1
497                  zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
498                  ztz = - zbtr * (    zkz(ji,jj,jk) - zkz(ji,jj,jk+1) )
499                  zth = - zbtr * (  ( zkx(ji,jj,jk) - zkx(ji-1,jj,jk) )   &
500                    &             + ( zky(ji,jj,jk) - zky(ji,jj-1,jk) )  )
501                  zkepe(ji,jj,jk) = (zth + ztz) * tmask(ji,jj,jk) * tmask_i(ji,jj)
502               END DO
503            END DO
504         END DO
505         zkepe( : , : ,jpk) = 0.e0
506         zkepe( : ,jpj, : ) = 0.e0
507         zkepe(jpi, : , : ) = 0.e0
508
509         ! I.2 Basin averaged kinetic energy trend
510         ! ----------------------------------------
511         peke = 0.e0
512         DO jk = 1,jpk
513            DO jj = 1, jpj
514               DO ji = 1, jpi
515                  peke = peke + zkepe(ji,jj,jk) * grav * fsdept(ji,jj,jk)   &
516                     &                     * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
517               END DO
518            END DO
519         END DO
520
521         ! I.3 Sums over the global domain
522         ! ---------------------------------
523         IF( lk_mpp ) THEN
524               CALL mpp_sum( peke )
525               CALL mpp_sum( umo , 11 )
526               CALL mpp_sum( vmo , 11 )
527               CALL mpp_sum( hke , 10 )
528         END IF
529
530         ! I.2 Print dynamic trends in the ocean.output file
531         ! --------------------------------------------------
532
533         IF(lwp) THEN
534            WRITE (numout,*)
535            WRITE (numout,*)
536            WRITE (numout,9500) kt
537            WRITE (numout,9501) umo( 1) / tvolu, vmo( 1) / tvolv
538            WRITE (numout,9502) umo( 2) / tvolu, vmo( 2) / tvolv
539            WRITE (numout,9503) umo( 3) / tvolu, vmo( 3) / tvolv
540            WRITE (numout,9504) umo( 4) / tvolu, vmo( 4) / tvolv
541            WRITE (numout,9505) umo( 5) / tvolu, vmo( 5) / tvolv
542            WRITE (numout,9506) umo( 6) / tvolu, vmo( 6) / tvolv
543            WRITE (numout,9507) umo( 7) / tvolu, vmo( 7) / tvolv
544            WRITE (numout,9508) umo( 8) / tvolu, vmo( 8) / tvolv
545            WRITE (numout,9509) umo(10) / tvolu, vmo(10) / tvolv
546            WRITE (numout,9510) umo( 9) / tvolu, vmo( 9) / tvolv
547            WRITE (numout,9511) umo(11) / tvolu, vmo(11) / tvolv
548            WRITE (numout,9512)
549            WRITE (numout,9513)                                                 &
550            &     (  umo(1) + umo(2) + umo(3) + umo( 4) + umo( 5) + umo(6)    &
551            &      + umo(7) + umo(8) + umo(9) + umo(10) + umo(11) ) / tvolu,   &
552            &     (  vmo(1) + vmo(2) + vmo(3) + vmo( 4) + vmo( 5) + vmo(6)    &
553            &      + vmo(7) + vmo(8) + vmo(9) + vmo(10) + vmo(11) ) / tvolv
554         ENDIF
555
556 9500    FORMAT(' momentum trend at it= ', i6, ' :', /' ==============================')
557 9501    FORMAT(' pressure gradient          u= ', e20.13, '    v= ', e20.13)
558 9502    FORMAT(' ke gradient                u= ', e20.13, '    v= ', e20.13)
559 9503    FORMAT(' relative vorticity term    u= ', e20.13, '    v= ', e20.13)
560 9504    FORMAT(' coriolis term              u= ', e20.13, '    v= ', e20.13)
561 9505    FORMAT(' horizontal diffusion       u= ', e20.13, '    v= ', e20.13)
562 9506    FORMAT(' vertical advection         u= ', e20.13, '    v= ', e20.13)
563 9507    FORMAT(' vertical diffusion         u= ', e20.13, '    v= ', e20.13)
564 9508    FORMAT(' surface pressure gradient  u= ', e20.13, '    v= ', e20.13)
565 9509    FORMAT(' forcing term               u= ', e20.13, '    v= ', e20.13)
566 9510    FORMAT(' dampimg term               u= ', e20.13, '    v= ', e20.13)
567 9511    FORMAT(' bottom flux                u= ', e20.13, '    v= ', e20.13)
568 9512    FORMAT(' -----------------------------------------------------------------------------')
569 9513    FORMAT(' total trend                u= ', e20.13, '    v= ', e20.13)
570
571         IF(lwp) THEN
572            WRITE (numout,*)
573            WRITE (numout,*)
574            WRITE (numout,9520) kt
575            WRITE (numout,9521) hke( 1) / tvolt
576            WRITE (numout,9522) hke( 2) / tvolt
577            WRITE (numout,9523) hke( 3) / tvolt
578            WRITE (numout,9524) hke( 4) / tvolt
579            WRITE (numout,9525) hke( 5) / tvolt
580            WRITE (numout,9526) hke( 6) / tvolt
581            WRITE (numout,9527) hke( 7) / tvolt
582            WRITE (numout,9528) hke( 8) / tvolt
583            WRITE (numout,9529) hke(10) / tvolt
584            WRITE (numout,9530) hke( 9) / tvolt
585            WRITE (numout,9531)
586            WRITE (numout,9532)   &
587            &     (  hke(1) + hke(2) + hke(3) + hke(4) + hke(5) + hke(6)   &
588            &      + hke(7) + hke(8) + hke(9) + hke(10) ) / tvolt
589         ENDIF
590
591 9520    FORMAT(' kinetic energy trend at it= ', i6, ' :', /' ====================================')
592 9521    FORMAT(' pressure gradient         u2= ', e20.13)
593 9522    FORMAT(' ke gradient               u2= ', e20.13)
594 9523    FORMAT(' relative vorticity term   u2= ', e20.13)
595 9524    FORMAT(' coriolis term             u2= ', e20.13)
596 9525    FORMAT(' horizontal diffusion      u2= ', e20.13)
597 9526    FORMAT(' vertical advection        u2= ', e20.13)
598 9527    FORMAT(' vertical diffusion        u2= ', e20.13)
599 9528    FORMAT(' surface pressure gradient u2= ', e20.13)
600 9529    FORMAT(' forcing term              u2= ', e20.13)
601 9530    FORMAT(' dampimg term              u2= ', e20.13)
602 9531    FORMAT(' --------------------------------------------------')
603 9532    FORMAT(' total trend               u2= ', e20.13)
604
605         IF(lwp) THEN
606            WRITE (numout,*)
607            WRITE (numout,*)
608            WRITE (numout,9540) kt
609            WRITE (numout,9541) ( hke(2) + hke(3) + hke(6) ) / tvolt
610            WRITE (numout,9542) ( hke(2) + hke(6) ) / tvolt
611            WRITE (numout,9543) ( hke(4) ) / tvolt
612            WRITE (numout,9544) ( hke(3) ) / tvolt
613            WRITE (numout,9545) ( hke(8) ) / tvolt
614            WRITE (numout,9546) ( hke(5) ) / tvolt
615            WRITE (numout,9547) ( hke(7) ) / tvolt
616            WRITE (numout,9548) ( hke(1) ) / tvolt, rpktrd / tvolt
617         ENDIF
618
619 9540    FORMAT(' energetic consistency at it= ', i6, ' :', /' =========================================')
620 9541    FORMAT(' 0 = non linear term(true if key_vorenergy or key_combined): ', e20.13)
621 9542    FORMAT(' 0 = ke gradient + vertical advection              : ', e20.13)
622 9543    FORMAT(' 0 = coriolis term  (true if key_vorenergy or key_combined): ', e20.13)
623 9544    FORMAT(' 0 = uh.( rot(u) x uh ) (true if enstrophy conser.)    : ', e20.13)
624 9545    FORMAT(' 0 = surface pressure gradient                     : ', e20.13)
625 9546    FORMAT(' 0 > horizontal diffusion                          : ', e20.13)
626 9547    FORMAT(' 0 > vertical diffusion                            : ', e20.13)
627 9548    FORMAT(' pressure gradient u2 = - 1/rau0 u.dz(rhop)        : ', e20.13, '  u.dz(rhop) =', e20.13)
628
629         ! Save potential to kinetic energy conversion for next time step
630         rpktrd = peke
631
632      ENDIF
633
634   END SUBROUTINE trd_dwr
635
636
637
638
639   SUBROUTINE trd_twr( kt )
640      !!---------------------------------------------------------------------
641      !!                  ***  ROUTINE trd_twr  ***
642      !!
643      !! ** Purpose :  write active tracers trends in ocean.output
644      !!
645      !! ** Method  :
646      !!
647      !! History :
648      !!   9.0  !  03-09  (G. Madec)  Original code
649      !!        !  04-08  (C. Talandier)  New trends organization
650      !!----------------------------------------------------------------------
651      !! * Arguments
652      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
653
654      !!----------------------------------------------------------------------
655
656      ! I. Tracers trends
657      ! -----------------
658
659      IF( MOD(kt,ntrd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN
660
661         ! I.1 Sums over the global domain
662         ! -------------------------------
663         IF( lk_mpp ) THEN
664            CALL mpp_sum( tmo, 10 )   
665            CALL mpp_sum( smo, 10 )
666            CALL mpp_sum( t2 , 10 )
667            CALL mpp_sum( s2 , 10 )
668         ENDIF
669
670         ! I.2 Print tracers trends in the ocean.output file
671         ! --------------------------------------------------
672         
673         IF(lwp) THEN
674            WRITE (numout,*)
675            WRITE (numout,*)
676            WRITE (numout,9400) kt
677            WRITE (numout,9401) tmo(1) / tvolt, smo(1) / tvolt
678            WRITE (numout,9402) tmo(2) / tvolt, smo(2) / tvolt
679            WRITE (numout,9403) tmo(3) / tvolt, smo(3) / tvolt
680            WRITE (numout,9404) tmo(4) / tvolt, smo(4) / tvolt
681            WRITE (numout,9405) tmo(5) / tvolt, smo(5) / tvolt
682            WRITE (numout,9406) tmo(6) / tvolt, smo(6) / tvolt
683            WRITE (numout,9407) tmo(7) / tvolt
684            WRITE (numout,9408) tmo(8) / tvolt, smo(8) / tvolt
685            WRITE (numout,9409)
686            WRITE (numout,9410) (  tmo(1) + tmo(2) + tmo(3) + tmo(4)              &
687            &                    + tmo(5) + tmo(6) + tmo(7) + tmo(8) ) / tvolt,   &
688            &                   (  smo(1) + smo(2) + smo(3) + smo(4)              &
689            &                    + smo(5) + smo(6)           + smo(8) ) / tvolt
690         ENDIF
691
6929400     FORMAT(' tracer trend at it= ',i6,' :     temperature',   &
693              '              salinity',/' ============================')
6949401     FORMAT(' horizontal advection        ',e20.13,'     ',e20.13)
6959402     FORMAT(' vertical advection          ',e20.13,'     ',e20.13)
6969403     FORMAT(' horizontal diffusion        ',e20.13,'     ',e20.13)
6979404     FORMAT(' vertical diffusion          ',e20.13,'     ',e20.13)
6989405     FORMAT(' STATIC instability mixing   ',e20.13,'     ',e20.13)
6999406     FORMAT(' damping term                ',e20.13,'     ',e20.13)
7009407     FORMAT(' penetrative qsr             ',e20.13,'     ',e20.13)
7019408     FORMAT(' forcing term                ',e20.13,'     ',e20.13)
7029409     FORMAT(' -------------------------------------------------------------------------')
7039410     FORMAT(' total trend                 ',e20.13,'     ',e20.13)
704
705
706         IF(lwp) THEN
707            WRITE (numout,*)
708            WRITE (numout,*)
709            WRITE (numout,9420) kt
710            WRITE (numout,9421) t2(1) / tvolt, s2(1) / tvolt
711            WRITE (numout,9422) t2(2) / tvolt, s2(2) / tvolt
712            WRITE (numout,9423) t2(3) / tvolt, s2(3) / tvolt
713            WRITE (numout,9424) t2(4) / tvolt, s2(4) / tvolt
714            WRITE (numout,9425) t2(5) / tvolt, s2(5) / tvolt
715            WRITE (numout,9426) t2(6) / tvolt, s2(6) / tvolt
716            WRITE (numout,9427) t2(7) / tvolt
717            WRITE (numout,9428) t2(8) / tvolt, s2(8) / tvolt
718            WRITE (numout,9429)
719            WRITE (numout,9430) (  t2(1) + t2(2) + t2(3) + t2(4)              &
720            &                    + t2(5) + t2(6) + t2(7) + t2(8) ) / tvolt,   &
721            &                   (  s2(1) + s2(2) + s2(3) + s2(4)              &
722            &                    + s2(5) + s2(6)          + s2(8) ) / tvolt
723         ENDIF
724
7259420     FORMAT(' tracer**2 trend at it= ', i6, ' :      temperature',   &
726            '               salinity', /, ' ===============================')
7279421     FORMAT(' horizontal advection      * t   ', e20.13, '     ', e20.13)
7289422     FORMAT(' vertical advection        * t   ', e20.13, '     ', e20.13)
7299423     FORMAT(' horizontal diffusion      * t   ', e20.13, '     ', e20.13)
7309424     FORMAT(' vertical diffusion        * t   ', e20.13, '     ', e20.13)
7319425     FORMAT(' STATIC instability mixing * t   ', e20.13, '     ', e20.13)
7329426     FORMAT(' damping term              * t   ', e20.13, '     ', e20.13)
7339427     FORMAT(' penetrative qsr           * t   ', e20.13, '     ', e20.13)
7349428     FORMAT(' forcing term              * t   ', e20.13, '     ', e20.13)
7359429     FORMAT(' -----------------------------------------------------------------------------')
7369430     FORMAT(' total trend                *t = ', e20.13, '  *s = ', e20.13)
737
738
739         IF(lwp) THEN
740            WRITE (numout,*)
741            WRITE (numout,*)
742            WRITE (numout,9440) kt
743            WRITE (numout,9441) ( tmo(1)+tmo(2) )/tvolt, ( smo(1)+smo(2) )/tvolt
744            WRITE (numout,9442)   tmo(3)/tvolt,  smo(3)/tvolt
745            WRITE (numout,9443)   tmo(4)/tvolt,  smo(4)/tvolt
746            WRITE (numout,9444)   tmo(5)/tvolt,  smo(5)/tvolt
747            WRITE (numout,9445) ( t2(1)+t2(2) )/tvolt, ( s2(1)+s2(2) )/tvolt
748            WRITE (numout,9446)   t2(3)/tvolt,   s2(3)/tvolt
749            WRITE (numout,9447)   t2(4)/tvolt,   s2(4)/tvolt
750            WRITE (numout,9448)   t2(5)/tvolt,   s2(5)/tvolt
751         ENDIF
752
7539440     FORMAT(' tracer consistency at it= ',i6,   &
754            ' :         temperature','                salinity',/,   &
755            ' ==================================')
7569441     FORMAT(' 0 = horizontal+vertical advection      ',e20.13,'       ',e20.13)
7579442     FORMAT(' 0 = horizontal diffusion               ',e20.13,'       ',e20.13)
7589443     FORMAT(' 0 = vertical diffusion                 ',e20.13,'       ',e20.13)
7599444     FORMAT(' 0 = static instability mixing          ',e20.13,'       ',e20.13)
7609445     FORMAT(' 0 = horizontal+vertical advection * t  ',e20.13,'       ',e20.13)
7619446     FORMAT(' 0 > horizontal diffusion          * t  ',e20.13,'       ',e20.13)
7629447     FORMAT(' 0 > vertical diffusion            * t  ',e20.13,'       ',e20.13)
7639448     FORMAT(' 0 > static instability mixing     * t  ',e20.13,'       ',e20.13)
764
765      ENDIF
766
767   END SUBROUTINE trd_twr
768
769#   else
770   !!----------------------------------------------------------------------
771   !!   Default case :                                         Empty module
772   !!----------------------------------------------------------------------
773   LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .FALSE.   !: tracers  trend flag
774   LOGICAL, PUBLIC, PARAMETER ::   lk_trddyn = .FALSE.   !: momentum trend flag
775CONTAINS
776   SUBROUTINE trd_2d(ptrd2dx, ptrd2dy, ktrd , ctype)       ! Empty routine
777      REAL, DIMENSION(:,:,:), INTENT( inout ) ::   &
778          ptrd2dx,                     &   ! Temperature or U trend
779          ptrd2dy                          ! Salinity    or V trend
780      INTEGER, INTENT( in ) ::   ktrd      ! momentum or tracer trend index
781      CHARACTER(len=3), INTENT( in ) ::   &
782         ctype                             ! momentum or tracers trends type
783      WRITE(*,*) 'trd_2d: You should not have seen this print! error ?', ptrd2dx(1,1,1)
784      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ptrd2dy(1,1,1)
785      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd
786      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ctype
787   END SUBROUTINE trd_2d
788   SUBROUTINE trd_3d(ptrd3dx, ptrd3dy, ktrd , ctype)       ! Empty routine
789      REAL, DIMENSION(:,:,:), INTENT( inout ) ::   &
790          ptrd3dx,                     &   ! Temperature or U trend
791          ptrd3dy                          ! Salinity    or V trend
792      INTEGER, INTENT( in ) ::   ktrd      ! momentum or tracer trend index
793      CHARACTER(len=3), INTENT( in ) ::   &
794         ctype                             ! momentum or tracers trends type
795      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1)
796      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ptrd3dy(1,1,1)
797      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd
798      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ctype
799   END SUBROUTINE trd_3d
800   SUBROUTINE trd_icp_init               ! Empty routine
801   END SUBROUTINE trd_icp_init
802   SUBROUTINE trd_dwr( kt )          ! Empty routine
803      INTEGER, INTENT(in) :: kt
804      WRITE(*,*) 'trd_dwr: You should not have seen this print! error ?', kt
805   END SUBROUTINE trd_dwr
806   SUBROUTINE trd_twr( kt )          ! Empty routine
807      INTEGER, INTENT(in) :: kt
808      WRITE(*,*) 'trd_twr: You should not have seen this print! error ?', kt
809   END SUBROUTINE trd_twr
810#endif
811
812   !!======================================================================
813END MODULE trdicp
Note: See TracBrowser for help on using the repository browser.