Context Navigation

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

Last change on this file since 125 was 119, checked in by slebonnois, 14 years ago
Sebastien Lebonnois: apres validation des versions Venus et Titan, correction d'un certain nombre de bugs.
File size: 12.6 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)
[110]	51	c CALL histwrite(nid_mth,"cdragh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[106]	52	c
	53	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
[110]	54	c CALL histwrite(nid_mth,"cdragm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[106]	55	c
[3]	56	ENDIF !lev_histmth.GE.1
	57	c
	58	c-------------------------------------------------------
	59	IF(lev_histmth.GE.2) THEN
	60	c
	61	ccccccccccccc 3D fields, basics
	62	c
	63	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
[97]	64	CALL histwrite(nid_mth,"temp",itau_w,zx_tmp_3d,
[3]	65	. iimjjmp1klev,ndex3d)
	66	c
	67	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
[97]	68	CALL histwrite(nid_mth,"pres",itau_w,zx_tmp_3d,
[3]	69	. iimjjmp1klev,ndex3d)
	70	c
	71	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
[97]	72	CALL histwrite(nid_mth,"geop",itau_w,zx_tmp_3d,
[3]	73	. iimjjmp1klev,ndex3d)
	74	c
	75	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
[97]	76	CALL histwrite(nid_mth,"vitu",itau_w,zx_tmp_3d,
[3]	77	. iimjjmp1klev,ndex3d)
	78	c
	79	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
[97]	80	CALL histwrite(nid_mth,"vitv",itau_w,zx_tmp_3d,
[3]	81	. iimjjmp1klev,ndex3d)
	82	c
	83	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
[97]	84	CALL histwrite(nid_mth,"vitw",itau_w,zx_tmp_3d,
[3]	85	. iimjjmp1klev,ndex3d)
	86	c
[106]	87	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ycoefh, zx_tmp_3d)
[110]	88	c CALL histwrite(nid_mth,"Kz",itau_w,zx_tmp_3d,
[106]	89	c . iimjjmp1klev,ndex3d)
	90	c
[3]	91	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
[97]	92	CALL histwrite(nid_mth,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	93	c
	94	if (iflag_trac.eq.1) THEN
[105]	95	c if (microfi.eq.1) then
[97]	96	c DO iq=1,nmicro
	97	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d)
	98	c CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
	99	c . iimjjmp1klev,ndex3d)
	100	c ENDDO
	101	c endif
	102	if (nmicro.lt.nqmax) then
[3]	103	DO iq=nmicro+1,nqmax
	104	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
[97]	105	CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
[3]	106	. iimjjmp1klev,ndex3d)
	107	ENDDO
	108	c Condensation:
	109	c DO iq=nmicro+1,nqmax
	110	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_tr_mph(1,1,iq),zx_tmp_3d)
[97]	111	c CALL histwrite(nid_mth,"c_"//tname(iq),itau_w,zx_tmp_3d,
[3]	112	c . iimjjmp1klev,ndex3d)
	113	c ENDDO
	114	endif
	115	endif
	116	c
	117	ENDIF !lev_histmth.GE.2
	118	c
	119	c-------------------------------------------------------
	120	IF(lev_histmth.GE.3) THEN
	121	c
	122	cccccccccccccccccc Radiative transfer
	123	c
	124	c 2D
	125	c
	126	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
[97]	127	CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	128	c
	129	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
[97]	130	CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	131	c
	132	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
[97]	133	CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	134	c
	135	c 3D
	136	c
	137	zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
	138	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	139	CALL histwrite(nid_mth,"SWnet",itau_w,zx_tmp_3d,
[3]	140	. iimjjmp1klev,ndex3d)
	141	c
	142	zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
	143	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	144	CALL histwrite(nid_mth,"LWnet",itau_w,zx_tmp_3d,
[3]	145	. iimjjmp1klev,ndex3d)
	146	c
[97]	147	c 3D adding Tau and k (31/08/10)
[106]	148	c
	149	do k=7,NSPECV,10
[97]	150	do i=1,klon
	151	do l=1,klev
[106]	152	t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
[97]	153	enddo
	154	enddo
	155	write(str1,'(i2.2)') k
	156	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
	157	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[119]	158	CALL histwrite(nid_mth,"thv"//str1,itau_w,zx_tmp_3d,
[97]	159	. iimjjmp1klev,ndex3d)
[106]	160	enddo ! fin boucle NSPECV
[97]	161
[106]	162	do k=7,NSPECV,10
[97]	163	do i=1,klon
	164	do l=1,klev
	165	if(l.ne.klev)
	166	s t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
	167	s -TAUHVD(i,klev-l+1-1,k)
	168
	169	if(l.eq.klev)
	170	s t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
	171
	172	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	173	enddo
	174	enddo
	175	write(str1,'(i2.2)') k
	176	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
	177	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[119]	178	CALL histwrite(nid_mth,"khv"//str1,itau_w,zx_tmp_3d,
[97]	179	. iimjjmp1klev,ndex3d)
[106]	180	enddo ! fin boucle NSPECV
[97]	181
[106]	182	do k=7,NSPECV,10
	183	do i=1,klon
	184	do l=1,klev
	185	t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
	186	enddo
	187	enddo
	188	write(str1,'(i2.2)') k
	189	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
	190	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[119]	191	CALL histwrite(nid_mth,"tgv"//str1,itau_w,zx_tmp_3d,
[106]	192	. iimjjmp1klev,ndex3d)
	193	enddo ! fin boucle NSPECV
	194
	195	do k=7,NSPECV,10
	196	do i=1,klon
	197	do l=1,klev
	198	if(l.ne.klev)
	199	s t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
	200	s -TAUGVD(i,klev-l+1-1,k)
	201
	202	if(l.eq.klev)
	203	s t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
	204
	205	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	206	enddo
	207	enddo
	208	write(str1,'(i2.2)') k
	209	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
	210	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[119]	211	CALL histwrite(nid_mth,"kgv"//str1,itau_w,zx_tmp_3d,
[106]	212	. iimjjmp1klev,ndex3d)
	213	enddo ! fin boucle NSPECV
	214
	215	do k=8,NSPECI,10
	216	do i=1,klon
	217	do l=1,klev
	218	t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
	219	enddo
	220	enddo
	221	write(str1,'(i2.2)') k
	222	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
	223	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[119]	224	CALL histwrite(nid_mth,"thi"//str1,itau_w,zx_tmp_3d,
[106]	225	. iimjjmp1klev,ndex3d)
	226	enddo ! fin boucle NSPECI
	227
	228	do k=8,NSPECI,10
	229	do i=1,klon
	230	do l=1,klev
	231	if(l.ne.klev)
	232	s t_khvd(i,l)=TAUHID(i,klev-l+1,k)
	233	s -TAUHID(i,klev-l+1-1,k)
	234
	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))
	239	enddo
	240	enddo
	241	write(str1,'(i2.2)') k
	242	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
	243	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[119]	244	CALL histwrite(nid_mth,"khi"//str1,itau_w,zx_tmp_3d,
[106]	245	. iimjjmp1klev,ndex3d)
	246	enddo ! fin boucle NSPECI
	247
	248	do k=8,NSPECI,10
	249	do i=1,klon
	250	do l=1,klev
	251	t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
	252	enddo
	253	enddo
	254	write(str1,'(i2.2)') k
	255	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
	256	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[119]	257	CALL histwrite(nid_mth,"tgi"//str1,itau_w,zx_tmp_3d,
[106]	258	. iimjjmp1klev,ndex3d)
	259	enddo ! fin boucle NSPECI
	260
	261	do k=8,NSPECI,10
	262	do i=1,klon
	263	do l=1,klev
	264	if(l.ne.klev)
	265	s t_khvd(i,l)=TAUGID(i,klev-l+1,k)
	266	s -TAUGID(i,klev-l+1-1,k)
	267
	268	if(l.eq.klev)
	269	s t_khvd(i,l)=TAUGID(i,klev-l+1,k)
	270
	271	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	272	enddo
	273	enddo
	274	write(str1,'(i2.2)') k
	275	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
	276	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[119]	277	CALL histwrite(nid_mth,"kgi"//str1,itau_w,zx_tmp_3d,
[106]	278	. iimjjmp1klev,ndex3d)
	279	enddo ! fin boucle NSPECI
	280
[3]	281	ENDIF !lev_histmth.GE.3
	282	c
	283	c-------------------------------------------------------
	284	IF(lev_histmth.GE.4) THEN
	285	c
	286	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
[97]	287	CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
[3]	288	. iimjjmp1klev,ndex3d)
	289	c
	290	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
[97]	291	CALL histwrite(nid_mth,"dtphy",itau_w,zx_tmp_3d,
[3]	292	. iimjjmp1klev,ndex3d)
	293	c K/s
	294	zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
	295	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	296	CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
[3]	297	. iimjjmp1klev,ndex3d)
	298	c
	299	c K/s
	300	zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
	301	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	302	CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
[3]	303	. iimjjmp1klev,ndex3d)
	304	c
	305	c K/s
	306	zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
	307	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	308	CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
[3]	309	. iimjjmp1klev,ndex3d)
	310	c
	311	c K/s
	312	zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
	313	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	314	CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
[3]	315	. iimjjmp1klev,ndex3d)
	316	c K/s
	317	c zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
	318	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	319	c CALL histwrite(nid_mth,"dtec",itau_w,zx_tmp_3d,
[3]	320	c . iimjjmp1klev,ndex3d)
	321	c
	322	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
[97]	323	CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d,
[3]	324	. iimjjmp1klev,ndex3d)
	325	c
	326	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
[97]	327	CALL histwrite(nid_mth,"dudyn",itau_w,zx_tmp_3d,
[3]	328	. iimjjmp1klev,ndex3d)
	329	c
	330	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
[97]	331	c CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d,
[3]	332	c . iimjjmp1klev,ndex3d)
	333	c
	334	ENDIF !lev_histmth.GE.4
	335	c
	336	c-------------------------------------------------------
	337	IF(lev_histmth.GE.5) THEN
	338	c
	339	c
	340	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
	341	c CALL histwrite(nid_mth,"taux_",itau_w,
[97]	342	c $ zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	343	c
	344	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
	345	c CALL histwrite(nid_mth,"tauy_",itau_w,
[97]	346	c $ zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	347	c
	348	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
[97]	349	c CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	350	c
	351	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
[97]	352	c CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	353	c
	354	ENDIF !lev_histmth.GE.5
	355	c-------------------------------------------------------
	356	c
	357	if (ok_sync) then
	358	call histsync(nid_mth)
	359	endif
	360
	361	ENDIF

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

Download in other formats: