Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

phys_output_mod.F90 @ 5452

Last change on this file since 5452 was 3331, checked in by acozic, 7 years ago
Add modification for isotopes
Property svn:executable set to ``*
File size: 36.0 KB

Line
1	! $Id: phys_output_mod.F90 2551 2016-06-09 09:30:18Z jyg $
2	!
3
4	MODULE phys_output_mod
5	USE indice_sol_mod
6	USE phys_output_var_mod
7	USE aero_mod, only : naero_spc,name_aero
8	USE phys_output_write_mod, ONLY : phys_output_write
9	REAL, DIMENSION(nfiles),SAVE :: ecrit_files
10
11	! Abderrahmane 12 2007
12	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
13	!!! Ecreture des Sorties du modele dans les fichiers Netcdf :
14	! histmth.nc : moyennes mensuelles
15	! histday.nc : moyennes journalieres
16	! histhf.nc : moyennes toutes les 3 heures
17	! histins.nc : valeurs instantanees
18	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
19
20	CONTAINS
21
22	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
23	!!!!!!!!! Ouverture des fichier et definition des variable de sortie !!!!!!!!
24	!! histbeg, histvert et histdef
25	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
26
27	SUBROUTINE phys_output_open(rlon,rlat,pim,tabij,ipt,jpt,plon,plat, &
28	jjmp1,nlevSTD,clevSTD,rlevSTD, dtime, ok_veget, &
29	type_ocean, iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, &
30	ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, read_climoz, &
31	phys_out_filestations, &
32	new_aod, aerosol_couple, flag_aerosol_strat, &
33	pdtphys, paprs, pphis, pplay, lmax_th, ptconv, ptconvth, ivap, &
34	d_t, qx, d_qx, zmasse, ok_sync)
35
36	USE iophy
37	USE dimphy
38	USE infotrac_phy, ONLY: nqtot, nqo, niadv, tname, ttext
39	#ifdef ISO
40	USE infotrac_phy, ONLY: ntraciso,niso,nqtottr,itr_indice
41	USE isotopes_mod, ONLY: striso,iso_HTO
42	#ifdef ISOTRAC
43	USE isotrac_mod, ONLY: strtrac,index_iso,index_zone
44	#endif
45	#endif
46	USE ioipsl
47	USE phys_cal_mod, only : hour, calend
48	USE mod_phys_lmdz_para
49	USE aero_mod, only : naero_spc,name_aero
50	!Martin
51	USE surface_data, ONLY : ok_snow
52	USE phys_output_ctrlout_mod
53	USE mod_grid_phy_lmdz, only: klon_glo,nbp_lon,nbp_lat
54	USE print_control_mod, ONLY: prt_level,lunout
55	USE vertical_layers_mod, ONLY: ap,bp,preff,presnivs
56	USE time_phylmdz_mod, ONLY: day_ini, itau_phy, start_time, annee_ref, day_ref
57	#ifdef CPP_XIOS
58	! ug Pour les sorties XIOS
59	USE wxios
60	#endif
61
62	IMPLICIT NONE
63	include "clesphys.h"
64	include "thermcell.h"
65	include "YOMCST.h"
66
67	! ug Nouveaux arguments n\'ecessaires au histwrite_mod:
68	INTEGER, INTENT(IN) :: ivap
69	INTEGER, DIMENSION(klon), INTENT(IN) :: lmax_th
70	LOGICAL, INTENT(IN) :: ok_sync
71	LOGICAL, DIMENSION(klon, klev), INTENT(IN) :: ptconv, ptconvth
72	REAL, INTENT(IN) :: pdtphys
73	REAL, DIMENSION(klon), INTENT(IN) :: pphis
74	REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay, d_t
75	REAL, DIMENSION(klon, klev+1), INTENT(IN) :: paprs
76	REAL, DIMENSION(klon,klev,nqtot), INTENT(IN):: qx, d_qx
77	REAL, DIMENSION(klon, klev), INTENT(IN) :: zmasse
78
79
80	REAL,DIMENSION(klon),INTENT(IN) :: rlon
81	REAL,DIMENSION(klon),INTENT(IN) :: rlat
82	INTEGER, INTENT(IN) :: pim
83	INTEGER, DIMENSION(pim) :: tabij
84	INTEGER,DIMENSION(pim), INTENT(IN) :: ipt, jpt
85	REAL,DIMENSION(pim), INTENT(IN) :: plat, plon
86	REAL,DIMENSION(pim,2) :: plat_bounds, plon_bounds
87
88	INTEGER :: jjmp1
89	INTEGER :: nlevSTD, radpas
90	LOGICAL :: ok_mensuel, ok_journe, ok_hf, ok_instan
91	LOGICAL :: ok_LES,ok_ade,ok_aie
92	INTEGER :: flag_aerosol_strat
93	LOGICAL :: new_aod, aerosol_couple
94	INTEGER, INTENT(IN):: read_climoz ! read ozone climatology
95	! Allowed values are 0, 1 and 2
96	! 0: do not read an ozone climatology
97	! 1: read a single ozone climatology that will be used day and night
98	! 2: read two ozone climatologies, the average day and night
99	! climatology and the daylight climatology
100
101	REAL :: dtime
102	INTEGER :: idayref
103	REAL :: zjulian_start, zjulian
104	REAL, DIMENSION(klev) :: Ahyb, Bhyb, Alt
105	CHARACTER(LEN=4), DIMENSION(nlevSTD) :: clevSTD
106	REAL, DIMENSION(nlevSTD) :: rlevSTD
107	INTEGER :: nsrf, k, iq, iiq, iff, i, j, ilev
108	INTEGER :: naero
109	LOGICAL :: ok_veget
110	INTEGER :: iflag_pbl
111	INTEGER :: iflag_pbl_split
112	CHARACTER(LEN=4) :: bb2
113	CHARACTER(LEN=2) :: bb3
114	CHARACTER(LEN=6) :: type_ocean
115	INTEGER, DIMENSION(nbp_lon*jjmp1) :: ndex2d
116	INTEGER, DIMENSION(nbp_lonjjmp1klev) :: ndex3d
117	INTEGER :: imin_ins, imax_ins
118	INTEGER :: jmin_ins, jmax_ins
119	INTEGER, DIMENSION(nfiles) :: phys_out_levmin, phys_out_levmax
120	INTEGER, DIMENSION(nfiles) :: phys_out_filelevels
121	CHARACTER(LEN=20), DIMENSION(nfiles) :: chtimestep = (/ 'Default', 'Default', 'Default', 'Default', 'Default', &
122	'Default', 'Default', 'Default', 'Default' /)
123	LOGICAL, DIMENSION(nfiles) :: phys_out_filekeys
124	LOGICAL, DIMENSION(nfiles) :: phys_out_filestations
125
126	!!!!!!!!!! stockage dans une region limitee pour chaque fichier !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
127	! entre [phys_out_lonmin,phys_out_lonmax] et [phys_out_latmin,phys_out_latmax]
128
129	LOGICAL, DIMENSION(nfiles), SAVE :: phys_out_regfkey = (/ .FALSE., .FALSE., .FALSE., .FALSE., &
130	.FALSE., .FALSE., .FALSE., .FALSE., .FALSE. /)
131	REAL, DIMENSION(nfiles), SAVE :: phys_out_lonmin = (/ -180., -180., -180., -180., &
132	-180., -180., -180., -180., -180. /)
133	REAL, DIMENSION(nfiles), SAVE :: phys_out_lonmax = (/ 180., 180., 180., 180., &
134	180., 180., 180., 180., 180. /)
135	REAL, DIMENSION(nfiles), SAVE :: phys_out_latmin = (/ -90., -90., -90., -90., &
136	-90., -90., -90., -90., -90. /)
137	REAL, DIMENSION(nfiles), SAVE :: phys_out_latmax = (/ 90., 90., 90., 90., &
138	90., 90., 90., 90., 90. /)
139
140	#ifdef ISO
141	integer ixt,itr
142	CHARACTER*50 striso_sortie
143	character(len=20) varname_iso
144	integer lnblnk
145	#ifdef ISOTRAC
146	integer iiso,izone
147	#endif
148	#endif
149
150	#ifdef CPP_XIOS
151	! ug Variables utilis\'ees pour r\'ecup\'erer le calendrier pour xios
152	INTEGER :: x_an, x_mois, x_jour
153	REAL :: x_heure
154	INTEGER :: ini_an, ini_mois, ini_jour
155	REAL :: ini_heure
156	#endif
157
158	WRITE(lunout,*) 'Debut phys_output_mod.F90'
159	! Initialisations (Valeurs par defaut
160
161	IF (.NOT. ALLOCATED(o_trac)) ALLOCATE(o_trac(nqtot))
162	IF (.NOT. ALLOCATED(o_trac_cum)) ALLOCATE(o_trac_cum(nqtot))
163	ALLOCATE(o_dtr_the(nqtot),o_dtr_con(nqtot),o_dtr_lessi_impa(nqtot))
164	ALLOCATE(o_dtr_lessi_nucl(nqtot),o_dtr_insc(nqtot),o_dtr_bcscav(nqtot))
165	ALLOCATE(o_dtr_evapls(nqtot),o_dtr_ls(nqtot),o_dtr_trsp(nqtot))
166	ALLOCATE(o_dtr_sscav(nqtot),o_dtr_sat(nqtot),o_dtr_uscav(nqtot))
167	ALLOCATE(o_dtr_dry(nqtot),o_dtr_vdf(nqtot))
168
169	#ifdef ISO
170	IF (.NOT. ALLOCATED(o_xtprecip)) ALLOCATE(o_xtprecip(ntraciso))
171	IF (.NOT. ALLOCATED(o_xtplul)) ALLOCATE(o_xtplul(ntraciso))
172	IF (.NOT. ALLOCATED(o_xtpluc)) ALLOCATE(o_xtpluc(ntraciso))
173	IF (.NOT. ALLOCATED(o_xtevap)) ALLOCATE(o_xtevap(ntraciso))
174	IF (.NOT. ALLOCATED(o_xtovap)) ALLOCATE(o_xtovap(ntraciso))
175	IF (.NOT. ALLOCATED(o_dxtdyn)) ALLOCATE(o_dxtdyn(ntraciso))
176	IF (.NOT. ALLOCATED(o_dxtldyn)) ALLOCATE(o_dxtldyn(ntraciso))
177	IF (.NOT. ALLOCATED(o_dxtlsc)) ALLOCATE(o_dxtlsc(ntraciso))
178	IF (.NOT. ALLOCATED(o_dxteva)) ALLOCATE(o_dxteva(ntraciso))
179	IF (.NOT. ALLOCATED(o_dxtcon)) ALLOCATE(o_dxtcon(ntraciso))
180	IF (.NOT. ALLOCATED(o_dxtajs)) ALLOCATE(o_dxtajs(ntraciso))
181	IF (.NOT. ALLOCATED(o_dxtch4)) ALLOCATE(o_dxtch4(ntraciso))
182	IF (.NOT. ALLOCATED(o_dxtvdf)) ALLOCATE(o_dxtvdf(ntraciso))
183	if (iso_HTO.gt.0) then
184	IF (.NOT. ALLOCATED(o_dxtprod_nucl)) ALLOCATE(o_dxtprod_nucl(ntraciso))
185	IF (.NOT. ALLOCATED(o_dxtcosmo)) ALLOCATE(o_dxtcosmo(ntraciso))
186	IF (.NOT. ALLOCATED(o_dxtdecroiss)) ALLOCATE(o_dxtdecroiss(ntraciso))
187	endif !if (iso_HTO.gt.0) then
188	#endif
189
190
191	levmax = (/ klev, klev, klev, klev, klev, klev, nlevSTD, nlevSTD, nlevSTD /)
192
193	phys_out_filenames(1) = 'histmth'
194	phys_out_filenames(2) = 'histday'
195	phys_out_filenames(3) = 'histhf6h'
196	phys_out_filenames(4) = 'histhf3h'
197	phys_out_filenames(5) = 'histhf3hm'
198	phys_out_filenames(6) = 'histstn'
199	phys_out_filenames(7) = 'histmthNMC'
200	phys_out_filenames(8) = 'histdayNMC'
201	phys_out_filenames(9) = 'histhfNMC.nc'
202
203	type_ecri(1) = 'ave(X)'
204	type_ecri(2) = 'ave(X)'
205	type_ecri(3) = 'inst(X)'
206	type_ecri(4) = 'inst(X)'
207	type_ecri(5) = 'ave(X)'
208	type_ecri(6) = 'inst(X)'
209	type_ecri(7) = 'inst(X)'
210	type_ecri(8) = 'inst(X)'
211	type_ecri(9) = 'inst(X)'
212
213	clef_files(1) = ok_mensuel
214	clef_files(2) = ok_journe
215	clef_files(3) = ok_hf
216	clef_files(4) = ok_instan
217	clef_files(5) = ok_LES
218	clef_files(6) = ok_instan
219	clef_files(7) = ok_histNMC(1)
220	clef_files(8) = ok_histNMC(2)
221	clef_files(9) = ok_histNMC(3)
222
223	!sortir des fichiers "stations" si clef_stations(:)=.TRUE.
224	clef_stations(1) = .FALSE.
225	clef_stations(2) = .FALSE.
226	clef_stations(3) = .FALSE.
227	clef_stations(4) = .FALSE.
228	clef_stations(5) = .FALSE.
229	clef_stations(6) = .FALSE.
230	clef_stations(7) = .FALSE.
231	clef_stations(8) = .FALSE.
232	clef_stations(9) = .FALSE.
233
234	lev_files(1) = lev_histmth
235	lev_files(2) = lev_histday
236	lev_files(3) = lev_histhf
237	lev_files(4) = lev_histins
238	lev_files(5) = lev_histLES
239	lev_files(6) = lev_histins
240	lev_files(7) = levout_histNMC(1)
241	lev_files(8) = levout_histNMC(2)
242	lev_files(9) = levout_histNMC(3)
243
244	ecrit_files(1) = ecrit_mth
245	ecrit_files(2) = ecrit_day
246	ecrit_files(3) = ecrit_hf
247	ecrit_files(4) = ecrit_ins
248	ecrit_files(5) = ecrit_LES
249	ecrit_files(6) = ecrit_ins
250	ecrit_files(7) = freq_outNMC(1)
251	ecrit_files(8) = freq_outNMC(2)
252	ecrit_files(9) = freq_outNMC(3)
253
254	!! Lectures des parametres de sorties dans physiq.def
255
256	CALL getin('phys_out_regfkey',phys_out_regfkey)
257	CALL getin('phys_out_lonmin',phys_out_lonmin)
258	CALL getin('phys_out_lonmax',phys_out_lonmax)
259	CALL getin('phys_out_latmin',phys_out_latmin)
260	CALL getin('phys_out_latmax',phys_out_latmax)
261	phys_out_levmin(:)=levmin(:)
262	CALL getin('phys_out_levmin',levmin)
263	phys_out_levmax(:)=levmax(:)
264	CALL getin('phys_out_levmax',levmax)
265	CALL getin('phys_out_filenames',phys_out_filenames)
266	phys_out_filekeys(:)=clef_files(:)
267	CALL getin('phys_out_filekeys',clef_files)
268	phys_out_filestations(:)=clef_stations(:)
269	CALL getin('phys_out_filestations',clef_stations)
270	phys_out_filelevels(:)=lev_files(:)
271	CALL getin('phys_out_filelevels',lev_files)
272	CALL getin('phys_out_filetimesteps',chtimestep)
273	phys_out_filetypes(:)=type_ecri(:)
274	CALL getin('phys_out_filetypes',type_ecri)
275
276	type_ecri_files(:)=type_ecri(:)
277
278	! if (ok_all_xml) phys_out_filelevels = 999
279
280	WRITE(lunout,*)'phys_out_lonmin=',phys_out_lonmin
281	WRITE(lunout,*)'phys_out_lonmax=',phys_out_lonmax
282	WRITE(lunout,*)'phys_out_latmin=',phys_out_latmin
283	WRITE(lunout,*)'phys_out_latmax=',phys_out_latmax
284	WRITE(lunout,*)'phys_out_filenames=',phys_out_filenames
285	WRITE(lunout,*)'phys_out_filetypes=',type_ecri
286	WRITE(lunout,*)'phys_out_filekeys=',clef_files
287	WRITE(lunout,*)'phys_out_filestations=',clef_stations
288	WRITE(lunout,*)'phys_out_filelevels=',lev_files
289
290	! A noter pour
291	! l heure initiale - dans les fichiers histoire hist* - on met comme
292	! heure de debut soit la vraie heure (pour le 1D) soit 0h (pour le 3D)
293	! afin d avoir une seule sortie mensuelle par mois lorsque l on tourne
294	! par annee (IM).
295	!
296	idayref = day_ref
297	IF (klon_glo==1) THEN
298	! current_time (used to compute hour) is updated at the begining of
299	! the physics; to set the correct outputs "initial time" we thus
300	! have to use (hour-dtphys).
301	CALL ymds2ju(annee_ref, 1, idayref, hour-pdtphys, zjulian)
302	print *,'phys_output_mod: annee,iday,hour,zjulian=',annee_ref,idayref, hour, zjulian
303	ELSE
304	CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
305	CALL ymds2ju(annee_ref, 1, day_ini, start_time*rday, zjulian_start)
306	END IF
307
308	#ifdef CPP_XIOS
309	! ug R\'eglage du calendrier xios
310	!Temps julian => an, mois, jour, heure
311	CALL ju2ymds(zjulian, x_an, x_mois, x_jour, x_heure)
312	CALL ju2ymds(zjulian_start, ini_an, ini_mois, ini_jour, ini_heure)
313	CALL wxios_set_cal(dtime, calend, x_an, x_mois, x_jour, x_heure, ini_an, &
314	ini_mois, ini_jour, ini_heure )
315	#endif
316
317	!!!!!!!!!!!!!!!!!!!!!!! Boucle sur les fichiers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
318	! Appel de histbeg et histvert pour creer le fichier et les niveaux verticaux !!
319	! Appel des histbeg pour definir les variables (nom, moy ou inst, freq de sortie ..
320	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
321
322	zdtime_moy = dtime ! Frequence ou l on moyenne
323
324	! Calcul des Ahyb, Bhyb et Alt
325	DO k=1,klev
326	Ahyb(k)=(ap(k)+ap(k+1))/2.
327	Bhyb(k)=(bp(k)+bp(k+1))/2.
328	Alt(k)=log(preff/presnivs(k))*8.
329	ENDDO
330	! if(prt_level.ge.1) then
331	WRITE(lunout,*)'Ap Hybrid = ',Ahyb(1:klev)
332	WRITE(lunout,*)'Bp Hybrid = ',Bhyb(1:klev)
333	WRITE(lunout,*)'Alt approx des couches pour une haut d echelle de 8km = ',Alt(1:klev)
334	! endif
335
336	ecrit_files(7) = ecrit_files(1)
337	ecrit_files(8) = ecrit_files(2)
338	ecrit_files(9) = ecrit_files(3)
339
340	DO iff=1,nfiles
341
342	! Calculate ecrit_files for all files
343	IF ( chtimestep(iff).eq.'Default' ) then
344	! Par defaut ecrit_files = (ecrit_mensuel ecrit_jour ecrit_hf
345	! ...)*86400.
346	ecrit_files(iff)=ecrit_files(iff)*86400.
347	ELSE IF (chtimestep(iff).eq.'-1') then
348	PRINT*,'ecrit_files(',iff,') < 0 so IOIPSL work on different'
349	PRINT*,'months length'
350	ecrit_files(iff)=-1.
351	else
352	CALL convers_timesteps(chtimestep(iff),dtime,ecrit_files(iff))
353	ENDIF
354
355	WRITE(lunout,*)'ecrit_files(',iff,')= ',ecrit_files(iff)
356	zoutm(iff) = ecrit_files(iff) ! Frequence ou l on ecrit en seconde
357
358
359	#ifdef CPP_XIOS
360	!!! Ouverture de chaque fichier XIOS !!!!!!!!!!!
361	IF (.not. ok_all_xml) then
362	if (prt_level >= 10) then
363	print*,'phys_output_open: call wxios_add_file with phys_out_filenames(iff)=',trim(phys_out_filenames(iff))
364	endif
365	CALL wxios_add_file(phys_out_filenames(iff),chtimestep(iff),lev_files(iff))
366	ENDIF
367
368	!!! Declaration des axes verticaux de chaque fichier:
369	if (prt_level >= 10) then
370	print*,'phys_output_open: Declare vertical axes for each file'
371	endif
372	if (iff.le.6) then
373	CALL wxios_add_vaxis("presnivs", &
374	levmax(iff) - levmin(iff) + 1, presnivs(levmin(iff):levmax(iff)))
375	CALL wxios_add_vaxis("Ahyb", &
376	levmax(iff) - levmin(iff) + 1, Ahyb)
377	CALL wxios_add_vaxis("Bhyb", &
378	levmax(iff) - levmin(iff) + 1, Bhyb)
379	CALL wxios_add_vaxis("Alt", &
380	levmax(iff) - levmin(iff) + 1, Alt)
381	else
382	! NMC files
383	CALL wxios_add_vaxis("plev", &
384	levmax(iff) - levmin(iff) + 1, rlevSTD(levmin(iff):levmax(iff)))
385	endif
386	#endif
387
388	IF (clef_files(iff)) THEN
389	!!!!!!!!!!!!!!!!! Traitement dans le cas ou l'on veut stocker sur un domaine limite !!
390	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
391	IF (phys_out_regfkey(iff)) then
392	imin_ins=1
393	imax_ins=nbp_lon
394	jmin_ins=1
395	jmax_ins=jjmp1
396
397	! correction abderr
398	do i=1,nbp_lon
399	WRITE(lunout,*)'io_lon(i)=',io_lon(i)
400	IF (io_lon(i).le.phys_out_lonmin(iff)) imin_ins=i
401	IF (io_lon(i).le.phys_out_lonmax(iff)) imax_ins=i+1
402	enddo
403
404	do j=1,jjmp1
405	WRITE(lunout,*)'io_lat(j)=',io_lat(j)
406	IF (io_lat(j).ge.phys_out_latmin(iff)) jmax_ins=j+1
407	IF (io_lat(j).ge.phys_out_latmax(iff)) jmin_ins=j
408	enddo
409
410	WRITE(lunout,*)'On stoke le fichier histoire numero ',iff,' sur ', &
411	imin_ins,imax_ins,jmin_ins,jmax_ins
412	WRITE(lunout,*)'longitudes : ', &
413	io_lon(imin_ins),io_lon(imax_ins), &
414	'latitudes : ', &
415	io_lat(jmax_ins),io_lat(jmin_ins)
416
417	CALL histbeg(phys_out_filenames(iff),nbp_lon,io_lon,jjmp1,io_lat, &
418	imin_ins,imax_ins-imin_ins+1, &
419	jmin_ins,jmax_ins-jmin_ins+1, &
420	itau_phy,zjulian,dtime,nhorim(iff),nid_files(iff))
421	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
422	!IM fichiers stations
423	else IF (clef_stations(iff)) THEN
424
425	if (prt_level >= 10) then
426	WRITE(lunout,*)'phys_output_open: iff=',iff,' phys_out_filenames(iff)=',phys_out_filenames(iff)
427	endif
428
429	CALL histbeg_phy_all(rlon,rlat,pim,tabij,ipt,jpt,plon,plat,plon_bounds,plat_bounds, &
430	phys_out_filenames(iff), &
431	itau_phy,zjulian,dtime,nhorim(iff),nid_files(iff))
432	else
433	CALL histbeg_phy_all(phys_out_filenames(iff),itau_phy,zjulian,&
434	dtime,nhorim(iff),nid_files(iff))
435	endif
436
437	#ifndef CPP_IOIPSL_NO_OUTPUT
438	if (iff.le.6) then
439	CALL histvert(nid_files(iff), "presnivs", "Vertical levels", "Pa", &
440	levmax(iff) - levmin(iff) + 1, &
441	presnivs(levmin(iff):levmax(iff)), nvertm(iff),"down")
442	!!!! Composantes de la coordonnee sigma-hybride
443	CALL histvert(nid_files(iff), "Ahyb","Ahyb comp of Hyb Cord ", "Pa", &
444	levmax(iff) - levmin(iff) + 1,Ahyb,nvertap(iff))
445
446	CALL histvert(nid_files(iff), "Bhyb","Bhyb comp of Hyb Cord", " ", &
447	levmax(iff) - levmin(iff) + 1,Bhyb,nvertbp(iff))
448
449	CALL histvert(nid_files(iff), "Alt","Height approx for scale heigh of 8km at levels", "Km", &
450	levmax(iff) - levmin(iff) + 1,Alt,nvertAlt(iff))
451
452	else
453	CALL histvert(nid_files(iff), "plev", "pressure", "Pa", &
454	levmax(iff) - levmin(iff) + 1, &
455	rlevSTD(levmin(iff):levmax(iff)), nvertm(iff), "down")
456	endif
457	#endif
458
459	ENDIF ! clef_files
460
461	!CR: ajout d'une variable eau
462	! IF (nqtot>=3) THEN
463
464	IF (nqtot>=nqo+1) THEN
465	! DO iq=3,nqtot
466	#ifdef ISO
467	DO itr=1,nqtottr
468	iq= itr_indice(itr)
469	iiq=niadv(iq)
470	o_trac(itr) = ctrl_out((/ 4, 5, 5, 5, 10, 10, 11, 11, 11 /), &
471	tname(iiq),'Tracer '//ttext(iiq), "-", &
472	(/ '', '', '', '', '', '', '', '', '' /))
473	o_dtr_vdf(itr) = ctrl_out((/ 4, 7, 7, 7, 10, 10, 11, 11, 11 /), &
474	'd'//trim(tname(iq))//'_vdf', &
475	'Tendance tracer '//ttext(iiq), "-" , &
476	(/ '', '', '', '', '', '', '', '', '' /))
477
478	o_dtr_the(itr) = ctrl_out((/ 5, 7, 7, 7, 10, 10, 11, 11, 11 /), &
479	'd'//trim(tname(iq))//'_the', &
480	'Tendance tracer '//ttext(iiq), "-", &
481	(/ '', '', '', '', '', '', '', '', '' /))
482
483	o_dtr_con(itr) = ctrl_out((/ 5, 7, 7, 7, 10, 10, 11, 11, 11 /), &
484	'd'//trim(tname(iq))//'_con', &
485	'Tendance tracer '//ttext(iiq), "-", &
486	(/ '', '', '', '', '', '', '', '', '' /))
487
488	o_dtr_lessi_impa(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
489	'd'//trim(tname(iq))//'_lessi_impa', &
490	'Tendance tracer '//ttext(iiq), "-", &
491	(/ '', '', '', '', '', '', '', '', '' /))
492
493	o_dtr_lessi_nucl(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
494	'd'//trim(tname(iq))//'_lessi_nucl', &
495	'Tendance tracer '//ttext(iiq), "-", &
496	(/ '', '', '', '', '', '', '', '', '' /))
497
498	o_dtr_insc(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
499	'd'//trim(tname(iq))//'_insc', &
500	'Tendance tracer '//ttext(iiq), "-", &
501	(/ '', '', '', '', '', '', '', '', '' /))
502
503	o_dtr_bcscav(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
504	'd'//trim(tname(iq))//'_bcscav', &
505	'Tendance tracer '//ttext(iiq), "-", &
506	(/ '', '', '', '', '', '', '', '', '' /))
507
508	o_dtr_evapls(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
509	'd'//trim(tname(iq))//'_evapls', &
510	'Tendance tracer '//ttext(iiq), "-", &
511	(/ '', '', '', '', '', '', '', '', '' /))
512
513	o_dtr_ls(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
514	'd'//trim(tname(iq))//'_ls', &
515	'Tendance tracer '//ttext(iiq), "-", &
516	(/ '', '', '', '', '', '', '', '', '' /))
517
518	o_dtr_trsp(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
519	'd'//trim(tname(iq))//'_trsp', &
520	'Tendance tracer '//ttext(iiq), "-", &
521	(/ '', '', '', '', '', '', '', '', '' /))
522
523	o_dtr_sscav(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
524	'd'//trim(tname(iq))//'_sscav', &
525	'Tendance tracer '//ttext(iiq), "-", &
526	(/ '', '', '', '', '', '', '', '', '' /))
527
528	o_dtr_sat(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
529	'd'//trim(tname(iq))//'_sat', &
530	'Tendance tracer '//ttext(iiq), "-", &
531	(/ '', '', '', '', '', '', '', '', '' /))
532
533	o_dtr_uscav(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
534	'd'//trim(tname(iq))//'_uscav', &
535	'Tendance tracer '//ttext(iiq), "-", &
536	(/ '', '', '', '', '', '', '', '', '' /))
537
538	o_dtr_dry(itr) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
539	'cum'//'d'//trim(tname(iq))//'_dry', &
540	'tracer tendency dry deposition'//ttext(iiq), "-", &
541	(/ '', '', '', '', '', '', '', '', '' /))
542
543	o_trac_cum(itr) = ctrl_out((/ 3, 4, 10, 10, 10, 10, 11, 11, 11 /), &
544	'cum'//tname(iiq),&
545	'Cumulated tracer '//ttext(iiq), "-", &
546	(/ '', '', '', '', '', '', '', '', '' /))
547	ENDDO
548	#else
549	DO iq=nqo+1,nqtot
550	iiq=niadv(iq)
551	o_trac(iq-nqo) = ctrl_out((/ 4, 5, 5, 5, 10, 10, 11, 11, 11 /), &
552	tname(iiq),'Tracer '//ttext(iiq), "-", &
553	(/ '', '', '', '', '', '', '', '', '' /))
554	o_dtr_vdf(iq-nqo) = ctrl_out((/ 4, 7, 7, 7, 10, 10, 11, 11, 11 /), &
555	'd'//trim(tname(iq))//'_vdf', &
556	'Tendance tracer '//ttext(iiq), "-" , &
557	(/ '', '', '', '', '', '', '', '', '' /))
558
559	o_dtr_the(iq-nqo) = ctrl_out((/ 5, 7, 7, 7, 10, 10, 11, 11, 11 /), &
560	'd'//trim(tname(iq))//'_the', &
561	'Tendance tracer '//ttext(iiq), "-", &
562	(/ '', '', '', '', '', '', '', '', '' /))
563
564	o_dtr_con(iq-nqo) = ctrl_out((/ 5, 7, 7, 7, 10, 10, 11, 11, 11 /), &
565	'd'//trim(tname(iq))//'_con', &
566	'Tendance tracer '//ttext(iiq), "-", &
567	(/ '', '', '', '', '', '', '', '', '' /))
568
569	o_dtr_lessi_impa(iq-nqo) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
570	'd'//trim(tname(iq))//'_lessi_impa', &
571	'Tendance tracer '//ttext(iiq), "-", &
572	(/ '', '', '', '', '', '', '', '', '' /))
573
574	o_dtr_lessi_nucl(iq-nqo) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
575	'd'//trim(tname(iq))//'_lessi_nucl', &
576	'Tendance tracer '//ttext(iiq), "-", &
577	(/ '', '', '', '', '', '', '', '', '' /))
578
579	o_dtr_insc(iq-nqo) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
580	'd'//trim(tname(iq))//'_insc', &
581	'Tendance tracer '//ttext(iiq), "-", &
582	(/ '', '', '', '', '', '', '', '', '' /))
583
584	o_dtr_bcscav(iq-nqo) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
585	'd'//trim(tname(iq))//'_bcscav', &
586	'Tendance tracer '//ttext(iiq), "-", &
587	(/ '', '', '', '', '', '', '', '', '' /))
588
589	o_dtr_evapls(iq-nqo) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
590	'd'//trim(tname(iq))//'_evapls', &
591	'Tendance tracer '//ttext(iiq), "-", &
592	(/ '', '', '', '', '', '', '', '', '' /))
593
594	o_dtr_ls(iq-nqo) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
595	'd'//trim(tname(iq))//'_ls', &
596	'Tendance tracer '//ttext(iiq), "-", &
597	(/ '', '', '', '', '', '', '', '', '' /))
598
599	o_dtr_trsp(iq-nqo) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
600	'd'//trim(tname(iq))//'_trsp', &
601	'Tendance tracer '//ttext(iiq), "-", &
602	(/ '', '', '', '', '', '', '', '', '' /))
603
604	o_dtr_sscav(iq-nqo) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
605	'd'//trim(tname(iq))//'_sscav', &
606	'Tendance tracer '//ttext(iiq), "-", &
607	(/ '', '', '', '', '', '', '', '', '' /))
608
609	o_dtr_sat(iq-nqo) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
610	'd'//trim(tname(iq))//'_sat', &
611	'Tendance tracer '//ttext(iiq), "-", &
612	(/ '', '', '', '', '', '', '', '', '' /))
613
614	o_dtr_uscav(iq-nqo) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
615	'd'//trim(tname(iq))//'_uscav', &
616	'Tendance tracer '//ttext(iiq), "-", &
617	(/ '', '', '', '', '', '', '', '', '' /))
618
619	o_dtr_dry(iq-nqo) = ctrl_out((/ 7, 7, 7, 7, 10, 10, 11, 11, 11 /), &
620	'cum'//'d'//trim(tname(iq))//'_dry', &
621	'tracer tendency dry deposition'//ttext(iiq), "-", &
622	(/ '', '', '', '', '', '', '', '', '' /))
623
624	o_trac_cum(iq-nqo) = ctrl_out((/ 3, 4, 10, 10, 10, 10, 11, 11, 11 /), &
625	'cum'//tname(iiq),&
626	'Cumulated tracer '//ttext(iiq), "-", &
627	(/ '', '', '', '', '', '', '', '', '' /))
628	ENDDO
629	#endif
630	ENDIF
631
632	#ifdef ISO
633	write(,) 'phys_output_mod tmp 538'
634	do ixt=1,ntraciso
635	if (ixt.le.niso) then
636	striso_sortie=striso(ixt)
637	write(,) 'ixt,striso_sortie=',ixt,striso_sortie
638	else
639	#ifdef ISOTRAC
640	iiso=index_iso(ixt)
641	izone=index_zone(ixt)
642	striso_sortie=striso(iiso)//strtrac(izone)
643	write(,) 'ixt,striso_sortie=',ixt,striso_sortie
644	#endif
645	endif
646
647	o_xtprecip(ixt)= ctrl_out((/ 4, 5, 5, 5, 10, 10, 11, 11, 11 /), &
648	'precip'//striso_sortie(1:lnblnk(striso_sortie)),&
649	'Precip Totale liq+sol '//striso_sortie(1:lnblnk(striso_sortie)), "kg/(s*m2)", &
650	(/ ('', i=1, 9) /))
651	o_xtplul(ixt)= ctrl_out((/ 4, 5, 5, 5, 10, 10, 11, 11, 11 /), &
652	'plul'//striso_sortie(1:lnblnk(striso_sortie)),&
653	'Large-scale Precip. '//striso_sortie(1:lnblnk(striso_sortie)), "kg/(s*m2)", &
654	(/ ('', i=1, 9) /))
655	o_xtpluc(ixt)= ctrl_out((/ 4, 5, 5, 5, 10, 10, 11, 11, 11 /), &
656	'pluc'//striso_sortie(1:lnblnk(striso_sortie)),&
657	'Convective Precip. '//striso_sortie(1:lnblnk(striso_sortie)), "kg/(s*m2)", &
658	(/ ('', i=1, 9) /))
659
660	o_xtevap(ixt)= ctrl_out((/ 4, 5, 5, 5, 10, 10, 11, 11, 11 /), &
661	'evap'//striso_sortie(1:lnblnk(striso_sortie)),&
662	'Evaporat '//striso_sortie(1:lnblnk(striso_sortie)), "kg/(s*m2)", &
663	(/ ('', i=1, 9) /))
664	o_xtovap(ixt)= ctrl_out((/ 2, 3, 4, 10, 10, 10, 11, 11, 11 /), &
665	'ovap'//striso_sortie(1:lnblnk(striso_sortie)), &
666	'Specific humidity '//striso_sortie(1:lnblnk(striso_sortie)), 'kg/kg', &
667	(/ ('', i=1, 9) /))
668
669	o_dxtdyn(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
670	'dqdyn'//striso_sortie(1:lnblnk(striso_sortie)), &
671	'Dynamics dQ '//striso_sortie(1:lnblnk(striso_sortie)), '(kg/kg)/s', &
672	(/ ('', i=1, 9) /))
673	o_dxtldyn(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
674	'dqldyn'//striso_sortie(1:lnblnk(striso_sortie)), &
675	'Dynamics dQL '//striso_sortie(1:lnblnk(striso_sortie)), '(kg/kg)/s', &
676	(/ ('', i=1, 9) /))
677	o_dxtcon(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
678	'dqcon'//striso_sortie(1:lnblnk(striso_sortie)), &
679	'Convection dQ '//striso_sortie(1:lnblnk(striso_sortie)), '(kg/kg)/s', &
680	(/ ('', i=1, 9) /))
681	o_dxtvdf(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
682	'dqvdf'//striso_sortie(1:lnblnk(striso_sortie)), &
683	'Boundary-layer dQ '//striso_sortie(1:lnblnk(striso_sortie)), '(kg/kg)/s', &
684	(/ ('', i=1, 9) /))
685	o_dxtajs(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
686	'dqajs'//striso_sortie(1:lnblnk(striso_sortie)), &
687	'Dry adjust. dQ '//striso_sortie(1:lnblnk(striso_sortie)), '(kg/kg)/s', &
688	(/ ('', i=1, 9) /))
689	o_dxteva(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
690	'dqeva'//striso_sortie(1:lnblnk(striso_sortie)), &
691	'Reevaporation dQ '//striso_sortie(1:lnblnk(striso_sortie)), '(kg/kg)/s', &
692	(/ ('', i=1, 9) /))
693	o_dxtlsc(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
694	'dqlsc'//striso_sortie(1:lnblnk(striso_sortie)), &
695	'Condensation dQ '//striso_sortie(1:lnblnk(striso_sortie)), '(kg/kg)/s', &
696	(/ ('', i=1, 9) /))
697	o_dxtch4(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
698	'dqch4'//striso_sortie(1:lnblnk(striso_sortie)), &
699	'H2O due to CH4 oxidation & photolysis '//striso_sortie(1:lnblnk(striso_sortie)), '(kg/kg)/s', &
700	(/ ('', i=1, 9) /))
701	if (iso_HTO.gt.0) then
702	o_dxtprod_nucl(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
703	'dqprod_nucl'//striso_sortie(1:lnblnk(striso_sortie)), &
704	'H2O due to nuclear production '//striso_sortie(1:lnblnk(striso_sortie)), '(kg/kg)/s', &
705	(/ ('', i=1, 9) /))
706	o_dxtcosmo(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
707	'dqcosmo'//striso_sortie(1:lnblnk(striso_sortie)), &
708	'H2O due to cosmogenic production '//striso_sortie(1:lnblnk(striso_sortie)), '(kg/kg)/s', &
709	(/ ('', i=1, 9) /))
710	o_dxtdecroiss(ixt) = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
711	'dqdecroiss'//striso_sortie(1:lnblnk(striso_sortie)), &
712	'H2O due to radioactive decay '//striso_sortie(1:lnblnk(striso_sortie)), '(kg/kg)/s', &
713	(/ ('', i=1, 9) /))
714	endif ! if (iso_HTO.gt.0) then
715	enddo !do ixt=1,ntraciso
716	#endif
717
718
719	ENDDO ! iff
720
721	! Updated write frequencies due to phys_out_filetimesteps.
722	! Write frequencies are now in seconds.
723	ecrit_mth = ecrit_files(1)
724	ecrit_day = ecrit_files(2)
725	ecrit_hf = ecrit_files(3)
726	ecrit_ins = ecrit_files(4)
727	ecrit_LES = ecrit_files(5)
728	ecrit_ins = ecrit_files(6)
729
730	if (prt_level >= 10) then
731	WRITE(lunout,*)'swaero_diag=',swaero_diag
732	WRITE(lunout,*)'phys_output_open: ends here'
733	endif
734
735	end SUBROUTINE phys_output_open
736
737
738
739	SUBROUTINE convers_timesteps(str,dtime,timestep)
740
741	use ioipsl
742	USE phys_cal_mod
743	USE time_phylmdz_mod, ONLY: day_ref, annee_ref
744	USE print_control_mod, ONLY: lunout
745
746	IMPLICIT NONE
747
748	CHARACTER(LEN=20) :: str
749	CHARACTER(LEN=10) :: type
750	INTEGER :: ipos,il
751	real :: ttt,xxx,timestep,dayseconde,dtime
752	parameter (dayseconde=86400.)
753
754	ipos=scan(str,'0123456789.',.TRUE.)
755	!
756	il=len_trim(str)
757	WRITE(lunout,*) "ipos = ", ipos
758	WRITE(lunout,*) "il = ", il
759	if (ipos == 0) call abort_physic("convers_timesteps", "bad str", 1)
760	read(str(1:ipos),*) ttt
761	WRITE(lunout,*)ttt
762	type=str(ipos+1:il)
763
764
765	IF ( il == ipos ) then
766	type='day'
767	endif
768
769	IF ( type == 'day'.or.type == 'days'.or.type == 'jours'.or.type == 'jour' ) timestep = ttt * dayseconde
770	IF ( type == 'mounths'.or.type == 'mth'.or.type == 'mois' ) then
771	WRITE(lunout,*)'annee_ref,day_ref mon_len',annee_ref,day_ref,mth_len
772	timestep = ttt * dayseconde * mth_len
773	endif
774	IF ( type == 'hours'.or.type == 'hr'.or.type == 'heurs') timestep = ttt * dayseconde / 24.
775	IF ( type == 'mn'.or.type == 'minutes' ) timestep = ttt * 60.
776	IF ( type == 's'.or.type == 'sec'.or.type == 'secondes' ) timestep = ttt
777	IF ( type == 'TS' ) timestep = ttt * dtime
778
779	WRITE(lunout,*)'type = ',type
780	WRITE(lunout,*)'nb j/h/m = ',ttt
781	WRITE(lunout,*)'timestep(s)=',timestep
782
783	END SUBROUTINE convers_timesteps
784
785	END MODULE phys_output_mod
786
787

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

Download in other formats:

Original Format