Context Navigation

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

Last change on this file since 201 was 175, checked in by slebonnois, 14 years ago

S.LEBONNOIS:

Revision majeure de la physique Titan => ajout des nuages version 10 bins (Jeremie Burgalat) Cette version reste a tester mais avec clouds=0, on reste sur l'ancienne.
Quelques ajouts dans la doc.

File size: 18.2 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
[175]	94	cccccccccccccccccc Tracers
	95	c
[3]	96	if (iflag_trac.eq.1) THEN
[175]	97	if (microfi.ge.1) then
[97]	98	c DO iq=1,nmicro
	99	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d)
	100	c CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
	101	c . iimjjmp1klev,ndex3d)
	102	c ENDDO
[175]	103	c ------- NB AER TOT
	104	do i=1,klon
	105	do j=1,klev
	106	zx_tmp_fi3d(i,j)= SUM(qaer(i,j,1:nrad))
	107	enddo
	108	enddo
	109	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	110	CALL histwrite(nid_mth,"qaer",itau_w,zx_tmp_3d,
	111	. iimjjmp1klev,ndex3d)
	112	c ------- NB NOY TOT
	113	do i=1,klon
	114	do j=1,klev
	115	zx_tmp_fi3d(i,j)= SUM(qaer(i,j,nrad+1:2*nrad))
	116	enddo
	117	enddo
	118	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	119	CALL histwrite(nid_mth,"qnoy",itau_w,zx_tmp_3d,
	120	. iimjjmp1klev,ndex3d)
	121	c ------- V GLA1 TOT
	122	do i=1,klon
	123	do j=1,klev
	124	zx_tmp_fi3d(i,j)= SUM(qaer(i,j,2nrad+1:3nrad))
	125	enddo
	126	enddo
	127	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	128	CALL histwrite(nid_mth,"qgl1",itau_w,zx_tmp_3d,
	129	. iimjjmp1klev,ndex3d)
	130	c ------- V GLA2 TOT
	131	do i=1,klon
	132	do j=1,klev
	133	zx_tmp_fi3d(i,j)= SUM(qaer(i,j,3nrad+1:4nrad))
	134	enddo
	135	enddo
	136	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	137	CALL histwrite(nid_mth,"qgl2",itau_w,zx_tmp_3d,
	138	. iimjjmp1klev,ndex3d)
	139	c ------- V GLA3 TOT
	140	do i=1,klon
	141	do j=1,klev
	142	zx_tmp_fi3d(i,j)= SUM(qaer(i,j,4nrad+1:5nrad))
	143	enddo
	144	enddo
	145	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	146	CALL histwrite(nid_mth,"qgl3",itau_w,zx_tmp_3d,
	147	. iimjjmp1klev,ndex3d)
	148	c --------------
	149	c ----- SATURATION ESP NUAGES
	150	if (clouds.eq.1) then
	151
	152	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satch4,zx_tmp_3d)
	153	CALL histwrite(nid_mth,"ch4sat", itau_w, zx_tmp_3d,
	154	. iimjjmp1klev,ndex3d)
	155
	156	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h6,zx_tmp_3d)
	157	CALL histwrite(nid_mth,"c2h6sat", itau_w, zx_tmp_3d,
	158	. iimjjmp1klev,ndex3d)
	159
	160	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h2,zx_tmp_3d)
	161	CALL histwrite(nid_mth,"c2h2sat", itau_w, zx_tmp_3d,
	162	. iimjjmp1klev,ndex3d)
	163	c --------------
	164	c ----- RESERVOIR DE SURFACE
	165	CALL gr_fi_ecrit(1, klon,iim,jjmp1,reservoir,zx_tmp_2d)
	166	CALL histwrite(nid_mth,"reserv",itau_w,zx_tmp_2d,
	167	. iim*jjmp1,ndex2d)
	168	c --------------
	169	c ----- PRECIPITATIONS
	170	c ----- CH4
	171	CALL gr_fi_ecrit(1, klon,iim,jjmp1,prec(:,1),zx_tmp_2d)
	172	CALL histwrite(nid_mth,"prech4",itau_w,zx_tmp_2d,
	173	. iim*jjmp1,ndex2d)
	174	c ----- C2H6
	175	CALL gr_fi_ecrit(1, klon,iim,jjmp1,prec(:,2),zx_tmp_2d)
	176	CALL histwrite(nid_mth,"prec2h6",itau_w,zx_tmp_2d,
	177	. iim*jjmp1,ndex2d)
	178	c ----- C2H2
	179	CALL gr_fi_ecrit(1, klon,iim,jjmp1,prec(:,3),zx_tmp_2d)
	180	CALL histwrite(nid_mth,"prec2h2",itau_w,zx_tmp_2d,
	181	. iim*jjmp1,ndex2d)
	182	c
	183	c --------------
	184	c ----- FLUX GLACE
	185	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,flxesp_i(1,1,1),zx_tmp_3d)
	186	CALL histwrite(nid_mth,"flxgl1", itau_w, zx_tmp_3d,
	187	. iimjjmp1klev,ndex3d)
	188	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,flxesp_i(1,1,2),zx_tmp_3d)
	189	CALL histwrite(nid_mth,"flxgl2", itau_w, zx_tmp_3d,
	190	. iimjjmp1klev,ndex3d)
	191	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,flxesp_i(1,1,3),zx_tmp_3d)
	192	CALL histwrite(nid_mth,"flxgl3", itau_w, zx_tmp_3d,
	193	. iimjjmp1klev,ndex3d)
	194	c
	195	c --------------
	196	c ----- RAYON MOYEN GOUTTE
	197	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, rmcloud,zx_tmp_3d)
	198	CALL histwrite(nid_mth,"rcldbar", itau_w, zx_tmp_3d,
	199	. iimjjmp1klev,ndex3d)
	200	c
	201	endif
	202	endif
	203	c
	204	c --------------
	205	c ----- TRACEURS CHIMIQUES
[97]	206	if (nmicro.lt.nqmax) then
[3]	207	DO iq=nmicro+1,nqmax
	208	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
[97]	209	CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
[3]	210	. iimjjmp1klev,ndex3d)
	211	ENDDO
	212	c Condensation:
	213	c DO iq=nmicro+1,nqmax
	214	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_tr_mph(1,1,iq),zx_tmp_3d)
[97]	215	c CALL histwrite(nid_mth,"c_"//tname(iq),itau_w,zx_tmp_3d,
[3]	216	c . iimjjmp1klev,ndex3d)
	217	c ENDDO
	218	endif
	219	endif
	220	c
	221	ENDIF !lev_histmth.GE.2
	222	c
	223	c-------------------------------------------------------
	224	IF(lev_histmth.GE.3) THEN
	225	c
	226	cccccccccccccccccc Radiative transfer
	227	c
	228	c 2D
	229	c
	230	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
[97]	231	CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	232	c
	233	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
[97]	234	CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	235	c
	236	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
[97]	237	CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	238	c
	239	c 3D
	240	c
	241	zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
	242	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	243	CALL histwrite(nid_mth,"SWnet",itau_w,zx_tmp_3d,
[3]	244	. iimjjmp1klev,ndex3d)
	245	c
	246	zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
	247	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	248	CALL histwrite(nid_mth,"LWnet",itau_w,zx_tmp_3d,
[3]	249	. iimjjmp1klev,ndex3d)
	250	c
[175]	251	c --------------
	252	c ----- OPACITE BRUME
[106]	253	do k=7,NSPECV,10
[97]	254	do i=1,klon
	255	do l=1,klev
[106]	256	t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
[97]	257	enddo
	258	enddo
	259	write(str1,'(i2.2)') k
	260	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
	261	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[119]	262	CALL histwrite(nid_mth,"thv"//str1,itau_w,zx_tmp_3d,
[97]	263	. iimjjmp1klev,ndex3d)
[106]	264	enddo ! fin boucle NSPECV
[97]	265
[175]	266	do k=8,NSPECI,10
	267	do i=1,klon
	268	do l=1,klev
	269	t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
	270	enddo
	271	enddo
	272	write(str1,'(i2.2)') k
	273	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
	274	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	275	CALL histwrite(nid_mth,"thi"//str1,itau_w,zx_tmp_3d,
	276	. iimjjmp1klev,ndex3d)
	277	enddo ! fin boucle NSPECI
	278	c
	279	c --------------
	280	c ----- EXTINCTION BRUME
