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.

diawri_dimg.h90 in trunk/NEMO/OPA_SRC/DIA – NEMO

Context Navigation

source: trunk/NEMO/OPA_SRC/DIA/diawri_dimg.h90 @ 60

Last change on this file since 60 was 32, checked in by opalod, 20 years ago
CT : UPDATE001 : First major NEMO update
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 17.4 KB

Line
1	!!----------------------------------------------------------------------
2	!! * diawri_dimg.h90 *
3	!!----------------------------------------------------------------------
4	!! OPA 9.0 , LODYC-IPSL (2003)
5	!!----------------------------------------------------------------------
6
7	SUBROUTINE dia_wri (kt, kindic)
8	!!----------------------------------------------------------------------
9	!! * routine dia_wri *
10	!!
11	!! ** Purpose : output dynamics and tracer fields on direct access file
12	!! suitable for MPP computing
13	!!
14	!! ** define key : 'key_dimgout'
15	!!
16	!! ** Method : Default is to cumulate the values over the interval between
17	!! 2 output, and each nwrite time-steps the mean value is computed
18	!! and written to the direct access file.
19	!! If 'key_diainstant' is defined, no mean values are computed and the
20	!! instantaneous fields are dump.
21	!! kindic is 0 or >0 in normal condition. When < 0 it indicates an error
22	!! condition and instantaneous file output is forced.
23	!! Each processor creates its own file with its local data
24	!! Merging all the files is performed off line by a dedicated program
25	!!
26	!! ** Arguments :
27	!! kt : time-step number
28	!! kindinc : error condition indicator : >=0 : OK, < 0 : error.
29	!!
30	!! ** Naming convention for files
31	!!
32	!! {cexper}_{var}_y----m--d--.dimg
33	!! cexper is the name of the experience, given in the namelist
34	!! var can be either U, V, T, S, KZ, SSH, ...
35	!! var can also be 2D, which means that each level of the file is a 2D field as described below
36	!! y----m--d-- is the date at the time of the dump
37	!! For mpp output, each processor dumps its own memory, on appropriate record range
38	!! (direct access : for level jk of a klev field on proc narea irec = 1+ klev*(narea -1) + jk )
39	!! To be tested with a lot of procs !!!!
40	!!
41	!! level 1: taux(:,:) * umask(:,:,1) zonal stress in N.m-2
42	!! level 2: tauy(:,:) * vmask(:,:,1) meridional stress in N. m-2
43	!! level 3: q (:,:) + qsr(:,:) total heat flux (W/m2)
44	!! level 4: emp (:,:) E-P flux (mm/day)
45	!! level 5: tb (:,:,1)-sst model SST -forcing sst (degree C)
46	!! level 6: bsfb(:,:) streamfunction (m**3/s)
47	!! level 7: qsr (:,:) solar flux (W/m2)
48	!! level 8: qrp (:,:) relax component of T flux.
49	!! level 9: erp (:,:) relax component of S flux
50	!! level 10: hmld(:,:) turbocline depth
51	!! level 11: hmlp(:,:) mixed layer depth
52	!! level 12: freeze (:,:) Ice cover (1. or 0.)
53	!! level 13: sst(:,:) the observed SST we relax to.
54	!! level 14: qct(:,:) equivalent flux due to treshold SST
55	!! level 15: fbt(:,:) feedback term .
56	!! level 16: gps(:,:) the surface pressure (m).
57	!! level 17: spgu(:,:) the surface pressure gradient in X direction.
58	!! level 18: spgv(:,:) the surface pressure gradient in Y direction.
59	!!
60	!! History
61	!! original : 91-03 ()
62	!! additions : 91-11 (G. Madec)
63	!! additions : 92-06 (M. Imbard) correction restart file
64	!! additions : 92-07 (M. Imbard) split into diawri and rstwri
65	!! additions : 93-03 (M. Imbard) suppress writibm
66	!! additions : 94-12 (M. Imbard) acces direct files
67	!! additions : 97-2002 ( Clipper Group ) dimg files
68	!! dec 2003 ( J.M. Molines) f90, mpp output for OPA9.0
69	!!----------------------------------------------------------------------
70	!! * modules used
71	USE lib_mpp
72	USE dtasst, ONLY : sst
73
74	!! * Arguments
75	INTEGER ,INTENT(in) :: kt, kindic
76
77	!! * local declarations
78	INTEGER :: inbsel
79	!! INTEGER :: iwrite
80	INTEGER :: iyear,imon,iday
81
82	#if defined key_diainstant
83	REAL(wp),DIMENSION(jpi,jpj,jpk) :: fsel
84	LOGICAL, PARAMETER :: l_dia_inst=.true.
85
86	REAL(wp), SAVE, DIMENSION (1,1,1) :: um , vm ! dummy arrays for comiplation purpose
87	REAL(wp), SAVE, DIMENSION (1,1,1) :: tm , sm !
88	REAL(wp), SAVE, DIMENSION (1,1,1) :: fsel !
89	REAL(wp) :: zdtj
90	#else
91	INTEGER, SAVE :: nmoyct
92
93	REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: um , vm ! used to compute mean u, v fields
94	REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: tm , sm ! used to compute mean t, s fields
95	REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: fsel ! used to compute mean 2d fields
96	REAL(wp) :: zdtj
97	LOGICAL, PARAMETER :: l_dia_inst=.false.
98	#endif
99	!
100	CHARACTER(LEN=80) :: clname
101	CHARACTER(LEN=80) :: cltext
102	CHARACTER(LEN=80) :: clmode
103	CHARACTER(LEN= 4) :: clver
104	!
105	! Initialization
106	! ---------------
107	!
108	#ifdef key_diaspr
109	inbsel = 18
110	#else
111	inbsel = 15
112	#endif
113
114	IF (inbsel > jpk) THEN
115	IF (lwp) WRITE(numout,*) &
116	' STOP inbsel =',inbsel,' is larger than jpk=',jpk
117	STOP
118	END IF
119
120
121	iyear = ndastp/10000
122	imon = (ndastp-iyear*10000)/100
123	iday = ndastp - imon100 - iyear10000
124
125	!
126	!! dimg format V1.0 should start with the 4 char. string '@!01'
127	!!
128	clver='@!01'
129	!
130	IF ( .NOT. l_dia_inst ) THEN
131	!#if ! defined key_diainstant
132	!
133	!! * Mean output section
134	!! ----------------------
135	!
136	IF (kt == nit000 .AND. lwp ) WRITE(numout,*) &
137	'THE OUTPUT FILES CONTAINS THE AVERAGE OF EACH FIELD'
138	!
139	IF ( kt == nit000 .AND. kindic > 0 ) THEN
140	! reset arrays for average computation
141	nmoyct = 0
142	!
143	um(:,:,:) = 0._wp
144	vm(:,:,:) = 0._wp
145	tm(:,:,:) = 0._wp
146	sm(:,:,:) = 0._wp
147	fsel(:,:,:) = 0._wp
148	!
149	END IF
150
151	! cumulate values
152	! ---------------
153
154	nmoyct = nmoyct+1
155	!
156	um(:,:,:)=um(:,:,:) + un (:,:,:)
157	vm(:,:,:)=vm(:,:,:) + vn (:,:,:)
158	tm(:,:,:)=tm(:,:,:) + tn (:,:,:)
159	sm(:,:,:)=sm(:,:,:) + sn (:,:,:)
160	!
161	fsel(:,:,1 ) = fsel(:,:,1 ) + taux(:,:) * umask(:,:,1)
162	fsel(:,:,2 ) = fsel(:,:,2 ) + tauy(:,:) * vmask(:,:,1)
163	fsel(:,:,3 ) = fsel(:,:,3 ) + q (:,:) + qsr(:,:)
164	fsel(:,:,4 ) = fsel(:,:,4 ) + emp (:,:)
165	fsel(:,:,5 ) = fsel(:,:,5 ) + tb (:,:,1) - sst(:,:)
166	#if defined key_dynspg_fsc
167	fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:) ! SSH
168	#else
169	fsel(:,:,6 ) = fsel(:,:,6 ) + bsfn(:,:) ! BSF
170	#endif
171	fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:)
172	fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:)
173	fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:)
174	fsel(:,:,10) = fsel(:,:,10) + hmld(:,:)
175	fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:)
176	fsel(:,:,12) = fsel(:,:,12) + freeze(:,:)
177	fsel(:,:,13) = fsel(:,:,13) + sst(:,:)
178	! fsel(:,:,14) = fsel(:,:,14) + qct(:,:)
179	! fsel(:,:,15) = fsel(:,:,15) + fbt(:,:)
180	#ifdef key_diaspr
181	fsel(:,:,16) = fsel(:,:,16) + gps(:,:)/g
182	#endif
183	!
184	! Output of dynamics and tracer fields and selected fields (numwri)
185	! -----------------------------------------------------------------
186	!
187	!
188	zdtj=rdt/86400. ! time step in days
189	WRITE(clmode,'(f5.1,a)' ) nwrite*zdtj,' days average'
190
191	! iwrite=NINT(adatrj/rwrite)
192	! IF (abs(adatrj-iwrite*rwrite) < zdtj/2. &
193
194	IF ( ( MOD (kt,nwrite) == 0 ) &
195	& .OR. kindic < 0 &
196	& .OR. ( kt == 1 .AND. kindic > 0) ) THEN
197	! it is time to make a dump on file
198	! compute average
199	um(:,:,:) = um(:,:,:) / nmoyct
200	vm(:,:,:) = vm(:,:,:) / nmoyct
201	tm(:,:,:) = tm(:,:,:) / nmoyct
202	sm(:,:,:) = sm(:,:,:) / nmoyct
203	!
204	fsel(:,:,:) = fsel(:,:,:) / nmoyct
205	!
206	! note : the surface pressure is not averaged, but rather
207	! computed from the averaged gradients.
208	!
209	#ifdef key_diaspr
210	fsel(:,:,16)= gps(:,:)/g
211	fsel(:,:,17)= spgu(:,:)
212	fsel(:,:,18)= spgv(:,:)
213	#endif
214	ENDIF
215	!
216	ELSE ! l_dia_inst true
217	!# else
218	!
219	!! * Instantaneous output section
220	!! ------------------------------
221	!
222	IF (kt == nit000 .AND. lwp ) WRITE(numout,*) &
223	'THE OUTPUT FILES CONTAINS INSTANTANEOUS VALUES OF EACH FIELD'
224	!
225	zdtj=rdt/86400. ! time step in days
226	! iwrite=NINT(adatrj/rwrite)
227	clmode='instantaneous'
228	! IF (abs(adatrj-iwrite*rwrite) < zdtj/2. &
229	IF ( ( MOD (kt,nwrite) == 0 ) &
230	& .OR. kindic < 0 &
231	& .OR. ( kt == 1 .AND. kindic > 0) ) THEN
232	!
233	! transfer wp arrays to sp arrays for dimg files
234	fsel(:,:,:) = 0._wp
235	!
236	fsel(:,:,1 ) = taux(:,:) * umask(:,:,1)
237	fsel(:,:,2 ) = tauy(:,:) * vmask(:,:,1)
238	fsel(:,:,3 ) = q (:,:) + qsr(:,:)
239	fsel(:,:,4 ) = emp (:,:)
240	fsel(:,:,5 ) = (tb (:,:,1) -sst(:,:)) *tmask(:,:,1)
241
242	#if defined key_dynspg_fsc
243	fsel(:,:,6 ) = sshn(:,:)
244	#else
245	fsel(:,:,6 ) = bsfn(:,:)
246	#endif
247	fsel(:,:,7 ) = qsr (:,:)
248	fsel(:,:,8 ) = qrp (:,:)
249	fsel(:,:,9 ) = erp (:,:)*tmask(:,:,1)
250	fsel(:,:,10) = hmld(:,:)
251	fsel(:,:,11) = hmlp(:,:)
252	fsel(:,:,12) = freeze(:,:)
253	fsel(:,:,13) = sst(:,:)
254	! fsel(:,:,14) = qct(:,:)
255	! fsel(:,:,15) = fbt(:,:)
256	#ifdef key_diaspr
257	fsel(:,:,16) = gps(:,:) /g
258	fsel(:,:,17) = spgu(:,:)
259	fsel(:,:,18) = spgv(:,:)
260	#endif
261	!
262	! qct(:,:) = 0._wp
263	ENDIF
264	!#endif
265	ENDIF
266	!
267	! Opening of the datrj.out file with the absolute time in day of each dump
268	! this file gives a record of the dump date for post processing ( ASCII file )
269	!
270	IF ( ( MOD (kt,nwrite) == 0 ) &
271	& .OR. kindic < 0 &
272	& .OR. ( kt == 1 .AND. kindic > 0) ) THEN
273	OPEN (14,FILE='datrj.out',FORM='FORMATTED', STATUS='UNKNOWN',POSITION='APPEND ')
274
275	IF (lwp) WRITE(14,'(f10.4,1x,i8)') adatrj, ndastp
276	CLOSE(14)
277
278	IF (lwp) WRITE(numout,*)'Days since the begining of the run :',adatrj
279
280	!! * U section
281
282	WRITE(clname,9000) TRIM(cexper),'U',iyear,imon,iday
283	cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode)
284	IF ( kindic < 0 ) cltext=TRIM(cexper)//' U(m/s) instantaneous (explosion)'
285	!
286	IF ( l_dia_inst) THEN
287	CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
288
289	ELSE
290	IF ( kindic == -3 ) THEN
291	! ... in case of explosion on umax, dump instantateous u field instead of mean.
292	CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
293	ELSE
294	CALL dia_wri_dimg(clname, cltext, um, jpk, 'T')
295	END IF
296	ENDIF
297
298	!! * V section
299
300	WRITE(clname,9000) TRIM(cexper),'V',iyear,imon,iday
301	cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode)
302	!
303	IF ( l_dia_inst) THEN
304	CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T')
305	ELSE
306	CALL dia_wri_dimg(clname, cltext, vm, jpk, 'T')
307	END IF
308	!
309
310	!! * KZ section
311
312	WRITE(clname,9000) TRIM(cexper),'KZ',iyear,imon,iday
313	cltext=TRIM(cexper)//' KZ(m2/s) instantaneous'
314
315	! no average on kz (convective area may show up too strongly )
316	CALL dia_wri_dimg(clname, cltext, avt, jpk, 'W')
317	!
318
319	!! * T section
320
321	WRITE(clname,9000) TRIM(cexper),'T',iyear,imon,iday
322	cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode)
323
324	IF (l_dia_inst) THEN
325	CALL dia_wri_dimg(clname, cltext, tn, jpk, 'T')
326	ELSE
327	CALL dia_wri_dimg(clname, cltext, tm, jpk, 'T')
328	END IF
329	!
330
331	!! * S section
332
333	WRITE(clname,9000) TRIM(cexper),'S',iyear,imon,iday
334	cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode)
335
336	IF (l_dia_inst) THEN
337	CALL dia_wri_dimg(clname, cltext, sn, jpk, 'T')
338	ELSE
339	CALL dia_wri_dimg(clname, cltext, sm, jpk, 'T')
340	END IF
341	!
342
343	!! * 2D section
344
345	WRITE(clname,9000) TRIM(cexper),'2D',iyear,imon,iday
346	cltext='2D fields '//TRIM(clmode)
347
348	IF (l_dia_inst) THEN
349	CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
350	ELSE
351	CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
352	ENDIF
353
354	IF( lk_mpp ) CALL mppsync ! synchronization in mpp
355
356	!! * Log message in numout
357
358	IF(lwp)WRITE(numout,*) ' '
359	IF(lwp)WRITE(numout,) ' *** WRITE in numwri ',kt
360
361	IF(lwp .AND. l_dia_inst) WRITE(numout,*) ' instantaneous fields'
362	IF(lwp .AND. .NOT. l_dia_inst ) WRITE(numout,*) ' average fields with ',nmoyct,'pdt'
363	!
364	!
365	!! * Reset cumulating arrays and counter to 0 after writing
366	!
367	IF ( .NOT. l_dia_inst ) THEN
368	nmoyct = 0
369	!
370	um(:,:,:) = 0._wp
371	vm(:,:,:) = 0._wp
372	tm(:,:,:) = 0._wp
373	sm(:,:,:) = 0._wp
374	fsel(:,:,:) = 0._wp
375	ENDIF
376	END IF
377	!
378	9000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
379
380	END SUBROUTINE dia_wri
381
382	SUBROUTINE dia_wri_state ( cdfile_name)
383	!!-------------------------------------------------------------------
384	!! * ROUTINE dia_wri_state *
385	!!
386	!! ** Purpose : Dummy routine for compatibility with IOIPSL output
387	!!
388	!! ** History :
389	!! 9.O ! 03-06 (J.M. Molines ) dimgout
390	!!--------------------------------------------------------------------
391	!! * Arguments
392	CHARACTER (len=*), INTENT(in) :: cdfile_name ! name of the file created
393	!!--------------------------------------------------------------------
394
395	IF (lwp) WRITE(numout,*) 'dia_wri_state: Dummy call', cdfile_name
396	IF (lwp) WRITE(numout,*) '-------------'
397	IF (lwp) WRITE(numout,*)
398
399	END SUBROUTINE dia_wri_state
400
401	SUBROUTINE dia_wri_dimg(cd_name, cd_text, ptab, klev, cd_type )
402	!!-------------------------------------------------------------------------
403	!! * ROUTINE dia_wri_dimg *
404	!!
405	!! ** Purpose : write ptab in the dimg file cd_name, with comment cd_text.
406	!! ptab has klev x 2D fields
407	!!
408	!! ** Action :
409	!! Define header variables from the config parameters
410	!! Open the dimg file on unit inum = 14 ( IEEE I4R4 file )
411	!! Write header on record 1
412	!! Write ptab on the following klev records
413	!!
414	!! History :
415	!! 03-12 (J.M. Molines ) : Original. Replace ctlopn, writn2d
416	!!---------------------------------------------------------------------------
417	!! * subsitutions
418	# include "domzgr_substitute.h90"
419
420	!! * Arguments
421	CHARACTER(len=*),INTENT(in) :: &
422	& cd_name, & ! dimg file name
423	& cd_text ! comment to write on record #1
424	INTEGER, INTENT(in) :: klev ! number of level in ptab to write
425	REAL(wp),INTENT(in), DIMENSION(:,:,:) :: ptab ! 3D array to write
426	CHARACTER(LEN=1),INTENT(in) :: cd_type ! either 'T', 'W' or '2' , depending on the vertical
427	! ! grid for ptab. 2 stands for 2D file
428
429	!! * Local declarations
430	INTEGER :: jk, jn ! dummy loop indices
431	INTEGER :: irecl4, & ! record length in bytes
432	& inum, & ! logical unit (set to 14)
433	& irec ! current record to be written
434	REAL(sp) :: zdx,zdy,zspval,zwest,ztimm
435	REAL(sp) :: zsouth
436	REAL(sp),DIMENSION(jpi,jpj) :: z42d ! 2d temporary workspace (sp)
437	REAL(sp),DIMENSION(jpk) :: z4dep ! vertical level (sp)
438
439	CHARACTER(LEN=4) :: clver='@!01'
440	!!---------------------------------------------------------------------------
441
442	!! * Initialisations
443
444	irecl4 = jpijpjsp
445	inum = 14
446
447	zspval=0.0_sp ! special values on land
448	! the 'numerical' grid is described. The geographical one is in a grid file
449	zdx=1._sp
450	zdy=1._sp
451	zsouth=njmpp * 1._sp
452	zwest=nimpp * 1._sp
453	! time in days since the historical begining of the run (nit000 = 0 )
454	ztimm=adatrj
455
456	SELECT CASE ( cd_type )
457
458	CASE ( 'T')
459	z4dep(:)=fsdept(1,1,:)
460
461	CASE ( 'W' )
462	z4dep(:)=fsdepw(1,1,:)
463
464	CASE ( '2' )
465	z4dep(1:klev) =(/(jk, jk=1,klev)/)
466
467	CASE DEFAULT
468	IF(lwp) WRITE(numout,*) ' E R R O R : bad cd_type in dia_wri_dimg '
469	STOP 'dia_wri_dimg'
470
471	END SELECT
472
473	!! * Open file
474	OPEN (inum, FILE=cd_name, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl4 )
475
476	!! * Write header on record #1
477	IF(lwp) WRITE(inum,REC=1 ) clver, cd_text, irecl4, &
478	& jpi,jpj, klev*jpnij, 1 , 1 , &
479	& zwest, zsouth, zdx, zdy, zspval, &
480	& (z4dep(1:klev),jn=1,jpnij), &
481	& ztimm, &
482	& narea, jpnij,jpiglo,jpjglo, & ! extension to dimg for mpp output
483	& nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt !
484
485	!! * Write klev levels
486	DO jk = 1, klev
487	irec =1 + klev * (narea -1) + jk
488	z42d(:,:) = ptab(:,:,jk)
489	WRITE(inum,REC=irec) z42d(:,:)
490	END DO
491
492	!! * Close the file
493	CLOSE(inum)
494
495	END SUBROUTINE dia_wri_dimg

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

Download in other formats:

Original Format