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

source: trunk/NEMO/TOP_SRC/trcdia.F90 @ 1310

Last change on this file since 1310 was 1310, checked in by smasson, 15 years ago

set origin of outputs calendar, continue changeset:1309, see ticket:335

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