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

source: branches/UKMO/r5936_hadgem3_cplfld/NEMOGCM/NEMO/TOP_SRC/trcdia.F90 @ 7138

Last change on this file since 7138 was 7138, checked in by jcastill, 7 years ago

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