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

Context Navigation

source: trunk/NEMO/TOP_SRC/trcdia.F90 @ 1450

Last change on this file since 1450 was 1450, checked in by cetlod, 15 years ago
implementation of iom_put in TOP, see ticket:432
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 30.0 KB

Line
1	MODULE trcdia
2	!!======================================================================
3	!! * MODULE trcdia *
4	!! TOP : Output of passive tracers
5	!!======================================================================
6	!! History : - ! 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	!! 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	!! trcdid_wr : outputs of dvection-diffusion trends
20	!! trcdii_wr : outputs of additional 2D/3D diagnostics
21	!! trcdib_wr : outputs of biological fields
22	!!----------------------------------------------------------------------
23	USE oce_trc
24	USE trc
25	USE trp_trc
26	USE trdmld_trc_oce, ONLY : luttrd
27	USE dianam ! build name of file (routine)
28	USE in_out_manager ! I/O manager
29	USE lib_mpp
30	USE ioipsl
31	USE iom
32
33	IMPLICIT NONE
34	PRIVATE
35
36	PUBLIC trc_dia
37
38	INTEGER :: nit5 !: id for tracer output file
39	INTEGER :: ndepit5 !: id for depth mesh
40	INTEGER :: nhorit5 !: id for horizontal mesh
41	INTEGER :: ndimt50 !: number of ocean points in index array
42	INTEGER :: ndimt51 !: number of ocean points in index array
43	REAL(wp) :: xjulian !: ???? not DOCTOR !
44	INTEGER , DIMENSION (jpij*jpk) :: ndext50 !: integer arrays for ocean 3D index
45	INTEGER , DIMENSION (jpij) :: ndext51 !: integer arrays for ocean surface index
46	# if defined key_trc_diaadd
47	INTEGER :: nitd !: id for additional array output file
48	INTEGER :: ndepitd !: id for depth mesh
49	INTEGER :: nhoritd !: id for horizontal mesh
50	# endif
51	# if defined key_trc_diatrd
52	INTEGER , DIMENSION (jptra) :: nit6 !: id for additional array output file
53	INTEGER , DIMENSION (jptra) :: ndepit6 !: id for depth mesh
54	INTEGER , DIMENSION (jptra) :: nhorit6 !: id for horizontal mesh
55	# endif
56	# if defined key_trc_diabio
57	INTEGER :: nitb !: id. for additional array output file
58	INTEGER :: ndepitb !: id for depth mesh
59	INTEGER :: nhoritb !: id for horizontal mesh
60	# endif
61
62	!! * Substitutions
63	# include "top_substitute.h90"
64	!!----------------------------------------------------------------------
65	!! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)
66	!! $Id$
67	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
68	!!----------------------------------------------------------------------
69
70	CONTAINS
71
72	SUBROUTINE trc_dia( kt, kindic )
73	!!---------------------------------------------------------------------
74	!! * ROUTINE trc_dia *
75	!!
76	!! ** Purpose : output passive tracers fields
77	!!---------------------------------------------------------------------
78	INTEGER, INTENT( in ) :: kt, kindic
79	!!---------------------------------------------------------------------
80
81	CALL trcdit_wr( kt, kindic ) ! outputs for tracer concentration
82	CALL trcdid_wr( kt, kindic ) ! outputs for dynamical trends
83	CALL trcdii_wr( kt, kindic ) ! outputs for additional arrays
84	CALL trcdib_wr( kt, kindic ) ! outputs for biological trends
85
86	!
87	END SUBROUTINE trc_dia
88
89	SUBROUTINE trcdit_wr( kt, kindic )
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 (nit000), 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	!! IF kindic <0, output of fields before the model interruption.
102	!! IF kindic =0, time step loop
103	!! IF kindic >0, output of fields before the time step loop
104	!!----------------------------------------------------------------------
105	INTEGER, INTENT( in ) :: kt ! ocean time-step
106	INTEGER, INTENT( in ) :: kindic ! indicator of abnormal termination
107	!!
108	INTEGER :: jn
109	LOGICAL :: ll_print = .FALSE.
110	CHARACTER (len=40) :: clhstnam, clop
111	CHARACTER (len=20) :: cltra, cltrau
112	CHARACTER (len=80) :: cltral
113	REAL(wp) :: zsto, zout, zdt
114	INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod
115	!!----------------------------------------------------------------------
116
117	! Initialisation
118	! --------------
119
120	CALL iom_setkt( kt + ndttrc - 1 )
121
122	! local variable for debugging
123	ll_print = .FALSE. ! change it to true for more control print
124	ll_print = ll_print .AND. lwp
125
126	! Define frequency of output and means
127	zdt = rdt
128	IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)
129	ELSE ; clop = "x" ! no use of the mask value (require less cpu time)
130	ENDIF
131	# if defined key_diainstant
132	zsto = nwritetrc * rdt
133	clop = "inst("//TRIM(clop)//")"
134	# else
135	zsto = zdt
136	clop = "ave("//TRIM(clop)//")"
137	# endif
138	zout = nwritetrc * zdt
139
140	! Define indices of the horizontal output zoom and vertical limit storage
141	iimi = 1 ; iima = jpi
142	ijmi = 1 ; ijma = jpj
143	ipk = jpk
144
145	! define time axis
146	itmod = kt - nittrc000 + 1
147	it = kt
148
149	! Define NETCDF files and fields at beginning of first time step
150	! --------------------------------------------------------------
151
152	IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic
153
154	IF( kt == nittrc000 ) THEN
155
156	! Compute julian date from starting date of the run
157	CALL ymds2ju( nyear, nmonth, nday, rdt, xjulian )
158	xjulian = xjulian - adatrj ! set calendar origin to the beginning of the experiment
159	IF(lwp)WRITE(numout,*)' '
160	IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000 &
161	& ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday &
162	& ,'Julian day : ', xjulian
163
164	IF(lwp) WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, &
165	& ' limit storage in depth = ', ipk
166
167
168	! Define the NETCDF files for passive tracer concentration
169	CALL dia_nam( clhstnam, nwritetrc, 'ptrc_T' )
170	IF(lwp)WRITE(numout,*)" Name of NETCDF file ", clhstnam
171
172	! Horizontal grid : glamt and gphit
173	CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, &
174	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
175	& nittrc000-ndttrc, xjulian, zdt, nhorit5, nit5 , domain_id=nidom)
176
177	! Vertical grid for tracer : gdept
178	CALL histvert( nit5, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepit5)
179
180	! Index of ocean points in 3D and 2D (surface)
181	CALL wheneq( jpijpjipk, tmask, 1, 1., ndext50, ndimt50 )
182	CALL wheneq( jpi*jpj , tmask, 1, 1., ndext51, ndimt51 )
183
184	! Declare all the output fields as NETCDF variables
185	DO jn = 1, jptra
186	IF( lutsav(jn) ) THEN
187	cltra = ctrcnm(jn) ! short title for tracer
188	cltral = ctrcnl(jn) ! long title for tracer
189	cltrau = ctrcun(jn) ! UNIT for tracer
190	CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5, &
191	& ipk, 1, ipk, ndepit5, 32, clop, zsto, zout )
192	ENDIF
193	END DO
194
195	! end netcdf files header
196	CALL histend( nit5 )
197	IF(lwp) WRITE(numout,*)
198	IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdit_wr'
199	IF( ll_print ) CALL FLUSH(numout )
200
201	ENDIF
202
203	! Start writing the tracer concentrations
204	! ---------------------------------------
205
206	IF( lwp .AND. MOD( itmod, nwritetrc ) == 0 ) THEN
207	WRITE(numout,*) 'trcdit_wr : write NetCDF passive tracer concentrations at ', kt, 'time-step'
208	WRITE(numout,*) '~~~~~~~~~ '
209	ENDIF
210
211	DO jn = 1, jptra
212	cltra = ctrcnm(jn) ! short title for tracer
213	IF( lutsav(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 )
214	CALL iom_put( ctrcnm(jn), trn(:,:,:,jn) )
215	END DO
216
217	! close the file
218	! --------------
219	IF( kt == nitend .OR. kindic < 0 ) CALL histclo( nit5 )
220	!
221	CALL iom_setkt( kt )
222
223	END SUBROUTINE trcdit_wr
224
225	# if defined key_trc_diatrd
226
227	SUBROUTINE trcdid_wr( kt, kindic )
228	!!----------------------------------------------------------------------
229	!! * ROUTINE trcdid_wr *
230	!!
231	!! ** Purpose : output of passive tracer : advection-diffusion trends
232	!!
233	!! ** Method : At the beginning of the first time step (nit000), define all
234	!! the NETCDF files and fields for concentration of passive tracer
235	!!
236	!! At each time step call histdef to compute the mean if necessary
237	!! Each nwritetrd time step, output the instantaneous or mean fields
238	!!
239	!! IF kindic <0, output of fields before the model interruption.
240	!! IF kindic =0, time step loop
241	!! IF kindic >0, output of fields before the time step loop
242	!!----------------------------------------------------------------------
243	INTEGER, INTENT( in ) :: kt ! ocean time-step
244	INTEGER, INTENT( in ) :: kindic ! indicator of abnormal termination
245	!!
246	LOGICAL :: ll_print = .FALSE.
247	CHARACTER (len=40) :: clhstnam, clop
248	CHARACTER (len=20) :: cltra, cltrau
249	CHARACTER (len=80) :: cltral
250	CHARACTER (len=10) :: csuff
251	INTEGER :: jn, jl
252	INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod
253	REAL(wp) :: zsto, zout, zdt
254	!!----------------------------------------------------------------------
255
256	! 0. Initialisation
257	! -----------------
258
259	CALL iom_setkt( kt + ndttrc - 1 )
260
261	! local variable for debugging
262	ll_print = .FALSE.
263	ll_print = ll_print .AND. lwp
264	!
265	! Define frequency of output and means
266	zdt = rdt
267	IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)
268	ELSE ; clop = "x" ! no use of the mask value (require less cpu time)
269	ENDIF
270	# if defined key_diainstant
271	zsto = nwritetrd * rdt
272	clop = "inst("//TRIM(clop)//")"
273	# else
274	zsto = zdt
275	clop = "ave("//TRIM(clop)//")"
276	# endif
277	zout = nwritetrd * zdt
278
279	! Define indices of the horizontal output zoom and vertical limit storage
280	iimi = 1 ; iima = jpi
281	ijmi = 1 ; ijma = jpj
282	ipk = jpk
283
284	! define time axis
285	itmod = kt - nittrc000 + 1
286	it = kt
287
288	! Define the NETCDF files (one per tracer)
289	IF( ll_print ) WRITE(numout,*) 'trcdid kt=', kt, ' kindic ', kindic
290
291
292	IF( kt == nittrc000 ) THEN
293
294	DO jn = 1, jptra
295	!
296	IF( luttrd(jn) ) THEN ! Define the file for dynamical trends - one per each tracer IF required
297
298	IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, &
299	& ' limit storage in depth = ', ipk
300	csuff='DY_'//ctrcnm(jn)
301	CALL dia_nam( clhstnam, nwritetrd, csuff )
302	IF(lwp)WRITE(numout,*) " Name of NETCDF file for dynamical trends", &
303	& " of tracer number : ",clhstnam
304
305	CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, &
306	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
307	& nittrc000-ndttrc, xjulian, zdt, nhorit6(jn), &
308	& nit6(jn) , domain_id=nidom )
309
310	! Vertical grid for tracer trend - one per each tracer IF needed
311	CALL histvert( nit6(jn), 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepit6(jn) )
312	END IF
313	END DO
314
315	! Declare all the output fields as NETCDF variables
316
317	! trends for tracer concentrations
318	DO jn = 1, jptra
319	IF( luttrd(jn) ) THEN
320	DO jl = 1, jpdiatrc
321	IF( jl == 1 ) THEN
322	! short and long title for x advection for tracer
323	WRITE (cltra,'("XAD_",16a)') ctrcnm(jn)
324	WRITE (cltral,'("X advective trend for ",58a)') &
325	& ctrcnl(jn)(1:58)
326	END IF
327	IF( jl == 2 ) THEN
328	! short and long title for y advection for tracer
329	WRITE (cltra,'("YAD_",16a)') ctrcnm(jn)
330	WRITE (cltral,'("Y advective trend for ",58a)') &
331	& ctrcnl(jn)(1:58)
332	END IF
333	IF( jl == 3 ) THEN
334	! short and long title for Z advection for tracer
335	WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn)
336	WRITE (cltral,'("Z advective trend for ",58a)') &
337	& ctrcnl(jn)(1:58)
338	END IF
339	IF( jl == 4 ) THEN
340	! short and long title for X diffusion for tracer
341	WRITE (cltra,'("XDF_",16a)') ctrcnm(jn)
342	WRITE (cltral,'("X diffusion trend for ",58a)') &
343	& ctrcnl(jn)(1:58)
344	END IF
345	IF( jl == 5 ) THEN
346	! short and long title for Y diffusion for tracer
347	WRITE (cltra,'("YDF_",16a)') ctrcnm(jn)
348	WRITE (cltral,'("Y diffusion trend for ",58a)') &
349	& ctrcnl(jn)(1:58)
350	END IF
351	IF( jl == 6 ) THEN
352	! short and long title for Z diffusion for tracer
353	WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn)
354	WRITE (cltral,'("Z diffusion trend for ",58a)') &
355	& ctrcnl(jn)(1:58)
356	END IF
357	# if defined key_trcldf_eiv
358	IF( jl == 7 ) THEN
359	! short and long title for x gent velocity for tracer
360	WRITE (cltra,'("XGV_",16a)') ctrcnm(jn)
361	WRITE (cltral,'("X gent velocity trend for ",53a)') &
362	& ctrcnl(jn)(1:53)
363	END IF
364	IF( jl == 8 ) THEN
365	! short and long title for y gent velocity for tracer
366	WRITE (cltra,'("YGV_",16a)') ctrcnm(jn)
367	WRITE (cltral,'("Y gent velocity trend for ",53a)') &
368	& ctrcnl(jn)(1:53)
369	END IF
370	IF( jl == 9 ) THEN
371	! short and long title for Z gent velocity for tracer
372	WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn)
373	WRITE (cltral,'("Z gent velocity trend for ",53a)') &
374	& ctrcnl(jn)(1:53)
375	END IF
376	# endif
377	# if defined key_trcdmp
378	IF( jl == jpdiatrc - 1 ) THEN
379	! last trends for tracer damping : short and long title
380	WRITE (cltra,'("TDM_",16a)') ctrcnm(jn)
381	WRITE (cltral,'("Tracer damping trend for ",55a)') &
382	& ctrcnl(jn)(1:55)
383	END IF
384	# endif
385	IF( jl == jpdiatrc ) THEN
386	! last trends for tracer damping : short and long title
387	WRITE (cltra,'("SBC_",16a)') ctrcnm(jn)
388	WRITE (cltral,'("Surface boundary flux ",58a)') &
389	& ctrcnl(jn)(1:58)
390	END IF
391
392	CALL FLUSH( numout )
393	cltrau = ctrcun(jn) ! UNIT for tracer /trends
394	CALL histdef( nit6(jn), cltra, cltral, cltrau, jpi,jpj, &
395	& nhorit6(jn), ipk, 1, ipk, ndepit6(jn), 32, clop , &
396	& zsto,zout )
397	END DO
398	END IF
399	END DO
400
401	! CLOSE netcdf Files
402	DO jn = 1, jptra
403	IF( luttrd(jn) ) CALL histend( nit6(jn) )
404	END DO
405
406	IF(lwp) WRITE(numout,*)
407	IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdid'
408	IF(ll_print) CALL FLUSH(numout )
409	!
410	ENDIF
411
412	! SOME diagnostics to DO first time
413
414	! Start writing data
415	! ---------------------
416
417	! trends for tracer concentrations
418
419	IF( lwp .AND. MOD( itmod, nwritetrd ) == 0 ) THEN
420	WRITE(numout,*) 'trcdid_wr : write NetCDF dynamical trends at ', kt, 'time-step'
421	WRITE(numout,*) '~~~~~~ '
422	ENDIF
423
424	DO jn = 1, jptra
425	IF( luttrd(jn) ) THEN
426	DO jl = 1, jpdiatrc
427	! short titles
428	IF( jl == 1) WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) ! x advection for tracer
429	IF( jl == 2) WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) ! z advection for tracer
430	IF( jl == 3) WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) ! z advection for tracer
431	IF( jl == 4) WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) ! x diffusion for tracer
432	IF( jl == 5) WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) ! y diffusion for tracer
433	IF( jl == 6) WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) ! z diffusion for tracer
434	# if defined key_trcldf_eiv
435	IF( jl == 7) WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) ! x gent velocity for tracer
436	IF( jl == 8) WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) ! y gent velocity for tracer
437	IF( jl == 9) WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) ! z gent velocity for tracer
438	# endif
439	# if defined key_trcdmp
440	IF( jl == jpdiatrc - 1 ) WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) ! damping
441	# endif
442	IF( jl == jpdiatrc ) WRITE (cltra,'("SBC_",a)') ctrcnm(jn) ! surface boundary conditions
443	!
444	CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikeep(jn),jl),ndimt50, ndext50)
445	END DO
446	END IF
447	CALL iom_put( ctrcnm(jn), trn(:,:,:,jn) )
448	END DO
449
450	! Closing all files
451	! -----------------
452	IF( kt == nitend .OR. kindic < 0 ) THEN
453	DO jn = 1, jptra
454	IF( luttrd(jn) ) CALL histclo( nit6(jn) )
455	END DO
456	ENDIF
457	!
458	CALL iom_setkt( kt )
459
460	END SUBROUTINE trcdid_wr
461
462	# else
463
464	SUBROUTINE trcdid_wr( kt, kindic ) ! Dummy routine
465	INTEGER, INTENT ( in ) :: kt, kindic
466	END SUBROUTINE trcdid_wr
467
468	# endif
469
470	#if defined key_trc_diaadd
471
472	SUBROUTINE trcdii_wr( kt, kindic )
473	!!----------------------------------------------------------------------
474	!! * ROUTINE trcdii_wr *
475	!!
476	!! ** Purpose : output of passive tracer : additional 2D and 3D arrays
477	!!
478	!! ** Method : At the beginning of the first time step (nit000), define all
479	!! the NETCDF files and fields for concentration of passive tracer
480	!!
481	!! At each time step call histdef to compute the mean if necessary
482	!! Each nwritedia time step, output the instantaneous or mean fields
483	!!
484	!! IF kindic <0, output of fields before the model interruption.
485	!! IF kindic =0, time step loop
486	!! IF kindic >0, output of fields before the time step loop
487	!!----------------------------------------------------------------------
488	INTEGER, INTENT( in ) :: kt ! ocean time-step
489	INTEGER, INTENT( in ) :: kindic ! indicator of abnormal termination
490	!!
491	LOGICAL :: ll_print = .FALSE.
492	CHARACTER (len=40) :: clhstnam, clop
493	CHARACTER (len=20) :: cltra, cltrau
494	CHARACTER (len=80) :: cltral
495	INTEGER :: jl
496	INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod
497	REAL(wp) :: zsto, zout, zdt
498	!!----------------------------------------------------------------------
499
500	! Initialisation
501	! --------------
502
503	CALL iom_setkt( kt + ndttrc - 1 )
504
505	! local variable for debugging
506	ll_print = .FALSE.
507	ll_print = ll_print .AND. lwp
508	!
509	! Define frequency of output and means
510	zdt = rdt
511	IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)
512	ELSE ; clop = "x" ! no use of the mask value (require less cpu time)
513	ENDIF
514	# if defined key_diainstant
515	zsto = nwritedia * zdt
516	clop = "inst("//TRIM(clop)//")"
517	# else
518	zsto = zdt
519	clop = "ave("//TRIM(clop)//")"
520	# endif
521	zout = nwritedia * zdt
522
523	! Define indices of the horizontal output zoom and vertical limit storage
524	iimi = 1 ; iima = jpi
525	ijmi = 1 ; ijma = jpj
526	ipk = jpk
527
528	! define time axis
529	itmod = kt - nittrc000 + 1
530	it = kt
531
532	! 1. Define NETCDF files and fields at beginning of first time step
533	! -----------------------------------------------------------------
534
535	IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt, ' kindic ', kindic
536
537	IF( kt == nittrc000 ) THEN
538
539	! Define the NETCDF files for additional arrays : 2D or 3D
540
541	! Define the T grid file for tracer auxiliary files
542
543	CALL dia_nam( clhstnam, nwritedia, 'diad_T' )
544	IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
545
546	! Define a netcdf FILE for 2d and 3d arrays
547
548	CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, &
549	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
550	& nittrc000-ndttrc, xjulian, zdt, nhoritd, nitd , domain_id=nidom )
551
552	! Vertical grid for 2d and 3d arrays
553
554	CALL histvert( nitd, 'deptht', 'Vertical T levels','m', ipk, gdept_0, ndepitd)
555
556	! Declare all the output fields as NETCDF variables
557
558	! more 3D horizontal arrays
559	DO jl = 1, jpdia3d
560	cltra = ctrc3d(jl) ! short title for 3D diagnostic
561	cltral = ctrc3l(jl) ! long title for 3D diagnostic
562	cltrau = ctrc3u(jl) ! UNIT for 3D diagnostic
563	CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd, &
564	& ipk, 1, ipk, ndepitd, 32, clop, zsto, zout )
565	END DO
566
567	! more 2D horizontal arrays
568	DO jl = 1, jpdia2d
569	cltra = ctrc2d(jl) ! short title for 2D diagnostic
570	cltral = ctrc2l(jl) ! long title for 2D diagnostic
571	cltrau = ctrc2u(jl) ! UNIT for 2D diagnostic
572	CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd, &
573	& 1, 1, 1, -99, 32, clop, zsto, zout )
574	END DO
575
576	! TODO: more 2D vertical sections arrays : I or J indice fixed
577
578	! CLOSE netcdf Files
579	CALL histend( nitd )
580
581	IF(lwp) WRITE(numout,*)
582	IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdii_wr'
583	IF( ll_print ) CALL FLUSH(numout )
584	!
585	ENDIF
586
587	! 2. Start writing data
588	! ---------------------
589
590	IF( lwp .AND. MOD( itmod, nwritedia ) == 0 ) THEN
591	WRITE(numout,*) 'trcdii_wr : write NetCDF additional arrays at ', kt, 'time-step'
592	WRITE(numout,*) '~~~~~~ '
593	ENDIF
594
595	! more 3D horizontal arrays
596	DO jl = 1, jpdia3d
597	cltra = ctrc3d(jl) ! short title for 3D diagnostic
598	CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jl), ndimt50 ,ndext50)
599	CALL iom_put( cltra, trc3d(:,:,:,jl) )
600	END DO
601
602	! more 2D horizontal arrays
603	DO jl = 1, jpdia2d
604	cltra = ctrc2d(jl) ! short title for 2D diagnostic
605	CALL histwrite(nitd, cltra, it, trc2d(:,:,jl), ndimt51 ,ndext51)
606	CALL iom_put( cltra, trc2d(:,:,jl) )
607	END DO
608
609	! Closing all files
610	! -----------------
611	IF( kt == nitend .OR. kindic < 0 ) CALL histclo(nitd)
612	!
613	CALL iom_setkt( kt )
614
615	END SUBROUTINE trcdii_wr
616
617	# else
618
619	SUBROUTINE trcdii_wr( kt, kindic ) ! Dummy routine
620	INTEGER, INTENT ( in ) :: kt, kindic
621	END SUBROUTINE trcdii_wr
622
623	# endif
624
625	# if defined key_trc_diabio
626
627	SUBROUTINE trcdib_wr( kt, kindic )
628	!!----------------------------------------------------------------------
629	!! * ROUTINE trcdib_wr *
630	!!
631	!! ** Purpose : output of passive tracer : biological fields
632	!!
633	!! ** Method : At the beginning of the first time step (nit000), define all
634	!! the NETCDF files and fields for concentration of passive tracer
635	!!
636	!! At each time step call histdef to compute the mean if necessary
637	!! Each nwritebio time step, output the instantaneous or mean fields
638	!!
639	!! IF kindic <0, output of fields before the model interruption.
640	!! IF kindic =0, time step loop
641	!! IF kindic >0, output of fields before the time step loop
642	!!----------------------------------------------------------------------
643	!!
644	INTEGER, INTENT( in ) :: kt ! ocean time-step
645	INTEGER, INTENT( in ) :: kindic ! indicator of abnormal termination
646	!!
647	LOGICAL :: ll_print = .FALSE.
648	CHARACTER (len=40) :: clhstnam, clop
649	CHARACTER (len=20) :: cltra, cltrau
650	CHARACTER (len=80) :: cltral
651	INTEGER :: ji, jj, jk, jl
652	INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod
653	REAL(wp) :: zsto, zout, zdt
654	!!----------------------------------------------------------------------
655
656	! Initialisation
657	! --------------
658
659	CALL iom_setkt( kt + ndttrc - 1 )
660
661	! local variable for debugging
662	ll_print = .FALSE.
663	ll_print = ll_print .AND. lwp
664
665	! Define frequency of output and means
666	zdt = rdt
667	IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)
668	ELSE ; clop = "x" ! no use of the mask value (require less cpu time)
669	ENDIF
670	# if defined key_diainstant
671	zsto = nwritebio * zdt
672	clop = "inst("//TRIM(clop)//")"
673	# else
674	zsto = zdt
675	clop = "ave("//TRIM(clop)//")"
676	# endif
677	zout = nwritebio * zdt
678
679	! Define indices of the horizontal output zoom and vertical limit storage
680	iimi = 1 ; iima = jpi
681	ijmi = 1 ; ijma = jpj
682	ipk = jpk
683
684	! define time axis
685	itmod = kt - nittrc000 + 1
686	it = kt
687
688	! Define NETCDF files and fields at beginning of first time step
689	! --------------------------------------------------------------
690
691	IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic
692
693	IF( kt == nittrc000 ) THEN
694
695	! Define the NETCDF files for biological trends
696
697	CALL dia_nam(clhstnam,nwritebio,'biolog')
698	IF(lwp)WRITE(numout,*) " Name of NETCDF file for biological trends ", clhstnam
699	! Horizontal grid : glamt and gphit
700	CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, &
701	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
702	& nittrc000-ndttrc, xjulian, zdt, nhoritb, nitb , domain_id=nidom )
703	! Vertical grid for biological trends
704	CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb)
705
706	! Declare all the output fields as NETCDF variables
707	! biological trends
708	DO jl = 1, jpdiabio
709	cltra = ctrbio(jl) ! short title for biological diagnostic
710	cltral = ctrbil(jl) ! long title for biological diagnostic
711	cltrau = ctrbiu(jl) ! UNIT for biological diagnostic
712	CALL histdef( nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb, &
713	& ipk, 1, ipk, ndepitb, 32, clop, zsto, zout)
714	END DO
715
716	! CLOSE netcdf Files
717	CALL histend( nitb )
718
719	IF(lwp) WRITE(numout,*)
720	IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdib_wr'
721	IF(ll_print) CALL FLUSH(numout )
722	!
723	ENDIF
724
725	! Start writing data
726	! ------------------
727
728	! biological trends
729	IF( lwp .AND. MOD( itmod, nwritebio ) == 0 ) THEN
730	WRITE(numout,*) 'trcdit_wr : write NetCDF biological trends at ', kt, 'time-step'
731	WRITE(numout,*) '~~~~~~ '
732	ENDIF
733
734	DO jl = 1, jpdiabio
735	cltra = ctrbio(jl) ! short title for biological diagnostic
736	CALL histwrite(nitb, cltra, it, trbio(:,:,:,jl), ndimt50,ndext50)
737	CALL iom_put( cltra, trbio(:,:,:,jl) )
738	END DO
739
740	! Closing all files
741	! -----------------
742	IF( kt == nitend .OR. kindic < 0 ) CALL histclo( nitb )
743	!
744	CALL iom_setkt( kt )
745
746	END SUBROUTINE trcdib_wr
747
748	# else
749
750	SUBROUTINE trcdib_wr( kt, kindic ) ! Dummy routine
751	INTEGER, INTENT ( in ) :: kt, kindic
752	END SUBROUTINE trcdib_wr
753
754	# endif
755
756	#else
757	!!----------------------------------------------------------------------
758	!! Dummy module : No passive tracer
759	!!----------------------------------------------------------------------
760	CONTAINS
761	SUBROUTINE trc_dia ! Empty routine
762	END SUBROUTINE trc_dia
763
764	#endif
765
766	!!======================================================================
767	END MODULE trcdia

Note: See TracBrowser for help on using the repository browser.

Download in other formats: