Context Navigation

source: trunk/LMDZ.TITAN/libf/phytitan/write_histday.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.1 KB

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

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

Download in other formats: