Context Navigation

phys_output_mod.F90 @ 4263

Last change on this file since 4263 was 4170, checked in by dcugnet, 2 years ago

The variable "types_trac" is the equivalent of "type_trac" in case multiple sections must be read
and used in "tracer.def" file.
Tests on the "type_trac" were replaced with tests on the vector "types_trac".
Most of the time, there are two components: 'lmdz' and a second one. The later has priority on 'lmdz'
and must be used for the tests. For more components, care must be taken to execute specific parts
of the code on the right tracers ; the tracers(:)%component has been created in that respect.

File size: 27.8 KB

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

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

Download in other formats:

Original Format