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

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcdia.F90 @ 2633

Last change on this file since 2633 was 2593, checked in by trackstand2, 13 years ago

Made module vars dynamic and added _alloc() routine
  • Property svn:keywords set to Id
File size: 20.3 KB
Line 
1MODULE trcdia
2   !!======================================================================
3   !!                       *** MODULE trcdia ***
4   !! TOP :   Output of passive tracers
5   !!======================================================================
6   !! History :   OPA  !  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   !!   NEMO      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   !! trcdii_wr   : outputs of additional 2D/3D diagnostics
20   !! trcdib_wr   : outputs of biological fields
21   !!----------------------------------------------------------------------
22   USE dom_oce         ! ocean space and time domain variables
23   USE oce_trc
24   USE trc
25   USE par_trc
26   USE dianam    ! build name of file (routine)
27   USE in_out_manager  ! I/O manager
28   USE lib_mpp
29   USE ioipsl
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC   trc_dia        ! called by XXX module
35   PUBLIC   trc_dia_alloc  ! called by nemogcm.F90
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 , ALLOCATABLE, SAVE, DIMENSION (:) ::   ndext50   !: integer arrays for ocean 3D index
44   INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) ::   ndext51   !: integer arrays for ocean surface index
45# if defined key_diatrc
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_diabio
51   INTEGER  ::   nitb        !:         id.         for additional array output file
52   INTEGER  ::   ndepitb   !:  id for depth mesh
53   INTEGER  ::   nhoritb   !:  id for horizontal mesh
54# endif
55
56   !! * Substitutions
57#  include "top_substitute.h90"
58   !!----------------------------------------------------------------------
59   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
60   !! $Id$
61   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
62   !!----------------------------------------------------------------------
63CONTAINS
64
65   FUNCTION trc_dia_alloc()
66      !!---------------------------------------------------------------------
67      !!                     ***  ROUTINE trc_dia_alloc  ***
68      !!---------------------------------------------------------------------
69      INTEGER :: trc_dia_alloc
70      !!---------------------------------------------------------------------
71
72      ALLOCATE(ndext50(jpij*jpk), ndext51(jpij), Stat=trc_dia_alloc)
73
74      IF(trc_dia_alloc /= 0)THEN
75         CALL ctl_warn('trc_dia_alloc : failed to allocate arrays.')
76      END IF
77
78   END FUNCTION trc_dia_alloc
79
80
81   SUBROUTINE trc_dia( kt ) 
82      !!---------------------------------------------------------------------
83      !!                     ***  ROUTINE trc_dia  ***
84      !!
85      !! ** Purpose :   output passive tracers fields
86      !!---------------------------------------------------------------------
87      INTEGER, INTENT( in ) :: kt
88      INTEGER               :: kindic
89      !!---------------------------------------------------------------------
90      !
91      CALL trcdit_wr( kt, kindic )      ! outputs for tracer concentration
92      CALL trcdii_wr( kt, kindic )      ! outputs for additional arrays
93      CALL trcdib_wr( kt, kindic )      ! outputs for biological trends
94      !
95   END SUBROUTINE trc_dia
96
97
98   SUBROUTINE trcdit_wr( kt, kindic )
99      !!----------------------------------------------------------------------
100      !!                     ***  ROUTINE trcdit_wr  ***
101      !!
102      !! ** Purpose :   Standard output of passive tracer : concentration fields
103      !!
104      !! ** Method  :   At the beginning of the first time step (nit000), define all
105      !!             the NETCDF files and fields for concentration of passive tracer
106      !!
107      !!        At each time step call histdef to compute the mean if necessary
108      !!        Each nwritetrc time step, output the instantaneous or mean fields
109      !!
110      !!        IF kindic <0, output of fields before the model interruption.
111      !!        IF kindic =0, time step loop
112      !!        IF kindic >0, output of fields before the time step loop
113      !!----------------------------------------------------------------------
114      INTEGER, INTENT( in ) ::   kt          ! ocean time-step
115      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination
116      !!
117      INTEGER ::   jn
118      LOGICAL ::   ll_print = .FALSE.
119      CHARACTER (len=40) :: clhstnam, clop
120      INTEGER ::   inum = 11             ! temporary logical unit
121      CHARACTER (len=20) :: cltra, cltrau
122      CHARACTER (len=80) :: cltral
123      REAL(wp) :: zsto, zout, zdt
124      INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
125      !!----------------------------------------------------------------------
126
127      ! Initialisation
128      ! --------------
129
130      ! local variable for debugging
131      ll_print = .FALSE.                  ! change it to true for more control print
132      ll_print = ll_print .AND. lwp
133
134      ! Define frequency of output and means
135      zdt = rdt
136      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
137      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
138      ENDIF
139# if defined key_diainstant
140      zsto = nn_writetrc * rdt
141      clop = "inst("//TRIM(clop)//")"
142# else
143      zsto = zdt
144      clop = "ave("//TRIM(clop)//")"
145# endif
146      zout = nn_writetrc * zdt
147
148      ! Define indices of the horizontal output zoom and vertical limit storage
149      iimi = 1      ;      iima = jpi
150      ijmi = 1      ;      ijma = jpj
151      ipk = jpk
152
153      ! define time axis
154      itmod = kt - nit000 + 1
155      it    = kt
156      iiter = ( nit000 - 1 ) / nn_dttrc
157
158      ! Define NETCDF files and fields at beginning of first time step
159      ! --------------------------------------------------------------
160
161      IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic
162     
163      IF( kt == nit000 ) THEN
164
165         ! Compute julian date from starting date of the run
166         CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
167         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
168         IF(lwp)WRITE(numout,*)' ' 
169         IF(lwp)WRITE(numout,*)' Date 0 used :', nit000                         &
170            &                 ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday   &
171            &                 ,'Julian day : ', zjulian 
172 
173         IF(lwp) WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,  &
174            &                    ' limit storage in depth = ', ipk
175
176         IF( lk_offline .AND. lwp ) THEN
177            CALL dia_nam( clhstnam, nn_writetrc,' ' )
178            CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, narea )
179            WRITE(inum,*) clhstnam
180            CLOSE(inum)
181         ENDIF
182
183         ! Define the NETCDF files for passive tracer concentration
184         CALL dia_nam( clhstnam, nn_writetrc, 'ptrc_T' )
185         IF(lwp)WRITE(numout,*)" Name of NETCDF file ", clhstnam
186
187         ! Horizontal grid : glamt and gphit
188         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,     &
189            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
190            &          iiter, zjulian, zdt, nhorit5, nit5 , domain_id=nidom, snc4chunks=snc4set)
191
192         ! Vertical grid for tracer : gdept
193         CALL histvert( nit5, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepit5)
194
195         ! Index of ocean points in 3D and 2D (surface)
196         CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndext50, ndimt50 )
197         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndext51, ndimt51 )
198
199         ! Declare all the output fields as NETCDF variables
200         DO jn = 1, jptra
201            IF( lutsav(jn) ) THEN
202               cltra  = ctrcnm(jn)   ! short title for tracer
203               cltral = ctrcnl(jn)   ! long title for tracer
204               cltrau = ctrcun(jn)   ! UNIT for tracer
205               CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5,  &
206                  &          ipk, 1, ipk,  ndepit5, 32, clop, zsto, zout ) 
207            ENDIF
208         END DO
209
210         ! end netcdf files header
211         CALL histend( nit5, snc4set )
212         IF(lwp) WRITE(numout,*)
213         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdit_wr'
214         IF( ll_print )   CALL FLUSH(numout )
215
216      ENDIF
217
218      ! Start writing the tracer concentrations
219      ! ---------------------------------------
220
221      IF( lwp .AND. MOD( itmod, nn_writetrc ) == 0 ) THEN
222         WRITE(numout,*) 'trcdit_wr : write NetCDF passive tracer concentrations at ', kt, 'time-step'
223         WRITE(numout,*) '~~~~~~~~~ '
224      ENDIF
225
226      DO jn = 1, jptra
227         cltra = ctrcnm(jn)      ! short title for tracer
228         IF( lutsav(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 )
229      END DO
230
231      ! close the file
232      ! --------------
233      IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nit5 )
234      !
235
236   END SUBROUTINE trcdit_wr
237
238#if defined key_diatrc
239
240   SUBROUTINE trcdii_wr( kt, kindic )
241      !!----------------------------------------------------------------------
242      !!                     ***  ROUTINE trcdii_wr  ***
243      !!
244      !! ** Purpose :   output of passive tracer : additional 2D and 3D arrays
245      !!
246      !! ** Method  :   At the beginning of the first time step (nit000), define all
247      !!             the NETCDF files and fields for concentration of passive tracer
248      !!
249      !!        At each time step call histdef to compute the mean if necessary
250      !!        Each nn_writedia time step, output the instantaneous or mean fields
251      !!
252      !!        IF kindic <0, output of fields before the model interruption.
253      !!        IF kindic =0, time step loop
254      !!        IF kindic >0, output of fields before the time step loop
255      !!----------------------------------------------------------------------
256      INTEGER, INTENT( in ) ::   kt          ! ocean time-step
257      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination
258      !!
259      LOGICAL ::   ll_print = .FALSE.
260      CHARACTER (len=40) ::   clhstnam, clop
261      CHARACTER (len=20) ::   cltra, cltrau
262      CHARACTER (len=80) ::   cltral
263      INTEGER  ::   jl
264      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
265      REAL(wp) ::   zsto, zout, zdt
266      !!----------------------------------------------------------------------
267
268      ! Initialisation
269      ! --------------
270     
271      ! local variable for debugging
272      ll_print = .FALSE.
273      ll_print = ll_print .AND. lwp
274      !
275      ! Define frequency of output and means
276      zdt = rdt
277      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
278      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
279      ENDIF
280#  if defined key_diainstant
281      zsto = nn_writedia * zdt
282      clop = "inst("//TRIM(clop)//")"
283#  else
284      zsto = zdt
285      clop = "ave("//TRIM(clop)//")"
286#  endif
287      zout = nn_writedia * zdt
288
289      ! Define indices of the horizontal output zoom and vertical limit storage
290      iimi = 1      ;      iima = jpi
291      ijmi = 1      ;      ijma = jpj
292      ipk = jpk
293
294      ! define time axis
295      itmod = kt - nit000 + 1
296      it    = kt
297      iiter = ( nit000 - 1 ) / nn_dttrc
298
299      ! 1. Define NETCDF files and fields at beginning of first time step
300      ! -----------------------------------------------------------------
301
302      IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt, ' kindic ', kindic
303
304      IF( kt == nit000 ) THEN
305
306         ! Define the NETCDF files for additional arrays : 2D or 3D
307
308         ! Define the T grid file for tracer auxiliary files
309
310         CALL dia_nam( clhstnam, nn_writedia, 'diad_T' )
311         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
312
313         ! Define a netcdf FILE for 2d and 3d arrays
314
315         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,             &
316            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &
317            &          iiter, zjulian, zdt, nhoritd, nitd , domain_id=nidom, snc4chunks=snc4set )
318
319         ! Vertical grid for 2d and 3d arrays
320
321         CALL histvert( nitd, 'deptht', 'Vertical T levels','m', ipk, gdept_0, ndepitd)
322
323         ! Declare all the output fields as NETCDF variables
324
325         ! more 3D horizontal arrays
326         DO jl = 1, jpdia3d
327            cltra  = ctrc3d(jl)   ! short title for 3D diagnostic
328            cltral = ctrc3l(jl)   ! long title for 3D diagnostic
329            cltrau = ctrc3u(jl)   ! UNIT for 3D diagnostic
330            CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,   &
331               &          ipk, 1, ipk,  ndepitd, 32, clop, zsto, zout )
332         END DO
333
334         ! more 2D horizontal arrays
335         DO jl = 1, jpdia2d
336            cltra  = ctrc2d(jl)    ! short title for 2D diagnostic
337            cltral = ctrc2l(jl)   ! long title for 2D diagnostic
338            cltrau = ctrc2u(jl)   ! UNIT for 2D diagnostic
339            CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,  &
340               &          1, 1, 1,  -99, 32, clop, zsto, zout )
341         END DO
342
343         ! TODO: more 2D vertical sections arrays : I or J indice fixed
344
345         ! CLOSE netcdf Files
346         CALL histend( nitd, snc4set )
347
348         IF(lwp) WRITE(numout,*)
349         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdii_wr'
350         IF( ll_print )   CALL FLUSH(numout )
351         !
352      ENDIF
353
354      ! 2. Start writing data
355      ! ---------------------
356
357      IF( lwp .AND. MOD( itmod, nn_writedia ) == 0 ) THEN
358         WRITE(numout,*) 'trcdii_wr : write NetCDF additional arrays at ', kt, 'time-step'
359         WRITE(numout,*) '~~~~~~ '
360      ENDIF
361
362      ! more 3D horizontal arrays
363      DO jl = 1, jpdia3d
364         cltra = ctrc3d(jl)   ! short title for 3D diagnostic
365         CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jl), ndimt50 ,ndext50)
366      END DO
367
368      ! more 2D horizontal arrays
369      DO jl = 1, jpdia2d
370         cltra = ctrc2d(jl)   ! short title for 2D diagnostic
371         CALL histwrite(nitd, cltra, it, trc2d(:,:,jl), ndimt51  ,ndext51)
372      END DO
373
374      ! Closing all files
375      ! -----------------
376      IF( kt == nitend .OR. kindic < 0 )   CALL histclo(nitd)
377      !
378
379   END SUBROUTINE trcdii_wr
380
381# else
382   SUBROUTINE trcdii_wr( kt, kindic )                      ! Dummy routine
383      INTEGER, INTENT ( in ) :: kt, kindic
384   END SUBROUTINE trcdii_wr
385# endif
386
387# if defined key_diabio
388
389   SUBROUTINE trcdib_wr( kt, kindic )
390      !!----------------------------------------------------------------------
391      !!                     ***  ROUTINE trcdib_wr  ***
392      !!
393      !! ** Purpose :   output of passive tracer : biological fields
394      !!
395      !! ** Method  :   At the beginning of the first time step (nit000), define all
396      !!             the NETCDF files and fields for concentration of passive tracer
397      !!
398      !!        At each time step call histdef to compute the mean if necessary
399      !!        Each nn_writebio time step, output the instantaneous or mean fields
400      !!
401      !!        IF kindic <0, output of fields before the model interruption.
402      !!        IF kindic =0, time step loop
403      !!        IF kindic >0, output of fields before the time step loop
404      !!----------------------------------------------------------------------
405      INTEGER, INTENT( in ) ::   kt          ! ocean time-step
406      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination
407      !!
408      LOGICAL ::   ll_print = .FALSE.
409      CHARACTER (len=40) ::   clhstnam, clop
410      CHARACTER (len=20) ::   cltra, cltrau
411      CHARACTER (len=80) ::   cltral
412      INTEGER  ::   ji, jj, jk, jl
413      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
414      REAL(wp) ::   zsto, zout, zdt
415      !!----------------------------------------------------------------------
416
417      ! Initialisation
418      ! --------------
419
420     
421      ! local variable for debugging
422      ll_print = .FALSE.
423      ll_print = ll_print .AND. lwp
424
425      ! Define frequency of output and means
426      zdt = rdt
427      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
428      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
429      ENDIF
430#        if defined key_diainstant
431      zsto = nn_writebio * zdt
432      clop = "inst("//TRIM(clop)//")"
433#        else
434      zsto = zdt
435      clop = "ave("//TRIM(clop)//")"
436#        endif
437      zout = nn_writebio * zdt
438
439      ! Define indices of the horizontal output zoom and vertical limit storage
440      iimi = 1      ;      iima = jpi
441      ijmi = 1      ;      ijma = jpj
442      ipk = jpk
443
444      ! define time axis
445      itmod = kt - nit000 + 1
446      it    = kt
447      iiter = ( nit000 - 1 ) / nn_dttrc
448
449      ! Define NETCDF files and fields at beginning of first time step
450      ! --------------------------------------------------------------
451
452      IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic
453
454      IF( kt == nit000 ) THEN
455
456         ! Define the NETCDF files for biological trends
457
458         CALL dia_nam(clhstnam,nn_writebio,'biolog')
459         IF(lwp)WRITE(numout,*) " Name of NETCDF file for biological trends ", clhstnam
460         ! Horizontal grid : glamt and gphit
461         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,      &
462            &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          &
463            &    iiter, zjulian, zdt, nhoritb, nitb , domain_id=nidom, snc4chunks=snc4set )
464         ! Vertical grid for biological trends
465         CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb)
466
467         ! Declare all the output fields as NETCDF variables
468         ! biological trends
469         DO jl = 1, jpdiabio
470            cltra  = ctrbio(jl)   ! short title for biological diagnostic
471            cltral = ctrbil(jl)   ! long title for biological diagnostic
472            cltrau = ctrbiu(jl)   ! UNIT for biological diagnostic
473            CALL histdef( nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb,  &
474               &         ipk, 1, ipk,  ndepitb, 32, clop, zsto, zout)
475         END DO
476
477         ! CLOSE netcdf Files
478          CALL histend( nitb, snc4set )
479
480         IF(lwp) WRITE(numout,*)
481         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdib_wr'
482         IF(ll_print) CALL FLUSH(numout )
483         !
484      ENDIF
485
486      ! Start writing data
487      ! ------------------
488
489      ! biological trends
490      IF( lwp .AND. MOD( itmod, nn_writebio ) == 0 ) THEN
491         WRITE(numout,*) 'trcdit_wr : write NetCDF biological trends at ', kt, 'time-step'
492         WRITE(numout,*) '~~~~~~ '
493      ENDIF
494
495      DO jl = 1, jpdiabio
496         cltra = ctrbio(jl)  ! short title for biological diagnostic
497         CALL histwrite(nitb, cltra, it, trbio(:,:,:,jl), ndimt50,ndext50)
498      END DO
499
500      ! Closing all files
501      ! -----------------
502      IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nitb )
503      !
504
505   END SUBROUTINE trcdib_wr
506
507# else
508
509   SUBROUTINE trcdib_wr( kt, kindic )                      ! Dummy routine
510      INTEGER, INTENT ( in ) ::   kt, kindic
511   END SUBROUTINE trcdib_wr
512
513# endif 
514
515#else
516   !!----------------------------------------------------------------------
517   !!  Dummy module :                                     No passive tracer
518   !!----------------------------------------------------------------------
519CONTAINS
520   SUBROUTINE trc_dia( kt )                      ! Empty routine   
521      INTEGER, INTENT(in) :: kt
522   END SUBROUTINE trc_dia   
523#endif
524
525   !!======================================================================
526END MODULE trcdia
Note: See TracBrowser for help on using the repository browser.