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 @ 2690

Last change on this file since 2690 was 2690, checked in by gm, 13 years ago

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