Context Navigation

source: trunk/libf/phytitan/write_histday.h @ 124

Last change on this file since 124 was 110, checked in by slebonnois, 14 years ago
SL: corrections de bugs suite a compilations venus et titan de la version 109.
File size: 11.8 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
	5	c
	6	ndex2d = 0
	7	ndex3d = 0
	8	zx_tmp_2d = 0.
	9	zx_tmp_3d = 0.
	10	zx_tmp_fi2d=0.
	11	zx_tmp_fi3d=0.
	12	c
	13	zsto = dtime
	14	zout = dtime * FLOAT(ecrit_day)
	15	itau_w = itau_phy + itap
	16
	17	c
	18	c-------------------------------------------------------
	19	IF(lev_histday.GE.1) THEN
	20	c
	21	ccccccccccccc 2D fields, invariables
	22	c
	23	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
[97]	24	CALL histwrite(nid_day,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	25	C
	26	CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d)
[97]	27	CALL histwrite(nid_day,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	28	c
	29	ccccccc axe Ls
	30	do j=1,jjmp1
	31	do i=1,iim
[97]	32	zx_tmp_2d(i,j)=zls*180./RPI ! zls est en radians !!
[3]	33	enddo
	34	enddo
[97]	35	CALL histwrite(nid_day,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	36	c
	37	ccccccccccccc 2D fields, variables
	38	c
	39	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
[97]	40	CALL histwrite(nid_day,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	41	c
	42	DO i = 1, klon
	43	zx_tmp_fi2d(i) = paprs(i,1)
	44	ENDDO
	45	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
[97]	46	CALL histwrite(nid_day,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	47	c
	48	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
[97]	49	c CALL histwrite(nid_day,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	50	c
	51	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
[97]	52	c CALL histwrite(nid_day,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	53	c
	54	ENDIF !lev_histday.GE.1
	55	c
	56	c-------------------------------------------------------
	57	IF(lev_histday.GE.2) THEN
	58	c
	59	ccccccccccccc 3D fields, basics
	60	c
	61	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
[97]	62	CALL histwrite(nid_day,"temp",itau_w,zx_tmp_3d,
[3]	63	. iimjjmp1klev,ndex3d)
	64	c
	65	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
[97]	66	CALL histwrite(nid_day,"pres",itau_w,zx_tmp_3d,
[3]	67	. iimjjmp1klev,ndex3d)
	68	c
	69	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
[97]	70	CALL histwrite(nid_day,"geop",itau_w,zx_tmp_3d,
[3]	71	. iimjjmp1klev,ndex3d)
	72	c
	73	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
[97]	74	CALL histwrite(nid_day,"vitu",itau_w,zx_tmp_3d,
[3]	75	. iimjjmp1klev,ndex3d)
	76	c
	77	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
[97]	78	CALL histwrite(nid_day,"vitv",itau_w,zx_tmp_3d,
[3]	79	. iimjjmp1klev,ndex3d)
	80	c
	81	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
[97]	82	CALL histwrite(nid_day,"vitw",itau_w,zx_tmp_3d,
[3]	83	. iimjjmp1klev,ndex3d)
	84	c
	85	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
[97]	86	CALL histwrite(nid_day,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	87	c
	88	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
[97]	89	CALL histwrite(nid_day,"dudyn",itau_w,zx_tmp_3d,
[3]	90	. iimjjmp1klev,ndex3d)
	91	c
	92	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
[97]	93	CALL histwrite(nid_day,"duvdf",itau_w,zx_tmp_3d,
[3]	94	. iimjjmp1klev,ndex3d)
	95	c
[106]	96	ENDIF !lev_histday.GE.2
	97	c
	98	c-------------------------------------------------------
	99	IF(lev_histday.GE.3) THEN
	100	c
	101	cccccccccccccccccc Tracers
	102	c
[3]	103	if (iflag_trac.eq.1) THEN
	104	if (microfi.eq.1) then
	105	DO iq=1,nmicro
	106	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d)
[110]	107	CALL histwrite(nid_day,tname(iq),itau_w,zx_tmp_3d,
[3]	108	. iimjjmp1klev,ndex3d)
	109	ENDDO
	110	endif
	111	if (nmicro.lt.nqmax) then
	112	DO iq=nmicro+1,nqmax
	113	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
[110]	114	CALL histwrite(nid_day,tname(iq),itau_w,zx_tmp_3d,
[3]	115	. iimjjmp1klev,ndex3d)
	116	ENDDO
	117	endif
	118	endif
	119	c
	120	cccccccccccccccccc Radiative transfer
	121	c
	122	c 2D
	123	c
	124	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
[97]	125	CALL histwrite(nid_day,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	126	c
	127	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
[97]	128	CALL histwrite(nid_day,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	129	c
	130	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
[97]	131	CALL histwrite(nid_day,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	132	c
	133	c 3D
	134	c
	135	zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
	136	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	137	CALL histwrite(nid_day,"SWnet",itau_w,zx_tmp_3d,
[3]	138	. iimjjmp1klev,ndex3d)
	139	c
	140	zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
	141	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	142	CALL histwrite(nid_day,"LWnet",itau_w,zx_tmp_3d,
[3]	143	. iimjjmp1klev,ndex3d)
	144	c
[106]	145	c 3D adding Tau and k (31/08/10)
	146	c
	147	do k=7,NSPECV,10
	148	do i=1,klon
	149	do l=1,klev
	150	t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
	151	enddo
	152	enddo
	153	write(str1,'(i2.2)') k
	154	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
	155	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[110]	156	CALL histwrite(nid_day,"thv"//str1,itau_w,zx_tmp_3d,
[106]	157	. iimjjmp1klev,ndex3d)
	158	enddo ! fin boucle NSPECV
	159
	160	do k=7,NSPECV,10
	161	do i=1,klon
	162	do l=1,klev
	163	if(l.ne.klev)
	164	s t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
	165	s -TAUHVD(i,klev-l+1-1,k)
	166
	167	if(l.eq.klev)
	168	s t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
	169
	170	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	171	enddo
	172	enddo
	173	write(str1,'(i2.2)') k
	174	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
	175	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[110]	176	CALL histwrite(nid_day,"khv"//str1,itau_w,zx_tmp_3d,
[106]	177	. iimjjmp1klev,ndex3d)
	178	enddo ! fin boucle NSPECV
	179
	180	do k=7,NSPECV,10
	181	do i=1,klon
	182	do l=1,klev
	183	t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
	184	enddo
	185	enddo
	186	write(str1,'(i2.2)') k
	187	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
	188	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[110]	189	CALL histwrite(nid_day,"tgv"//str1,itau_w,zx_tmp_3d,
[106]	190	. iimjjmp1klev,ndex3d)
	191	enddo ! fin boucle NSPECV
	192
	193	do k=7,NSPECV,10
	194	do i=1,klon
	195	do l=1,klev
	196	if(l.ne.klev)
	197	s t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
	198	s -TAUGVD(i,klev-l+1-1,k)
	199
	200	if(l.eq.klev)
	201	s t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
	202
	203	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	204	enddo
	205	enddo
	206	write(str1,'(i2.2)') k
	207	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
	208	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[110]	209	CALL histwrite(nid_day,"kgv"//str1,itau_w,zx_tmp_3d,
[106]	210	. iimjjmp1klev,ndex3d)
	211	enddo ! fin boucle NSPECV
	212
	213	do k=8,NSPECI,10
	214	do i=1,klon
	215	do l=1,klev
	216	t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
	217	enddo
	218	enddo
	219	write(str1,'(i2.2)') k
	220	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
	221	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[110]	222	CALL histwrite(nid_day,"thi"//str1,itau_w,zx_tmp_3d,
[106]	223	. iimjjmp1klev,ndex3d)
	224	enddo ! fin boucle NSPECI
	225
	226	do k=8,NSPECI,10
	227	do i=1,klon
	228	do l=1,klev
	229	if(l.ne.klev)
	230	s t_khvd(i,l)=TAUHID(i,klev-l+1,k)
	231	s -TAUHID(i,klev-l+1-1,k)
	232
	233	if(l.eq.klev)
	234	s t_khvd(i,l)=TAUHID(i,klev-l+1,k)
	235
	236	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	237	enddo
	238	enddo
	239	write(str1,'(i2.2)') k
	240	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
	241	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[110]	242	CALL histwrite(nid_day,"khi"//str1,itau_w,zx_tmp_3d,
[106]	243	. iimjjmp1klev,ndex3d)
	244	enddo ! fin boucle NSPECI
	245
	246	do k=8,NSPECI,10
	247	do i=1,klon
	248	do l=1,klev
	249	t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
	250	enddo
	251	enddo
	252	write(str1,'(i2.2)') k
	253	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
	254	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[110]	255	CALL histwrite(nid_day,"tgi"//str1,itau_w,zx_tmp_3d,
[106]	256	. iimjjmp1klev,ndex3d)
	257	enddo ! fin boucle NSPECI
	258
	259	do k=8,NSPECI,10
	260	do i=1,klon
	261	do l=1,klev
	262	if(l.ne.klev)
	263	s t_khvd(i,l)=TAUGID(i,klev-l+1,k)
	264	s -TAUGID(i,klev-l+1-1,k)
	265
	266	if(l.eq.klev)
	267	s t_khvd(i,l)=TAUGID(i,klev-l+1,k)
	268
	269	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	270	enddo
	271	enddo
	272	write(str1,'(i2.2)') k
	273	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
	274	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[110]	275	CALL histwrite(nid_day,"kgi"//str1,itau_w,zx_tmp_3d,
[106]	276	. iimjjmp1klev,ndex3d)
	277	enddo ! fin boucle NSPECI
	278
[3]	279	ENDIF !lev_histday.GE.3
	280	c
	281	c-------------------------------------------------------
	282	IF(lev_histday.GE.4) THEN
	283	c
	284	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
[97]	285	CALL histwrite(nid_day,"dtdyn",itau_w,zx_tmp_3d,
[3]	286	. iimjjmp1klev,ndex3d)
	287	c
	288	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
[97]	289	CALL histwrite(nid_day,"dtphy",itau_w,zx_tmp_3d,
[3]	290	. iimjjmp1klev,ndex3d)
	291	c K/s
	292	zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
	293	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	294	CALL histwrite(nid_day,"dtvdf",itau_w,zx_tmp_3d,
[3]	295	. iimjjmp1klev,ndex3d)
	296	c
	297	c K/s
	298	zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
	299	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	300	CALL histwrite(nid_day,"dtajs",itau_w,zx_tmp_3d,
[3]	301	. iimjjmp1klev,ndex3d)
	302	c
	303	c K/s
	304	zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
	305	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	306	CALL histwrite(nid_day,"dtswr",itau_w,zx_tmp_3d,
[3]	307	. iimjjmp1klev,ndex3d)
	308	c
	309	c K/s
	310	zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
	311	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	312	CALL histwrite(nid_day,"dtlwr",itau_w,zx_tmp_3d,
[3]	313	. iimjjmp1klev,ndex3d)
	314	c K/s
[106]	315	c zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
	316	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	317	c CALL histwrite(nid_day,"dtec",itau_w,zx_tmp_3d,
	318	c . iimjjmp1klev,ndex3d)
[3]	319	c
	320	ENDIF !lev_histday.GE.4
	321	c
	322	c-------------------------------------------------------
	323	IF(lev_histday.GE.5) THEN
	324	c
	325	c
	326	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
	327	c CALL histwrite(nid_day,"taux_",itau_w,
[97]	328	c $ zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	329	c
	330	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
	331	c CALL histwrite(nid_day,"tauy_",itau_w,
[97]	332	c $ zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	333	c
	334	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
[97]	335	c CALL histwrite(nid_day,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	336	c
	337	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
[97]	338	c CALL histwrite(nid_day,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	339	c
	340	ENDIF !lev_histday.GE.5
	341	c-------------------------------------------------------
	342	c
	343	if (ok_sync) then
	344	call histsync(nid_day)
	345	endif
	346
	347	ENDIF

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

Download in other formats: