source: branches/NERC/dev_r5518_GO6_CO2_cmip/NEMOGCM/NEMO/TOP_SRC/trcdia.F90 @ 9309

Last change on this file since 9309 was 6486, checked in by davestorkey, 5 years ago

Remove SVN keywords from UKMO/dev_r5518_GO6_package branch.

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