Context Navigation

phys_output_mod.F90 @ 3643

Last change on this file since 3643 was 3630, checked in by Laurent Fairhead, 5 years ago
Parameter new_aod is not needed anymore as it is assumed to be true all the time. This means that we cannot replay AR4 simulations with new LMDZ sources (we probably couldn't anyway) LF, OB
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 26.9 KB

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

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

Download in other formats:

Original Format