[106]	281	do k=7,NSPECV,10
[97]	282	do i=1,klon
	283	do l=1,klev
[175]	284	if(l.ne.klev)
	285	s t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
	286	s -TAUHVD(i,klev-l+1-1,k)
[97]	287	if(l.eq.klev)
[175]	288	s t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
[97]	289
	290	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	291	enddo
	292	enddo
	293	write(str1,'(i2.2)') k
	294	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
	295	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[119]	296	CALL histwrite(nid_mth,"khv"//str1,itau_w,zx_tmp_3d,
[97]	297	. iimjjmp1klev,ndex3d)
[106]	298	enddo ! fin boucle NSPECV
[97]	299
[175]	300	do k=8,NSPECI,10
[106]	301	do i=1,klon
	302	do l=1,klev
[175]	303	if(l.ne.klev)
	304	s t_khvd(i,l)=TAUHID(i,klev-l+1,k)
	305	s -TAUHID(i,klev-l+1-1,k)
	306	if(l.eq.klev)
	307	s t_khvd(i,l)=TAUHID(i,klev-l+1,k)
	308
	309	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
[106]	310	enddo
	311	enddo
	312	write(str1,'(i2.2)') k
[175]	313	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
[106]	314	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[175]	315	CALL histwrite(nid_mth,"khi"//str1,itau_w,zx_tmp_3d,
[106]	316	. iimjjmp1klev,ndex3d)
[175]	317	enddo ! fin boucle NSPECI
	318	c
	319	c --------------
	320	c ----- OPACITE GAZ
[106]	321	do k=7,NSPECV,10
	322	do i=1,klon
	323	do l=1,klev
[175]	324	t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
[106]	325	enddo
	326	enddo
	327	write(str1,'(i2.2)') k
[175]	328	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
[106]	329	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[175]	330	CALL histwrite(nid_mth,"tgv"//str1,itau_w,zx_tmp_3d,
[106]	331	. iimjjmp1klev,ndex3d)
	332	enddo ! fin boucle NSPECV
	333
	334	do k=8,NSPECI,10
	335	do i=1,klon
	336	do l=1,klev
[175]	337	t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
[106]	338	enddo
	339	enddo
	340	write(str1,'(i2.2)') k
	341	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
	342	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[175]	343	CALL histwrite(nid_mth,"tgi"//str1,itau_w,zx_tmp_3d,
[106]	344	. iimjjmp1klev,ndex3d)
	345	enddo ! fin boucle NSPECI
[175]	346	c
	347	c --------------
	348	c ----- EXTINCTION GAZ
	349	do k=7,NSPECV,10
[106]	350	do i=1,klon
	351	do l=1,klev
[175]	352	if(l.ne.klev)
	353	s t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
	354	s -TAUGVD(i,klev-l+1-1,k)
[106]	355	if(l.eq.klev)
[175]	356	s t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
[106]	357
	358	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	359	enddo
	360	enddo
	361	write(str1,'(i2.2)') k
	362	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
	363	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[175]	364	CALL histwrite(nid_mth,"kgv"//str1,itau_w,zx_tmp_3d,
[106]	365	. iimjjmp1klev,ndex3d)
[175]	366	enddo ! fin boucle NSPECV
[106]	367
	368	do k=8,NSPECI,10
	369	do i=1,klon
	370	do l=1,klev
[175]	371	if(l.ne.klev)
	372	s t_khvd(i,l)=TAUGID(i,klev-l+1,k)
	373	s -TAUGID(i,klev-l+1-1,k)
[106]	374
	375	if(l.eq.klev)
[175]	376	s t_khvd(i,l)=TAUGID(i,klev-l+1,k)
[106]	377
	378	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	379	enddo
	380	enddo
	381	write(str1,'(i2.2)') k
	382	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
	383	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[119]	384	CALL histwrite(nid_mth,"kgi"//str1,itau_w,zx_tmp_3d,
[106]	385	. iimjjmp1klev,ndex3d)
	386	enddo ! fin boucle NSPECI
	387
[175]	388	c --------------
	389	c ----- OPACITE NUAGES (ATTENTION PROXY)
	390	if (clouds.eq.1) then
	391	zx_tmp_fi3d(1:klon,1:klev)=occcld(1:klon,1:klev)
	392	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	393	CALL histwrite(nid_mth,"tcld",itau_w,zx_tmp_3d,
	394	. iimjjmp1klev,ndex3d)
	395	c --------------
	396	c ----- EXTINCTION NUAGES (ATTENTION PROXY)
	397	do i=1,klon
	398	t_kcld(i,klev)=occcld(i,klev)
	399	. /(zzlev(i,klev+1)-zzlev(i,klev))
	400	do j=klev-1,1,-1
	401	t_kcld(i,j)=(occcld(i,j)-occcld(i,j+1))
	402	. /(zzlev(i,j+1)-zzlev(i,j))
	403	enddo
	404	enddo
	405	zx_tmp_fi3d(1:klon,1:klev)=t_kcld(1:klon,1:klev)
	406	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	407	CALL histwrite(nid_mth,"kcld",itau_w,zx_tmp_3d,
	408	. iimjjmp1klev,ndex3d)
	409	c
	410	c --------------
	411	c ----- OCCURENCE NUAGES
	412	do k=1,12
	413	write(str1,'(i2.2)') k
	414	zx_tmp_fi3d(1:klon,1:klev)=occcld_m(1:klon,1:klev,k)
	415	CALL histwrite(nid_mth,"occcld"//str1,itau_w,zx_tmp_3d,
	416	. iimjjmp1klev,ndex3d)
	417	enddo
	418	c
	419	endif
	420	c
[3]	421	ENDIF !lev_histmth.GE.3
	422	c
	423	c-------------------------------------------------------
	424	IF(lev_histmth.GE.4) THEN
	425	c
	426	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
[97]	427	CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
[3]	428	. iimjjmp1klev,ndex3d)
	429	c
	430	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
[97]	431	CALL histwrite(nid_mth,"dtphy",itau_w,zx_tmp_3d,
[3]	432	. iimjjmp1klev,ndex3d)
	433	c K/s
	434	zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
	435	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	436	CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
[3]	437	. iimjjmp1klev,ndex3d)
	438	c
	439	c K/s
	440	zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
	441	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	442	CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
[3]	443	. iimjjmp1klev,ndex3d)
	444	c
	445	c K/s
	446	zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
	447	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	448	CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
[3]	449	. iimjjmp1klev,ndex3d)
	450	c
	451	c K/s
	452	zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
	453	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	454	CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
[3]	455	. iimjjmp1klev,ndex3d)
	456	c K/s
	457	c zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
	458	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	459	c CALL histwrite(nid_mth,"dtec",itau_w,zx_tmp_3d,
[3]	460	c . iimjjmp1klev,ndex3d)
	461	c
	462	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
[97]	463	CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d,
[3]	464	. iimjjmp1klev,ndex3d)
	465	c
	466	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
[97]	467	CALL histwrite(nid_mth,"dudyn",itau_w,zx_tmp_3d,
[3]	468	. iimjjmp1klev,ndex3d)
	469	c
	470	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
[97]	471	c CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d,
[3]	472	c . iimjjmp1klev,ndex3d)
	473	c
	474	ENDIF !lev_histmth.GE.4
	475	c
	476	c-------------------------------------------------------
	477	IF(lev_histmth.GE.5) THEN
	478	c
	479	c
	480	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
	481	c CALL histwrite(nid_mth,"taux_",itau_w,
[97]	482	c $ zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	483	c
	484	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
	485	c CALL histwrite(nid_mth,"tauy_",itau_w,
[97]	486	c $ zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	487	c
	488	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
[97]	489	c CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	490	c
	491	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
[97]	492	c CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	493	c
	494	ENDIF !lev_histmth.GE.5
	495	c-------------------------------------------------------
	496	c
	497	if (ok_sync) then
	498	call histsync(nid_mth)
	499	endif
	500
	501	ENDIF

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

Download in other formats: