Context Navigation

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

Last change on this file since 404 was 306, checked in by slebonnois, 14 years ago

SLebonnois: correction de bugs dans la physique Titan:

effg.F : Z doit etre en km, donc conversion
optc*_1pt_2.F : On utilise cfffv11 et plus optfrac Du coup, les fichiers input testag* ne sont plus necessaires.
phytrac.F : passage de la tendance aerosols en intensif dans tous les cas

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

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

Download in other formats: