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

source: branches/UKMO/dev_r10171_test_crs_AMM7/NEMOGCM/NEMO/TOP_SRC/trcdia.F90 @ 10207

Last change on this file since 10207 was 10207, checked in by cmao, 5 years ago

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