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 @ 405

Last change on this file since 405 was 405, checked in by opalod, 18 years ago
nemo_v1_024 : CT : bug fix for mean KZ output in dimg output format
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 15.1 KB

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

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

Download in other formats:

Original Format