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.
trcdia.F90 in branches/DEV_r1784_mid_year_merge_2010/NEMO/TOP_SRC – NEMO

source: branches/DEV_r1784_mid_year_merge_2010/NEMO/TOP_SRC/trcdia.F90 @ 1970

Last change on this file since 1970 was 1970, checked in by acc, 14 years ago

ticket #684 step 5: Add in changes from the trunk between revisions 1821 and 1879.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 29.6 KB
Line 
1MODULE trcdia
2   !!======================================================================
3   !!                       *** MODULE trcdia ***
4   !! TOP :   Output of passive tracers
5   !!======================================================================
6   !! History :    -   !  1995-01 (M. Levy)  Original code
7   !!              -   !  1998-01 (C. Levy) NETCDF format using ioipsl interface
8   !!              -   !  1999-01 (M.A. Foujols) adapted for passive tracer
9   !!              -   !  1999-09 (M.A. Foujols) split into three parts
10   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
11   !!                  !  2008-05 (C. Ethe re-organization)
12   !!----------------------------------------------------------------------
13#if defined key_top && ! defined key_iomput
14   !!----------------------------------------------------------------------
15   !!   'key_top'                                                TOP models
16   !!----------------------------------------------------------------------
17   !! trc_dia     : main routine of output passive tracer
18   !! trcdit_wr   : outputs of concentration fields
19   !! trcdid_wr   : outputs of dvection-diffusion trends
20   !! trcdii_wr   : outputs of additional 2D/3D diagnostics
21   !! trcdib_wr   : outputs of biological fields
22   !!----------------------------------------------------------------------
23   USE dom_oce         ! ocean space and time domain variables
24   USE oce_trc
25   USE trc
26   USE trp_trc
27   USE par_trc
28   USE trdmld_trc_oce, ONLY : luttrd
29   USE dianam    ! build name of file (routine)
30   USE in_out_manager  ! I/O manager
31   USE lib_mpp
32   USE ioipsl
33
34   IMPLICIT NONE
35   PRIVATE
36
37   PUBLIC trc_dia     
38
39   INTEGER  ::   nit5      !: id for tracer output file
40   INTEGER  ::   ndepit5   !: id for depth mesh
41   INTEGER  ::   nhorit5   !: id for horizontal mesh
42   INTEGER  ::   ndimt50   !: number of ocean points in index array
43   INTEGER  ::   ndimt51   !: number of ocean points in index array
44   REAL(wp) ::   zjulian   !: ????   not DOCTOR !
45   INTEGER , DIMENSION (jpij*jpk) ::   ndext50   !: integer arrays for ocean 3D index
46   INTEGER , DIMENSION (jpij)     ::   ndext51   !: integer arrays for ocean surface index
47# if defined key_trc_diaadd
48   INTEGER  ::   nitd      !: id for additional array output file
49   INTEGER  ::   ndepitd   !: id for depth mesh
50   INTEGER  ::   nhoritd   !: id for horizontal mesh
51# endif
52# if defined key_trc_diatrd
53   INTEGER , DIMENSION (jptra) ::   nit6      !: id for additional array output file
54   INTEGER , DIMENSION (jptra) ::   ndepit6   !: id for depth mesh
55   INTEGER , DIMENSION (jptra) ::   nhorit6   !: id for horizontal mesh
56# endif
57# if defined key_trc_diabio
58   INTEGER  ::   nitb        !:         id.         for additional array output file
59   INTEGER  ::   ndepitb   !:  id for depth mesh
60   INTEGER  ::   nhoritb   !:  id for horizontal mesh
61# endif
62
63   !! * Substitutions
64#  include "top_substitute.h90"
65   !!----------------------------------------------------------------------
66   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)
67   !! $Id$
68   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
69   !!----------------------------------------------------------------------
70
71CONTAINS
72
73   SUBROUTINE trc_dia( kt ) 
74      !!---------------------------------------------------------------------
75      !!                     ***  ROUTINE trc_dia  ***
76      !!
77      !! ** Purpose :   output passive tracers fields
78      !!---------------------------------------------------------------------
79      INTEGER, INTENT( in ) :: kt
80      INTEGER               :: kindic
81      !!---------------------------------------------------------------------
82     
83      CALL trcdit_wr( kt, kindic )      ! outputs for tracer concentration
84      CALL trcdid_wr( kt, kindic )      ! outputs for dynamical trends
85      CALL trcdii_wr( kt, kindic )      ! outputs for additional arrays
86      CALL trcdib_wr( kt, kindic )      ! outputs for biological trends
87
88      !
89   END SUBROUTINE trc_dia
90
91   SUBROUTINE trcdit_wr( kt, kindic )
92      !!----------------------------------------------------------------------
93      !!                     ***  ROUTINE trcdit_wr  ***
94      !!
95      !! ** Purpose :   Standard output of passive tracer : concentration fields
96      !!
97      !! ** Method  :   At the beginning of the first time step (nit000), define all
98      !!             the NETCDF files and fields for concentration of passive tracer
99      !!
100      !!        At each time step call histdef to compute the mean if necessary
101      !!        Each nwritetrc time step, output the instantaneous or mean fields
102      !!
103      !!        IF kindic <0, output of fields before the model interruption.
104      !!        IF kindic =0, time step loop
105      !!        IF kindic >0, output of fields before the time step loop
106      !!----------------------------------------------------------------------
107      INTEGER, INTENT( in ) ::   kt          ! ocean time-step
108      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination
109      !!
110      INTEGER ::   jn
111      LOGICAL ::   ll_print = .FALSE.
112      CHARACTER (len=40) :: clhstnam, clop
113#if defined key_off_tra
114      INTEGER ::   inum = 11             ! temporary logical unit
115#endif
116      CHARACTER (len=20) :: cltra, cltrau
117      CHARACTER (len=80) :: cltral
118      REAL(wp) :: zsto, zout, zdt
119      INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod
120      !!----------------------------------------------------------------------
121
122      ! Initialisation
123      ! --------------
124
125      ! local variable for debugging
126      ll_print = .FALSE.                  ! change it to true for more control print
127      ll_print = ll_print .AND. lwp
128
129      ! Define frequency of output and means
130      zdt = rdt
131      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
132      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
133      ENDIF
134# if defined key_diainstant
135      zsto = nwritetrc * rdt
136      clop = "inst("//TRIM(clop)//")"
137# else
138      zsto = zdt
139      clop = "ave("//TRIM(clop)//")"
140# endif
141      zout = nwritetrc * zdt
142
143      ! Define indices of the horizontal output zoom and vertical limit storage
144      iimi = 1      ;      iima = jpi
145      ijmi = 1      ;      ijma = jpj
146      ipk = jpk
147
148      ! define time axis
149      itmod = kt - nittrc000 + 1
150      it    = kt
151
152      ! Define NETCDF files and fields at beginning of first time step
153      ! --------------------------------------------------------------
154
155      IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic
156     
157      IF( kt == nittrc000 ) THEN
158
159         ! Compute julian date from starting date of the run
160         CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
161         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
162         IF(lwp)WRITE(numout,*)' ' 
163         IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000                         &
164            &                 ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday   &
165            &                 ,'Julian day : ', zjulian 
166 
167         IF(lwp) WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,  &
168            &                    ' limit storage in depth = ', ipk
169
170#if defined key_off_tra
171        ! WRITE root name in date.file for use by postpro
172         IF(lwp) THEN
173            CALL dia_nam( clhstnam, nwritetrc,' ' )
174            CALL ctlopn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, narea )
175            WRITE(inum,*) clhstnam
176            CLOSE(inum)
177         ENDIF
178#endif
179
180         ! Define the NETCDF files for passive tracer concentration
181         CALL dia_nam( clhstnam, nwritetrc, 'ptrc_T' )
182         IF(lwp)WRITE(numout,*)" Name of NETCDF file ", clhstnam
183
184         ! Horizontal grid : glamt and gphit
185         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,     &
186            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
187            &          nittrc000-ndttrc, zjulian, zdt, nhorit5, nit5 , domain_id=nidom)
188
189         ! Vertical grid for tracer : gdept
190         CALL histvert( nit5, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepit5)
191
192         ! Index of ocean points in 3D and 2D (surface)
193         CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndext50, ndimt50 )
194         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndext51, ndimt51 )
195
196         ! Declare all the output fields as NETCDF variables
197         DO jn = 1, jptra
198            IF( lutsav(jn) ) THEN
199               cltra  = ctrcnm(jn)   ! short title for tracer
200               cltral = ctrcnl(jn)   ! long title for tracer
201               cltrau = ctrcun(jn)   ! UNIT for tracer
202               CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5,  &
203                  &          ipk, 1, ipk,  ndepit5, 32, clop, zsto, zout ) 
204            ENDIF
205         END DO
206
207         ! end netcdf files header
208         CALL histend( nit5 )
209         IF(lwp) WRITE(numout,*)
210         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdit_wr'
211         IF( ll_print )   CALL FLUSH(numout )
212
213      ENDIF
214
215      ! Start writing the tracer concentrations
216      ! ---------------------------------------
217
218      IF( lwp .AND. MOD( itmod, nwritetrc ) == 0 ) THEN
219         WRITE(numout,*) 'trcdit_wr : write NetCDF passive tracer concentrations at ', kt, 'time-step'
220         WRITE(numout,*) '~~~~~~~~~ '
221      ENDIF
222
223      DO jn = 1, jptra
224         cltra = ctrcnm(jn)      ! short title for tracer
225         IF( lutsav(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 )
226      END DO
227
228      ! close the file
229      ! --------------
230      IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nit5 )
231      !
232
233   END SUBROUTINE trcdit_wr
234
235# if defined key_trc_diatrd
236
237   SUBROUTINE trcdid_wr( kt, kindic )
238      !!----------------------------------------------------------------------
239      !!                     ***  ROUTINE trcdid_wr  ***
240      !!
241      !! ** Purpose :   output of passive tracer : advection-diffusion trends
242      !!
243      !! ** Method  :   At the beginning of the first time step (nit000), define all
244      !!             the NETCDF files and fields for concentration of passive tracer
245      !!
246      !!        At each time step call histdef to compute the mean if necessary
247      !!        Each nwritetrd time step, output the instantaneous or mean fields
248      !!
249      !!        IF kindic <0, output of fields before the model interruption.
250      !!        IF kindic =0, time step loop
251      !!        IF kindic >0, output of fields before the time step loop
252      !!----------------------------------------------------------------------
253      INTEGER, INTENT( in ) ::   kt          ! ocean time-step
254      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination
255      !!
256      LOGICAL ::   ll_print = .FALSE.
257      CHARACTER (len=40) ::   clhstnam, clop
258      CHARACTER (len=20) ::   cltra, cltrau
259      CHARACTER (len=80) ::   cltral
260      CHARACTER (len=10) ::   csuff
261      INTEGER  ::   jn, jl, ikn
262      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod
263      REAL(wp) ::   zsto, zout, zdt
264      !!----------------------------------------------------------------------
265
266      ! 0. Initialisation
267      ! -----------------
268     
269
270      ! local variable for debugging
271      ll_print = .FALSE.
272      ll_print = ll_print .AND. lwp
273      !
274      ! Define frequency of output and means
275      zdt = rdt
276      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
277      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
278      ENDIF
279#  if defined key_diainstant
280      zsto = nwritetrd * rdt
281      clop = "inst("//TRIM(clop)//")"
282#  else
283      zsto = zdt
284      clop = "ave("//TRIM(clop)//")"
285#  endif
286      zout = nwritetrd * zdt
287
288      ! Define indices of the horizontal output zoom and vertical limit storage
289      iimi = 1      ;      iima = jpi
290      ijmi = 1      ;      ijma = jpj
291      ipk = jpk
292
293      ! define time axis
294      itmod = kt - nittrc000 + 1
295      it    = kt
296
297      ! Define the NETCDF files (one per tracer)
298      IF( ll_print ) WRITE(numout,*) 'trcdid kt=', kt, ' kindic ', kindic
299     
300     
301      IF( kt == nittrc000 ) THEN
302
303         DO jn = 1, jptra
304            !
305            IF( luttrd(jn) ) THEN      ! Define the file for dynamical trends - one per each tracer IF required
306
307               IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,  &
308                   &                   ' limit storage in depth = ', ipk
309               csuff='DY_'//ctrcnm(jn)
310               CALL dia_nam( clhstnam, nwritetrd, csuff )
311               IF(lwp)WRITE(numout,*)   " Name of NETCDF file for dynamical trends",   &
312                  &                     " of tracer number : ",clhstnam
313
314               CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,       &
315                  &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,   &
316                  &          nittrc000-ndttrc, zjulian, zdt, nhorit6(jn),  &
317                  &          nit6(jn) , domain_id=nidom )
318
319               ! Vertical grid for tracer trend - one per each tracer IF needed
320               CALL histvert( nit6(jn), 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepit6(jn) ) 
321             END IF
322          END DO
323
324          ! Declare all the output fields as NETCDF variables
325          DO jn = 1, jptra
326            IF( luttrd(jn) ) THEN
327                DO jl = 1, jpdiatrc
328                  IF( jl == jptrc_xad ) THEN
329                      ! short and long title for x advection for tracer
330                      WRITE (cltra,'("XAD_",16a)') ctrcnm(jn)
331                      WRITE (cltral,'("X advective trend for ",58a)') ctrcnl(jn)(1:58)
332                  END IF
333                  IF( jl == jptrc_yad ) THEN
334                      ! short and long title for y advection for tracer
335                      WRITE (cltra,'("YAD_",16a)') ctrcnm(jn)
336                      WRITE (cltral,'("Y advective trend for ",58a)') ctrcnl(jn)(1:58)
337                  END IF
338                  IF( jl == jptrc_zad ) THEN
339                      ! short and long title for Z advection for tracer
340                      WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn)
341                      WRITE (cltral,'("Z advective trend for ",58a)') ctrcnl(jn)(1:58)
342                  END IF
343                  IF( jl == jptrc_xdf ) THEN
344                      ! short and long title for X diffusion for tracer
345                      WRITE (cltra,'("XDF_",16a)') ctrcnm(jn)
346                      WRITE (cltral,'("X diffusion trend for ",58a)') ctrcnl(jn)(1:58)
347                  END IF
348                  IF( jl == jptrc_ydf ) THEN
349                      ! short and long title for Y diffusion for tracer
350                      WRITE (cltra,'("YDF_",16a)') ctrcnm(jn)
351                      WRITE (cltral,'("Y diffusion trend for ",58a)') ctrcnl(jn)(1:58)
352                  END IF
353                  IF( jl == jptrc_zdf ) THEN
354                      ! short and long title for Z diffusion for tracer
355                      WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn)
356                      WRITE (cltral,'("Z diffusion trend for ",58a)') ctrcnl(jn)(1:58)
357                  END IF
358# if defined key_trcldf_eiv
359                  IF( jl == jptrc_xei ) THEN
360                      ! short and long title for x gent velocity for tracer
361                      WRITE (cltra,'("XGV_",16a)') ctrcnm(jn)
362                      WRITE (cltral,'("X gent velocity trend for ",53a)') ctrcnl(jn)(1:53)
363                  END IF
364                  IF( jl == jptrc_yei ) THEN
365                      ! short and long title for y gent velocity for tracer
366                      WRITE (cltra,'("YGV_",16a)') ctrcnm(jn)
367                      WRITE (cltral,'("Y gent velocity trend for ",53a)') ctrcnl(jn)(1:53)
368                  END IF
369                  IF( jl == jptrc_zei ) THEN
370                      ! short and long title for Z gent velocity for tracer
371                      WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn)
372                      WRITE (cltral,'("Z gent velocity trend for ",53a)') ctrcnl(jn)(1:53)
373                  END IF
374# endif
375# if defined key_trcdmp
376                  IF( jl == jptrc_dmp ) THEN
377                      ! last trends for tracer damping : short and long title
378                      WRITE (cltra,'("TDM_",16a)') ctrcnm(jn)
379                      WRITE (cltral,'("Tracer damping trend for ",55a)') ctrcnl(jn)(1:55)
380                  END IF
381# endif
382                  IF( jl == jptrc_sbc ) THEN
383                      ! last trends for tracer damping : short and long title
384                      WRITE (cltra,'("SBC_",16a)') ctrcnm(jn)
385                      WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55)
386                  END IF
387                      WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55)
388                  END IF
389                  CALL FLUSH( numout )
390                  cltrau = ctrcun(jn)      ! UNIT for tracer /trends
391                  CALL histdef( nit6(jn), cltra, cltral, cltrau, jpi,jpj,  &
392                     &          nhorit6(jn), ipk, 1, ipk,  ndepit6(jn), 32, clop ,  &
393                     &          zsto,zout )
394               END DO
395            END IF
396         END DO
397         ! CLOSE netcdf Files
398          DO jn = 1, jptra
399             IF( luttrd(jn) )   CALL histend( nit6(jn) )
400          END DO
401
402         IF(lwp) WRITE(numout,*)
403         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdid'
404         IF(ll_print) CALL FLUSH(numout )
405         !
406      ENDIF
407
408      ! SOME diagnostics to DO first time
409
410      ! Start writing data
411      ! ---------------------
412
413      ! trends for tracer concentrations
414
415      IF( lwp .AND. MOD( itmod, nwritetrd ) == 0 ) THEN
416         WRITE(numout,*) 'trcdid_wr : write NetCDF dynamical trends at ', kt, 'time-step'
417         WRITE(numout,*) '~~~~~~ '
418      ENDIF
419
420      DO jn = 1, jptra
421         IF( luttrd(jn) ) THEN
422            ikn = ikeep(jn) 
423            DO jl = 1, jpdiatrc
424               ! short titles
425               IF( jl == jptrc_xad)   WRITE (cltra,'("XAD_",16a)') ctrcnm(jn)
426               IF( jl == jptrc_yad)   WRITE (cltra,'("YAD_",16a)') ctrcnm(jn)
427               IF( jl == jptrc_zad)   WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn)
428               IF( jl == jptrc_xdf)   WRITE (cltra,'("XDF_",16a)') ctrcnm(jn)
429               IF( jl == jptrc_ydf)   WRITE (cltra,'("YDF_",16a)') ctrcnm(jn)
430               IF( jl == jptrc_zdf)   WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn)
431# if defined key_trcldf_eiv
432               IF( jl == jptrc_xei)   WRITE (cltra,'("XGV_",16a)') ctrcnm(jn)
433               IF( jl == jptrc_yei)   WRITE (cltra,'("YGV_",16a)') ctrcnm(jn)
434               IF( jl == jptrc_zei)   WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn)
435# endif
436# if defined key_trcdmp
437               IF( jl == jptrc_dmp )  WRITE (cltra,'("TDM_",16a)') ctrcnm(jn)
438# endif
439               IF( jl == jptrc_sbc )  WRITE (cltra,'("SBC_",16a)') ctrcnm(jn)
440               !
441               CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikn,jl),ndimt50, ndext50)
442            END DO
443         END IF
444      END DO
445
446      ! Closing all files
447      ! -----------------
448      IF( kt == nitend .OR. kindic < 0 ) THEN
449         DO jn = 1, jptra
450            IF( luttrd(jn) )   CALL histclo( nit6(jn) )
451         END DO
452      ENDIF
453      !
454
455   END SUBROUTINE trcdid_wr
456
457# else
458
459   SUBROUTINE trcdid_wr( kt, kindic )                      ! Dummy routine
460      INTEGER, INTENT ( in ) ::   kt, kindic
461   END SUBROUTINE trcdid_wr
462
463# endif
464
465#if defined key_trc_diaadd
466
467   SUBROUTINE trcdii_wr( kt, kindic )
468      !!----------------------------------------------------------------------
469      !!                     ***  ROUTINE trcdii_wr  ***
470      !!
471      !! ** Purpose :   output of passive tracer : additional 2D and 3D arrays
472      !!
473      !! ** Method  :   At the beginning of the first time step (nit000), define all
474      !!             the NETCDF files and fields for concentration of passive tracer
475      !!
476      !!        At each time step call histdef to compute the mean if necessary
477      !!        Each nwritedia time step, output the instantaneous or mean fields
478      !!
479      !!        IF kindic <0, output of fields before the model interruption.
480      !!        IF kindic =0, time step loop
481      !!        IF kindic >0, output of fields before the time step loop
482      !!----------------------------------------------------------------------
483      INTEGER, INTENT( in ) ::   kt          ! ocean time-step
484      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination
485      !!
486      LOGICAL ::   ll_print = .FALSE.
487      CHARACTER (len=40) ::   clhstnam, clop
488      CHARACTER (len=20) ::   cltra, cltrau
489      CHARACTER (len=80) ::   cltral
490      INTEGER  ::   jl
491      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod
492      REAL(wp) ::   zsto, zout, zdt
493      !!----------------------------------------------------------------------
494
495      ! Initialisation
496      ! --------------
497     
498      ! local variable for debugging
499      ll_print = .FALSE.
500      ll_print = ll_print .AND. lwp
501      !
502      ! Define frequency of output and means
503      zdt = rdt
504      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
505      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
506      ENDIF
507#  if defined key_diainstant
508      zsto = nwritedia * zdt
509      clop = "inst("//TRIM(clop)//")"
510#  else
511      zsto = zdt
512      clop = "ave("//TRIM(clop)//")"
513#  endif
514      zout = nwritedia * zdt
515
516      ! Define indices of the horizontal output zoom and vertical limit storage
517      iimi = 1      ;      iima = jpi
518      ijmi = 1      ;      ijma = jpj
519      ipk = jpk
520
521      ! define time axis
522      itmod = kt - nittrc000 + 1
523      it    = kt
524
525      ! 1. Define NETCDF files and fields at beginning of first time step
526      ! -----------------------------------------------------------------
527
528      IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt, ' kindic ', kindic
529
530      IF( kt == nittrc000 ) THEN
531
532         ! Define the NETCDF files for additional arrays : 2D or 3D
533
534         ! Define the T grid file for tracer auxiliary files
535
536         CALL dia_nam( clhstnam, nwritedia, 'diad_T' )
537         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
538
539         ! Define a netcdf FILE for 2d and 3d arrays
540
541         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,             &
542            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &
543            &          nittrc000-ndttrc, zjulian, zdt, nhoritd, nitd , domain_id=nidom )
544
545         ! Vertical grid for 2d and 3d arrays
546
547         CALL histvert( nitd, 'deptht', 'Vertical T levels','m', ipk, gdept_0, ndepitd)
548
549         ! Declare all the output fields as NETCDF variables
550
551         ! more 3D horizontal arrays
552         DO jl = 1, jpdia3d
553            cltra  = ctrc3d(jl)   ! short title for 3D diagnostic
554            cltral = ctrc3l(jl)   ! long title for 3D diagnostic
555            cltrau = ctrc3u(jl)   ! UNIT for 3D diagnostic
556            CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,   &
557               &          ipk, 1, ipk,  ndepitd, 32, clop, zsto, zout )
558         END DO
559
560         ! more 2D horizontal arrays
561         DO jl = 1, jpdia2d
562            cltra  = ctrc2d(jl)    ! short title for 2D diagnostic
563            cltral = ctrc2l(jl)   ! long title for 2D diagnostic
564            cltrau = ctrc2u(jl)   ! UNIT for 2D diagnostic
565            CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,  &
566               &          1, 1, 1,  -99, 32, clop, zsto, zout )
567         END DO
568
569         ! TODO: more 2D vertical sections arrays : I or J indice fixed
570
571         ! CLOSE netcdf Files
572         CALL histend( nitd )
573
574         IF(lwp) WRITE(numout,*)
575         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdii_wr'
576         IF( ll_print )   CALL FLUSH(numout )
577         !
578      ENDIF
579
580      ! 2. Start writing data
581      ! ---------------------
582
583      IF( lwp .AND. MOD( itmod, nwritedia ) == 0 ) THEN
584         WRITE(numout,*) 'trcdii_wr : write NetCDF additional arrays at ', kt, 'time-step'
585         WRITE(numout,*) '~~~~~~ '
586      ENDIF
587
588      ! more 3D horizontal arrays
589      DO jl = 1, jpdia3d
590         cltra = ctrc3d(jl)   ! short title for 3D diagnostic
591         CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jl), ndimt50 ,ndext50)
592      END DO
593
594      ! more 2D horizontal arrays
595      DO jl = 1, jpdia2d
596         cltra = ctrc2d(jl)   ! short title for 2D diagnostic
597         CALL histwrite(nitd, cltra, it, trc2d(:,:,jl), ndimt51  ,ndext51)
598      END DO
599
600      ! Closing all files
601      ! -----------------
602      IF( kt == nitend .OR. kindic < 0 )   CALL histclo(nitd)
603      !
604
605   END SUBROUTINE trcdii_wr
606
607# else
608
609   SUBROUTINE trcdii_wr( kt, kindic )                      ! Dummy routine
610      INTEGER, INTENT ( in ) :: kt, kindic
611   END SUBROUTINE trcdii_wr
612
613# endif
614
615# if defined key_trc_diabio
616
617   SUBROUTINE trcdib_wr( kt, kindic )
618      !!----------------------------------------------------------------------
619      !!                     ***  ROUTINE trcdib_wr  ***
620      !!
621      !! ** Purpose :   output of passive tracer : biological fields
622      !!
623      !! ** Method  :   At the beginning of the first time step (nit000), define all
624      !!             the NETCDF files and fields for concentration of passive tracer
625      !!
626      !!        At each time step call histdef to compute the mean if necessary
627      !!        Each nwritebio time step, output the instantaneous or mean fields
628      !!
629      !!        IF kindic <0, output of fields before the model interruption.
630      !!        IF kindic =0, time step loop
631      !!        IF kindic >0, output of fields before the time step loop
632      !!----------------------------------------------------------------------
633      !!
634      INTEGER, INTENT( in ) ::   kt          ! ocean time-step
635      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination
636      !!
637      LOGICAL ::   ll_print = .FALSE.
638      CHARACTER (len=40) ::   clhstnam, clop
639      CHARACTER (len=20) ::   cltra, cltrau
640      CHARACTER (len=80) ::   cltral
641      INTEGER  ::   ji, jj, jk, jl
642      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod
643      REAL(wp) ::   zsto, zout, zdt
644      !!----------------------------------------------------------------------
645
646      ! Initialisation
647      ! --------------
648
649     
650      ! local variable for debugging
651      ll_print = .FALSE.
652      ll_print = ll_print .AND. lwp
653
654      ! Define frequency of output and means
655      zdt = rdt
656      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
657      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
658      ENDIF
659#        if defined key_diainstant
660      zsto = nwritebio * zdt
661      clop = "inst("//TRIM(clop)//")"
662#        else
663      zsto = zdt
664      clop = "ave("//TRIM(clop)//")"
665#        endif
666      zout = nwritebio * zdt
667
668      ! Define indices of the horizontal output zoom and vertical limit storage
669      iimi = 1      ;      iima = jpi
670      ijmi = 1      ;      ijma = jpj
671      ipk = jpk
672
673      ! define time axis
674      itmod = kt - nittrc000 + 1
675      it    = kt
676
677      ! Define NETCDF files and fields at beginning of first time step
678      ! --------------------------------------------------------------
679
680      IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic
681
682      IF( kt == nittrc000 ) THEN
683
684         ! Define the NETCDF files for biological trends
685
686         CALL dia_nam(clhstnam,nwritebio,'biolog')
687         IF(lwp)WRITE(numout,*) " Name of NETCDF file for biological trends ", clhstnam
688         ! Horizontal grid : glamt and gphit
689         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,      &
690            &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          &
691            &    nittrc000-ndttrc, zjulian, zdt, nhoritb, nitb , domain_id=nidom )
692         ! Vertical grid for biological trends
693         CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb)
694
695         ! Declare all the output fields as NETCDF variables
696         ! biological trends
697         DO jl = 1, jpdiabio
698            cltra  = ctrbio(jl)   ! short title for biological diagnostic
699            cltral = ctrbil(jl)   ! long title for biological diagnostic
700            cltrau = ctrbiu(jl)   ! UNIT for biological diagnostic
701            CALL histdef( nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb,  &
702               &         ipk, 1, ipk,  ndepitb, 32, clop, zsto, zout)
703         END DO
704
705         ! CLOSE netcdf Files
706          CALL histend( nitb )
707
708         IF(lwp) WRITE(numout,*)
709         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdib_wr'
710         IF(ll_print) CALL FLUSH(numout )
711         !
712      ENDIF
713
714      ! Start writing data
715      ! ------------------
716
717      ! biological trends
718      IF( lwp .AND. MOD( itmod, nwritebio ) == 0 ) THEN
719         WRITE(numout,*) 'trcdit_wr : write NetCDF biological trends at ', kt, 'time-step'
720         WRITE(numout,*) '~~~~~~ '
721      ENDIF
722
723      DO jl = 1, jpdiabio
724         cltra = ctrbio(jl)  ! short title for biological diagnostic
725         CALL histwrite(nitb, cltra, it, trbio(:,:,:,jl), ndimt50,ndext50)
726      END DO
727
728      ! Closing all files
729      ! -----------------
730      IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nitb )
731      !
732
733   END SUBROUTINE trcdib_wr
734
735# else
736
737   SUBROUTINE trcdib_wr( kt, kindic )                      ! Dummy routine
738      INTEGER, INTENT ( in ) ::   kt, kindic
739   END SUBROUTINE trcdib_wr
740
741# endif 
742
743#else
744   !!----------------------------------------------------------------------
745   !!  Dummy module :                                     No passive tracer
746   !!----------------------------------------------------------------------
747CONTAINS
748   SUBROUTINE trc_dia( kt )                      ! Empty routine   
749      INTEGER, INTENT(in) :: kt
750   END SUBROUTINE trc_dia   
751
752#endif
753
754   !!======================================================================
755END MODULE trcdia
Note: See TracBrowser for help on using the repository browser.