Context Navigation

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

Last change on this file since 1243 was 1056, checked in by slebonnois, 11 years ago
SL: Titan runs ! see DOC/chantiers/commit_importants.log
File size: 11.5 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))
	190	call histwrite_phy(nid_mth,.false.,"LWnet",
	191	. itau_w,lwnet(1:klon,1:klev))
	192
[175]	193	c --------------
	194	c ----- OPACITE BRUME
[106]	195	do k=7,NSPECV,10
[97]	196	do i=1,klon
	197	do l=1,klev
[106]	198	t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
[97]	199	enddo
	200	enddo
[1056]	201	write(str2,'(i2.2)') k
	202	call histwrite_phy(nid_mth,.false.,"thv"//str2,itau_w,t_tauhvd)
[106]	203	enddo ! fin boucle NSPECV
[97]	204
[175]	205	do k=8,NSPECI,10
	206	do i=1,klon
	207	do l=1,klev
	208	t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
	209	enddo
	210	enddo
[1056]	211	write(str2,'(i2.2)') k
	212	call histwrite_phy(nid_mth,.false.,"thi"//str2,itau_w,t_tauhvd)
[175]	213	enddo ! fin boucle NSPECI
	214	c --------------
	215	c ----- EXTINCTION BRUME
[106]	216	do k=7,NSPECV,10
[97]	217	do i=1,klon
	218	do l=1,klev
[175]	219	if(l.ne.klev)
	220	s t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
	221	s -TAUHVD(i,klev-l+1-1,k)
[97]	222	if(l.eq.klev)
[175]	223	s t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
[97]	224
	225	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	226	enddo
	227	enddo
[1056]	228	write(str2,'(i2.2)') k
	229	call histwrite_phy(nid_mth,.false.,"khv"//str2,itau_w,t_khvd)
[106]	230	enddo ! fin boucle NSPECV
[97]	231
[175]	232	do k=8,NSPECI,10
[106]	233	do i=1,klon
	234	do l=1,klev
[175]	235	if(l.ne.klev)
	236	s t_khvd(i,l)=TAUHID(i,klev-l+1,k)
	237	s -TAUHID(i,klev-l+1-1,k)
	238	if(l.eq.klev)
	239	s t_khvd(i,l)=TAUHID(i,klev-l+1,k)
	240
	241	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
[106]	242	enddo
	243	enddo
[1056]	244	write(str2,'(i2.2)') k
	245	call histwrite_phy(nid_mth,.false.,"khi"//str2,itau_w,t_khvd)
[175]	246	enddo ! fin boucle NSPECI
	247	c --------------
	248	c ----- OPACITE GAZ
[106]	249	do k=7,NSPECV,10
	250	do i=1,klon
	251	do l=1,klev
[175]	252	t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
[106]	253	enddo
	254	enddo
[1056]	255	write(str2,'(i2.2)') k
	256	call histwrite_phy(nid_mth,.false.,"tgv"//str2,itau_w,t_tauhvd)
[106]	257	enddo ! fin boucle NSPECV
	258
	259	do k=8,NSPECI,10
	260	do i=1,klon
	261	do l=1,klev
[175]	262	t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
[106]	263	enddo
	264	enddo
[1056]	265	write(str2,'(i2.2)') k
	266	call histwrite_phy(nid_mth,.false.,"tgi"//str2,itau_w,t_tauhvd)
[106]	267	enddo ! fin boucle NSPECI
[175]	268	c --------------
	269	c ----- EXTINCTION GAZ
	270	do k=7,NSPECV,10
[106]	271	do i=1,klon
	272	do l=1,klev
[175]	273	if(l.ne.klev)
	274	s t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
	275	s -TAUGVD(i,klev-l+1-1,k)
[106]	276	if(l.eq.klev)
[175]	277	s t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
[106]	278
	279	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	280	enddo
	281	enddo
[1056]	282	write(str2,'(i2.2)') k
	283	call histwrite_phy(nid_mth,.false.,"kgv"//str2,itau_w,t_khvd)
[175]	284	enddo ! fin boucle NSPECV
[106]	285
	286	do k=8,NSPECI,10
	287	do i=1,klon
	288	do l=1,klev
[175]	289	if(l.ne.klev)
	290	s t_khvd(i,l)=TAUGID(i,klev-l+1,k)
	291	s -TAUGID(i,klev-l+1-1,k)
[106]	292
	293	if(l.eq.klev)
[175]	294	s t_khvd(i,l)=TAUGID(i,klev-l+1,k)
[106]	295
	296	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	297	enddo
	298	enddo
[1056]	299	write(str2,'(i2.2)') k
	300	call histwrite_phy(nid_mth,.false.,"kgi"//str2,itau_w,t_khvd)
[106]	301	enddo ! fin boucle NSPECI
	302
[175]	303	c --------------
	304	if (clouds.eq.1) then
	305	c --------------
[1056]	306	c ----- OPACITE NUAGES (ATTENTION PROXY)
	307	call histwrite_phy(nid_mth,.false.,"tcld",itau_w,occcld)
	308	c --------------
[175]	309	c ----- EXTINCTION NUAGES (ATTENTION PROXY)
	310	do i=1,klon
	311	t_kcld(i,klev)=occcld(i,klev)
	312	. /(zzlev(i,klev+1)-zzlev(i,klev))
	313	do j=klev-1,1,-1
	314	t_kcld(i,j)=(occcld(i,j)-occcld(i,j+1))
	315	. /(zzlev(i,j+1)-zzlev(i,j))
	316	enddo
	317	enddo
[1056]	318	call histwrite_phy(nid_mth,.false.,"kcld",itau_w,t_kcld)
[175]	319	c --------------
	320	c ----- OCCURENCE NUAGES
	321	do k=1,12
[1056]	322	write(str2,'(i2.2)') k
	323	call histwrite_phy(nid_mth,.false.,"occcld"//str2,
	324	. itau_w,occcld_m(1:klon,1:klev,k))
[175]	325	enddo
[1056]	326	c --------------
[175]	327	endif
[1056]	328	c --------------
	329
[3]	330	ENDIF !lev_histmth.GE.3
[1056]	331
[3]	332	c-------------------------------------------------------
	333	IF(lev_histmth.GE.4) THEN
[1056]	334
	335	call histwrite_phy(nid_mth,.false.,"dtdyn",itau_w,d_t_dyn)
	336	call histwrite_phy(nid_mth,.false.,"dtphy",itau_w,d_t)
[3]	337	c K/s
[1056]	338	call histwrite_phy(nid_mth,.false.,"dtvdf",itau_w,d_t_vdf)
[3]	339	c K/s
[1056]	340	call histwrite_phy(nid_mth,.false.,"dtajs",itau_w,d_t_ajs)
[3]	341	c K/s
[1056]	342	call histwrite_phy(nid_mth,.false.,"dtswr",itau_w,heat)
	343	c K/s
	344	call histwrite_phy(nid_mth,.false.,"dtlwr",itau_w,-1.*cool)
[3]	345	c K/s
[1056]	346	c call histwrite_phy(nid_mth,.false.,"dtec",itau_w,d_t_ec)
	347	c call histwrite_phy(nid_mth,.false.,"dvvdf",itau_w,d_v_vdf)
	348
[3]	349	ENDIF !lev_histmth.GE.4
	350	c
	351	c-------------------------------------------------------
	352	IF(lev_histmth.GE.5) THEN
[1056]	353
	354	c call histwrite_phy(nid_mth,.false.,"taux",itau_w,fluxu)
	355	c call histwrite_phy(nid_mth,.false.,"tauy",itau_w,fluxv)
	356	c call histwrite_phy(nid_mth,.false.,"cdrm",itau_w,cdragm)
	357	c call histwrite_phy(nid_mth,.false.,"cdrh",itau_w,cdragh)
	358
[3]	359	ENDIF !lev_histmth.GE.5
	360	c-------------------------------------------------------
[1056]	361
[3]	362	if (ok_sync) then
	363	call histsync(nid_mth)
	364	endif
	365
	366	ENDIF

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

Download in other formats: