Context Navigation

source: trunk/LMDZ.TITAN/libf/phytitan/write_histmth.h @ 1523

Last change on this file since 1523 was 1356, checked in by slebonnois, 11 years ago
SL: update to newstart/start2archive tools in Venus+Titan / additional diagnostics in radiative fluxes for Titan
File size: 12.1 KB

Rev	Line
[3]	1	IF (ok_mensuel) THEN
[1056]	2
[3]	3	zsto = dtime
[1056]	4	zout = dtime * REAL(ecrit_mth)
[3]	5	itau_w = itau_phy + itap
[1056]	6
[3]	7	c-------------------------------------------------------
	8	IF(lev_histmth.GE.1) THEN
[1056]	9
[3]	10	ccccccccccccc 2D fields, invariables
[1056]	11
	12	call histwrite_phy(nid_mth,.false.,"phis",itau_w,pphis)
	13	call histwrite_phy(nid_mth,.false.,"aire",itau_w,airephy)
	14
[808]	15	ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement...
[1056]	16	c Correction passage de 360 a 0... Sinon probleme avec moyenne
[808]	17	if (zls.lt.zlsm1) then
[1056]	18	do i=1,klon
	19	tmpout(i,1) = zls*180./RPI+360.
	20	enddo
[808]	21	zlsm1 = 2.*RPI
	22	else
[1056]	23	do i=1,klon
	24	tmpout(i,1) = zls*180./RPI
	25	enddo
[808]	26	zlsm1 = zls
	27	endif
[1056]	28	call histwrite_phy(nid_mth,.false.,"ls",itau_w,tmpout(:,1))
	29
[3]	30	ccccccccccccc 2D fields, variables
[1056]	31
	32	call histwrite_phy(nid_mth,.false.,"tsol",itau_w,ftsol)
	33	call histwrite_phy(nid_mth,.false.,"psol",itau_w,paprs(:,1))
	34
	35	c call histwrite_phy(nid_mth,.false.,"ue",itau_w,ue)
	36	c call histwrite_phy(nid_mth,.false.,"ve",itau_w,ve)
	37
[3]	38	ENDIF !lev_histmth.GE.1
[1056]	39
[3]	40	c-------------------------------------------------------
	41	IF(lev_histmth.GE.2) THEN
[1056]	42
[3]	43	ccccccccccccc 3D fields, basics
[1056]	44
	45	call histwrite_phy(nid_mth,.false.,"temp",itau_w,t_seri)
	46	call histwrite_phy(nid_mth,.false.,"pres",itau_w,pplay)
	47	call histwrite_phy(nid_mth,.false.,"geop",itau_w,zphi)
	48	call histwrite_phy(nid_mth,.false.,"vitu",itau_w,u_seri)
	49	call histwrite_phy(nid_mth,.false.,"vitv",itau_w,v_seri)
	50	call histwrite_phy(nid_mth,.false.,"vitw",itau_w,omega)
	51	c call histwrite_phy(nid_mth,.false.,"Kz",itau_w,ycoefh)
	52	call histwrite_phy(nid_mth,.false.,"tops",itau_w,topsw)
	53	call histwrite_phy(nid_mth,.false.,"duvdf",itau_w,d_u_vdf)
	54	call histwrite_phy(nid_mth,.false.,"dudyn",itau_w,d_u_dyn)
	55
[175]	56	cccccccccccccccccc Tracers
[1056]	57
[3]	58	if (iflag_trac.eq.1) THEN
[175]	59	if (microfi.ge.1) then
[97]	60	c DO iq=1,nmicro
[1056]	61	c call histwrite_phy(nid_mth,.false.,tname(iq),
	62	c . itau_w,qaer(1:klon,1:klev,iq))
[97]	63	c ENDDO
[175]	64	c ------- NB AER TOT
	65	do i=1,klon
	66	do j=1,klev
[1056]	67	tmpout(i,j)= SUM(qaer(i,j,1:nrad))
[175]	68	enddo
	69	enddo
[1056]	70	call histwrite_phy(nid_mth,.false.,"qaer",itau_w,tmpout)
[306]	71
	72	if (clouds.eq.1) then
[175]	73	c ------- NB NOY TOT
	74	do i=1,klon
	75	do j=1,klev
[1056]	76	tmpout(i,j)= SUM(qaer(i,j,nrad+1:2*nrad))
[175]	77	enddo
	78	enddo
[1056]	79	call histwrite_phy(nid_mth,.false.,"qnoy",itau_w,tmpout)
[175]	80	c ------- V GLA1 TOT
	81	do i=1,klon
	82	do j=1,klev
[1056]	83	tmpout(i,j)= SUM(qaer(i,j,2nrad+1:3nrad))
[175]	84	enddo
	85	enddo
[1056]	86	call histwrite_phy(nid_mth,.false.,"qgl1",itau_w,tmpout)
[175]	87	c ------- V GLA2 TOT
	88	do i=1,klon
	89	do j=1,klev
[1056]	90	tmpout(i,j)= SUM(qaer(i,j,3nrad+1:4nrad))
[175]	91	enddo
	92	enddo
[1056]	93	call histwrite_phy(nid_mth,.false.,"qgl2",itau_w,tmpout)
[175]	94	c ------- V GLA3 TOT
	95	do i=1,klon
	96	do j=1,klev
[1056]	97	tmpout(i,j)= SUM(qaer(i,j,4nrad+1:5nrad))
[175]	98	enddo
	99	enddo
[1056]	100	call histwrite_phy(nid_mth,.false.,"qgl3",itau_w,tmpout)
[175]	101	c --------------
	102	c ----- SATURATION ESP NUAGES
[1056]	103	call histwrite_phy(nid_mth,.false.,"ch4sat",itau_w,satch4)
	104	call histwrite_phy(nid_mth,.false.,"c2h6sat",itau_w,satc2h6)
	105	call histwrite_phy(nid_mth,.false.,"c2h2sat",itau_w,satc2h2)
[175]	106	c --------------
	107	c ----- RESERVOIR DE SURFACE
[1056]	108	call histwrite_phy(nid_mth,.false.,"reserv",itau_w,reservoir)
[175]	109	c --------------
[474]	110	c ----- ECHANGE GAZ SURF/ATM (evaporation)
[1056]	111	call histwrite_phy(nid_mth,.false.,"evapch4",itau_w,evapch4)
[474]	112	c --------------
[175]	113	c ----- PRECIPITATIONS
	114	c ----- CH4
[1056]	115	call histwrite_phy(nid_mth,.false.,"prech4",
	116	. itau_w,precip(1:klon,1))
[175]	117	c ----- C2H6
[1056]	118	call histwrite_phy(nid_mth,.false.,"prec2h6",
	119	. itau_w,precip(1:klon,2))
[175]	120	c ----- C2H2
[1056]	121	call histwrite_phy(nid_mth,.false.,"prec2h2",
	122	. itau_w,precip(1:klon,3))
[474]	123	c ----- NOY
[1056]	124	call histwrite_phy(nid_mth,.false.,"prenoy",
	125	. itau_w,precip(1:klon,4))
[474]	126	c ----- AER
[1056]	127	call histwrite_phy(nid_mth,.false.,"preaer",
	128	. itau_w,precip(1:klon,5))
[175]	129	c --------------
	130	c ----- FLUX GLACE
[474]	131	c ----- CH4
[1056]	132	call histwrite_phy(nid_mth,.false.,"flxgl1",
	133	. itau_w,flxesp_i(1:klon,1:klev,1))
[474]	134	c ----- C2H6
[1056]	135	call histwrite_phy(nid_mth,.false.,"flxgl2",
	136	. itau_w,flxesp_i(1:klon,1:klev,2))
[474]	137	c ----- C2H2
[1056]	138	call histwrite_phy(nid_mth,.false.,"flxgl3",
	139	. itau_w,flxesp_i(1:klon,1:klev,3))
[474]	140	c --------------
	141	c ----- Source/puits GLACE
	142	c ----- CH4
[1056]	143	call histwrite_phy(nid_mth,.false.,"solch4",
	144	. itau_w,solesp(1:klon,1:klev,1))
[474]	145	c ----- C2H6
[1056]	146	call histwrite_phy(nid_mth,.false.,"solc2h6",
	147	. itau_w,solesp(1:klon,1:klev,2))
[474]	148	c ----- C2H2
[1056]	149	call histwrite_phy(nid_mth,.false.,"solc2h2",
	150	. itau_w,solesp(1:klon,1:klev,3))
[175]	151	c --------------
	152	c ----- RAYON MOYEN GOUTTE
[1056]	153	call histwrite_phy(nid_mth,.false.,"rcldbar",itau_w,rmcloud)
	154
[175]	155	endif
	156	endif
[1056]	157
[175]	158	c --------------
	159	c ----- TRACEURS CHIMIQUES
[97]	160	if (nmicro.lt.nqmax) then
[3]	161	DO iq=nmicro+1,nqmax
[1056]	162	call histwrite_phy(nid_mth,.false.,tname(iq),
	163	. itau_w,tr_seri(1:klon,1:klev,iq))
[3]	164	ENDDO
	165	c Condensation:
	166	c DO iq=nmicro+1,nqmax
[1056]	167	c call histwrite_phy(nid_mth,.false.,"c_"//tname(iq),
	168	c . itau_w,d_tr_mph(1:klon,1:klev,iq))
[3]	169	c ENDDO
	170	endif
	171	endif
[1056]	172
[3]	173	ENDIF !lev_histmth.GE.2
[1056]	174
[3]	175	c-------------------------------------------------------
	176	IF(lev_histmth.GE.3) THEN
[1056]	177
[3]	178	cccccccccccccccccc Radiative transfer
[1056]	179
[3]	180	c 2D
[1056]	181
	182	call histwrite_phy(nid_mth,.false.,"topl",itau_w,toplw)
	183	call histwrite_phy(nid_mth,.false.,"sols",itau_w,solsw)
	184	call histwrite_phy(nid_mth,.false.,"soll",itau_w,sollw)
	185
[3]	186	c 3D
[1056]	187
	188	call histwrite_phy(nid_mth,.false.,"SWnet",
	189	. itau_w,swnet(1:klon,1:klev))
[1356]	190	c call histwrite_phy(nid_mth,.false.,"SWup",
	191	c . itau_w,swup(1:klon,1:klev))
	192	c call histwrite_phy(nid_mth,.false.,"SWdn",
	193	c . itau_w,swdn(1:klon,1:klev))
[1056]	194	call histwrite_phy(nid_mth,.false.,"LWnet",
	195	. itau_w,lwnet(1:klon,1:klev))
[1356]	196	c call histwrite_phy(nid_mth,.false.,"LWup",
	197	c . itau_w,lwup(1:klon,1:klev))
	198	c call histwrite_phy(nid_mth,.false.,"LWdn",
	199	c . itau_w,lwdn(1:klon,1:klev))
	200	call histwrite_phy(nid_mth,.false.,"fluxvdf",itau_w,fluxt)
	201	call histwrite_phy(nid_mth,.false.,"fluxdyn",itau_w,flux_dyn)
	202	call histwrite_phy(nid_mth,.false.,"fluxajs",itau_w,flux_ajs)
	203	c call histwrite_phy(nid_mth,.false.,"fluxec",itau_w,flux_ec)
[1056]	204
[175]	205	c --------------
	206	c ----- OPACITE BRUME
[106]	207	do k=7,NSPECV,10
[97]	208	do i=1,klon
	209	do l=1,klev
[106]	210	t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
[97]	211	enddo
	212	enddo
[1056]	213	write(str2,'(i2.2)') k
	214	call histwrite_phy(nid_mth,.false.,"thv"//str2,itau_w,t_tauhvd)
[106]	215	enddo ! fin boucle NSPECV
[97]	216
[175]	217	do k=8,NSPECI,10
	218	do i=1,klon
	219	do l=1,klev
	220	t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
	221	enddo
	222	enddo
[1056]	223	write(str2,'(i2.2)') k
	224	call histwrite_phy(nid_mth,.false.,"thi"//str2,itau_w,t_tauhvd)
[175]	225	enddo ! fin boucle NSPECI
	226	c --------------
	227	c ----- EXTINCTION BRUME
[106]	228	do k=7,NSPECV,10
[97]	229	do i=1,klon
	230	do l=1,klev
[175]	231	if(l.ne.klev)
	232	s t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
	233	s -TAUHVD(i,klev-l+1-1,k)
[97]	234	if(l.eq.klev)
[175]	235	s t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
[97]	236
	237	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	238	enddo
	239	enddo
[1056]	240	write(str2,'(i2.2)') k
	241	call histwrite_phy(nid_mth,.false.,"khv"//str2,itau_w,t_khvd)
[106]	242	enddo ! fin boucle NSPECV
[97]	243
[175]	244	do k=8,NSPECI,10
[106]	245	do i=1,klon
	246	do l=1,klev
[175]	247	if(l.ne.klev)
	248	s t_khvd(i,l)=TAUHID(i,klev-l+1,k)
	249	s -TAUHID(i,klev-l+1-1,k)
	250	if(l.eq.klev)
	251	s t_khvd(i,l)=TAUHID(i,klev-l+1,k)
	252
	253	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
[106]	254	enddo
	255	enddo
[1056]	256	write(str2,'(i2.2)') k
	257	call histwrite_phy(nid_mth,.false.,"khi"//str2,itau_w,t_khvd)
[175]	258	enddo ! fin boucle NSPECI
	259	c --------------
	260	c ----- OPACITE GAZ
[106]	261	do k=7,NSPECV,10
	262	do i=1,klon
	263	do l=1,klev
[175]	264	t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
[106]	265	enddo
	266	enddo
[1056]	267	write(str2,'(i2.2)') k
	268	call histwrite_phy(nid_mth,.false.,"tgv"//str2,itau_w,t_tauhvd)
[106]	269	enddo ! fin boucle NSPECV
	270
	271	do k=8,NSPECI,10
	272	do i=1,klon
	273	do l=1,klev
[175]	274	t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
[106]	275	enddo
	276	enddo
[1056]	277	write(str2,'(i2.2)') k
	278	call histwrite_phy(nid_mth,.false.,"tgi"//str2,itau_w,t_tauhvd)
[106]	279	enddo ! fin boucle NSPECI
[175]	280	c --------------
	281	c ----- EXTINCTION GAZ
	282	do k=7,NSPECV,10
[106]	283	do i=1,klon
	284	do l=1,klev
[175]	285	if(l.ne.klev)
	286	s t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
	287	s -TAUGVD(i,klev-l+1-1,k)
[106]	288	if(l.eq.klev)
[175]	289	s t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
[106]	290
	291	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	292	enddo
	293	enddo
[1056]	294	write(str2,'(i2.2)') k
	295	call histwrite_phy(nid_mth,.false.,"kgv"//str2,itau_w,t_khvd)
[175]	296	enddo ! fin boucle NSPECV
[106]	297
	298	do k=8,NSPECI,10
	299	do i=1,klon
	300	do l=1,klev
[175]	301	if(l.ne.klev)
	302	s t_khvd(i,l)=TAUGID(i,klev-l+1,k)
	303	s -TAUGID(i,klev-l+1-1,k)
[106]	304
	305	if(l.eq.klev)
[175]	306	s t_khvd(i,l)=TAUGID(i,klev-l+1,k)
[106]	307
	308	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	309	enddo
	310	enddo
[1056]	311	write(str2,'(i2.2)') k
	312	call histwrite_phy(nid_mth,.false.,"kgi"//str2,itau_w,t_khvd)
[106]	313	enddo ! fin boucle NSPECI
	314
[175]	315	c --------------
	316	if (clouds.eq.1) then
	317	c --------------
[1056]	318	c ----- OPACITE NUAGES (ATTENTION PROXY)
	319	call histwrite_phy(nid_mth,.false.,"tcld",itau_w,occcld)
	320	c --------------
[175]	321	c ----- EXTINCTION NUAGES (ATTENTION PROXY)
	322	do i=1,klon
	323	t_kcld(i,klev)=occcld(i,klev)
	324	. /(zzlev(i,klev+1)-zzlev(i,klev))
	325	do j=klev-1,1,-1
	326	t_kcld(i,j)=(occcld(i,j)-occcld(i,j+1))
	327	. /(zzlev(i,j+1)-zzlev(i,j))
	328	enddo
	329	enddo
[1056]	330	call histwrite_phy(nid_mth,.false.,"kcld",itau_w,t_kcld)
[175]	331	c --------------
	332	c ----- OCCURENCE NUAGES
	333	do k=1,12
[1056]	334	write(str2,'(i2.2)') k
	335	call histwrite_phy(nid_mth,.false.,"occcld"//str2,
	336	. itau_w,occcld_m(1:klon,1:klev,k))
[175]	337	enddo
[1056]	338	c --------------
[175]	339	endif
[1056]	340	c --------------
	341
[3]	342	ENDIF !lev_histmth.GE.3
[1056]	343
[3]	344	c-------------------------------------------------------
	345	IF(lev_histmth.GE.4) THEN
[1056]	346
	347	call histwrite_phy(nid_mth,.false.,"dtdyn",itau_w,d_t_dyn)
	348	call histwrite_phy(nid_mth,.false.,"dtphy",itau_w,d_t)
[3]	349	c K/s
[1056]	350	call histwrite_phy(nid_mth,.false.,"dtvdf",itau_w,d_t_vdf)
[3]	351	c K/s
[1056]	352	call histwrite_phy(nid_mth,.false.,"dtajs",itau_w,d_t_ajs)
[3]	353	c K/s
[1056]	354	call histwrite_phy(nid_mth,.false.,"dtswr",itau_w,heat)
	355	c K/s
	356	call histwrite_phy(nid_mth,.false.,"dtlwr",itau_w,-1.*cool)
[3]	357	c K/s
[1056]	358	c call histwrite_phy(nid_mth,.false.,"dtec",itau_w,d_t_ec)
	359	c call histwrite_phy(nid_mth,.false.,"dvvdf",itau_w,d_v_vdf)
	360
[3]	361	ENDIF !lev_histmth.GE.4
	362	c
	363	c-------------------------------------------------------
	364	IF(lev_histmth.GE.5) THEN
[1056]	365
	366	c call histwrite_phy(nid_mth,.false.,"taux",itau_w,fluxu)
	367	c call histwrite_phy(nid_mth,.false.,"tauy",itau_w,fluxv)
	368	c call histwrite_phy(nid_mth,.false.,"cdrm",itau_w,cdragm)
	369	c call histwrite_phy(nid_mth,.false.,"cdrh",itau_w,cdragh)
	370
[3]	371	ENDIF !lev_histmth.GE.5
	372	c-------------------------------------------------------
[1056]	373
[3]	374	if (ok_sync) then
	375	call histsync(nid_mth)
	376	endif
	377
	378	ENDIF

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

Download in other formats: