Context Navigation

source: trunk/libf/phytitan/write_histmth.h @ 107

Last change on this file since 107 was 106, checked in by slebonnois, 14 years ago
SL : mise a jour de phytitan pour etre conforme aux sources actuelles utilisees sur gnome.
File size: 12.8 KB

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

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

Download in other formats: