Context Navigation

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

Last change on this file since 881 was 808, checked in by slebonnois, 12 years ago
SL: Many changes for VENUS (related to newstart) and TITAN (related to clouds). Please read DOC/chantiers/commit_importants.log (cf v808).
File size: 20.1 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
[808]	25	ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement...
[3]	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
[808]	31	c Correction passage de 360 à 0... Sinon probleme avec moyenne
	32	if (zls.lt.zlsm1) then
	33	zx_tmp_2d = zx_tmp_2d+360.
	34	zlsm1 = 2.*RPI
	35	else
	36	zlsm1 = zls
	37	endif
[97]	38	CALL histwrite(nid_mth,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	39	c
	40	ccccccccccccc 2D fields, variables
	41	c
	42	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
[97]	43	CALL histwrite(nid_mth,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	44	c
	45	DO i = 1, klon
	46	zx_tmp_fi2d(i) = paprs(i,1)
	47	ENDDO
	48	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
[97]	49	CALL histwrite(nid_mth,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	50	c
	51	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
[97]	52	c CALL histwrite(nid_mth,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	53	c
	54	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
[97]	55	c CALL histwrite(nid_mth,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	56	c
[106]	57	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
[110]	58	c CALL histwrite(nid_mth,"cdragh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[106]	59	c
	60	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
[110]	61	c CALL histwrite(nid_mth,"cdragm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[106]	62	c
[3]	63	ENDIF !lev_histmth.GE.1
	64	c
	65	c-------------------------------------------------------
	66	IF(lev_histmth.GE.2) THEN
	67	c
	68	ccccccccccccc 3D fields, basics
	69	c
	70	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
[97]	71	CALL histwrite(nid_mth,"temp",itau_w,zx_tmp_3d,
[3]	72	. iimjjmp1klev,ndex3d)
	73	c
	74	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
[97]	75	CALL histwrite(nid_mth,"pres",itau_w,zx_tmp_3d,
[3]	76	. iimjjmp1klev,ndex3d)
	77	c
	78	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
[97]	79	CALL histwrite(nid_mth,"geop",itau_w,zx_tmp_3d,
[3]	80	. iimjjmp1klev,ndex3d)
	81	c
	82	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
[97]	83	CALL histwrite(nid_mth,"vitu",itau_w,zx_tmp_3d,
[3]	84	. iimjjmp1klev,ndex3d)
	85	c
	86	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
[97]	87	CALL histwrite(nid_mth,"vitv",itau_w,zx_tmp_3d,
[3]	88	. iimjjmp1klev,ndex3d)
	89	c
	90	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
[97]	91	CALL histwrite(nid_mth,"vitw",itau_w,zx_tmp_3d,
[3]	92	. iimjjmp1klev,ndex3d)
	93	c
[106]	94	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ycoefh, zx_tmp_3d)
[110]	95	c CALL histwrite(nid_mth,"Kz",itau_w,zx_tmp_3d,
[106]	96	c . iimjjmp1klev,ndex3d)
	97	c
[3]	98	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
[97]	99	CALL histwrite(nid_mth,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	100	c
[175]	101	cccccccccccccccccc Tracers
	102	c
[3]	103	if (iflag_trac.eq.1) THEN
[175]	104	if (microfi.ge.1) then
[97]	105	c DO iq=1,nmicro
[474]	106	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
	107	c . qaer(1:klon,1:klev,iq), zx_tmp_3d)
[97]	108	c CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
	109	c . iimjjmp1klev,ndex3d)
	110	c ENDDO
[175]	111	c ------- NB AER TOT
	112	do i=1,klon
	113	do j=1,klev
	114	zx_tmp_fi3d(i,j)= SUM(qaer(i,j,1:nrad))
	115	enddo
	116	enddo
	117	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	118	CALL histwrite(nid_mth,"qaer",itau_w,zx_tmp_3d,
	119	. iimjjmp1klev,ndex3d)
[306]	120
	121	if (clouds.eq.1) then
[175]	122	c ------- NB NOY TOT
	123	do i=1,klon
	124	do j=1,klev
	125	zx_tmp_fi3d(i,j)= SUM(qaer(i,j,nrad+1:2*nrad))
	126	enddo
	127	enddo
	128	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	129	CALL histwrite(nid_mth,"qnoy",itau_w,zx_tmp_3d,
	130	. iimjjmp1klev,ndex3d)
	131	c ------- V GLA1 TOT
	132	do i=1,klon
	133	do j=1,klev
	134	zx_tmp_fi3d(i,j)= SUM(qaer(i,j,2nrad+1:3nrad))
	135	enddo
	136	enddo
	137	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	138	CALL histwrite(nid_mth,"qgl1",itau_w,zx_tmp_3d,
	139	. iimjjmp1klev,ndex3d)
	140	c ------- V GLA2 TOT
	141	do i=1,klon
	142	do j=1,klev
	143	zx_tmp_fi3d(i,j)= SUM(qaer(i,j,3nrad+1:4nrad))
	144	enddo
	145	enddo
	146	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	147	CALL histwrite(nid_mth,"qgl2",itau_w,zx_tmp_3d,
	148	. iimjjmp1klev,ndex3d)
	149	c ------- V GLA3 TOT
	150	do i=1,klon
	151	do j=1,klev
	152	zx_tmp_fi3d(i,j)= SUM(qaer(i,j,4nrad+1:5nrad))
	153	enddo
	154	enddo
	155	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	156	CALL histwrite(nid_mth,"qgl3",itau_w,zx_tmp_3d,
	157	. iimjjmp1klev,ndex3d)
	158	c --------------
	159	c ----- SATURATION ESP NUAGES
	160	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satch4,zx_tmp_3d)
	161	CALL histwrite(nid_mth,"ch4sat", itau_w, zx_tmp_3d,
	162	. iimjjmp1klev,ndex3d)
	163
	164	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h6,zx_tmp_3d)
	165	CALL histwrite(nid_mth,"c2h6sat", itau_w, zx_tmp_3d,
	166	. iimjjmp1klev,ndex3d)
	167
	168	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h2,zx_tmp_3d)
	169	CALL histwrite(nid_mth,"c2h2sat", itau_w, zx_tmp_3d,
	170	. iimjjmp1klev,ndex3d)
	171	c --------------
	172	c ----- RESERVOIR DE SURFACE
	173	CALL gr_fi_ecrit(1, klon,iim,jjmp1,reservoir,zx_tmp_2d)
	174	CALL histwrite(nid_mth,"reserv",itau_w,zx_tmp_2d,
	175	. iim*jjmp1,ndex2d)
	176	c --------------
[474]	177	c ----- ECHANGE GAZ SURF/ATM (evaporation)
	178	CALL gr_fi_ecrit(1, klon,iim,jjmp1,evapch4,zx_tmp_2d)
	179	CALL histwrite(nid_mth,"evapch4",itau_w,zx_tmp_2d,
	180	. iim*jjmp1,ndex2d)
	181	c --------------
[175]	182	c ----- PRECIPITATIONS
	183	c ----- CH4
[474]	184	CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,1),zx_tmp_2d)
[175]	185	CALL histwrite(nid_mth,"prech4",itau_w,zx_tmp_2d,
	186	. iim*jjmp1,ndex2d)
	187	c ----- C2H6
[474]	188	CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,2),zx_tmp_2d)
[175]	189	CALL histwrite(nid_mth,"prec2h6",itau_w,zx_tmp_2d,
	190	. iim*jjmp1,ndex2d)
	191	c ----- C2H2
[474]	192	CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,3),zx_tmp_2d)
[175]	193	CALL histwrite(nid_mth,"prec2h2",itau_w,zx_tmp_2d,
	194	. iim*jjmp1,ndex2d)
	195	c
[474]	196	c ----- NOY
	197	CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,4),zx_tmp_2d)
	198	CALL histwrite(nid_mth,"prenoy",itau_w,zx_tmp_2d,
	199	. iim*jjmp1,ndex2d)
	200	c ----- AER
	201	CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,5),zx_tmp_2d)
	202	CALL histwrite(nid_mth,"preaer",itau_w,zx_tmp_2d,
	203	. iim*jjmp1,ndex2d)
[175]	204	c --------------
	205	c ----- FLUX GLACE
[474]	206	c ----- CH4
	207	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
	208	. flxesp_i(1:klon,1:klev,1),zx_tmp_3d)
[175]	209	CALL histwrite(nid_mth,"flxgl1", itau_w, zx_tmp_3d,
	210	. iimjjmp1klev,ndex3d)
[474]	211	c ----- C2H6
	212	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
	213	. flxesp_i(1:klon,1:klev,2),zx_tmp_3d)
[175]	214	CALL histwrite(nid_mth,"flxgl2", itau_w, zx_tmp_3d,
	215	. iimjjmp1klev,ndex3d)
[474]	216	c ----- C2H2
	217	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
	218	. flxesp_i(1:klon,1:klev,3),zx_tmp_3d)
[175]	219	CALL histwrite(nid_mth,"flxgl3", itau_w, zx_tmp_3d,
	220	. iimjjmp1klev,ndex3d)
[474]	221	c --------------
	222	c ----- Source/puits GLACE
	223	c ----- CH4
	224	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
	225	. solesp(1:klon,1:klev,1),zx_tmp_3d)
	226	CALL histwrite(nid_mth,"solch4", itau_w, zx_tmp_3d,
	227	. iimjjmp1klev,ndex3d)
	228	c ----- C2H6
	229	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
	230	. solesp(1:klon,1:klev,2),zx_tmp_3d)
	231	CALL histwrite(nid_mth,"solc2h6", itau_w, zx_tmp_3d,
	232	. iimjjmp1klev,ndex3d)
	233	c ----- C2H2
	234	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
	235	. solesp(1:klon,1:klev,3),zx_tmp_3d)
	236	CALL histwrite(nid_mth,"solc2h2", itau_w, zx_tmp_3d,
	237	. iimjjmp1klev,ndex3d)
[175]	238	c
	239	c --------------
	240	c ----- RAYON MOYEN GOUTTE
	241	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, rmcloud,zx_tmp_3d)
	242	CALL histwrite(nid_mth,"rcldbar", itau_w, zx_tmp_3d,
	243	. iimjjmp1klev,ndex3d)
	244	c
	245	endif
	246	endif
	247	c
	248	c --------------
	249	c ----- TRACEURS CHIMIQUES
[97]	250	if (nmicro.lt.nqmax) then
[3]	251	DO iq=nmicro+1,nqmax
	252	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
[97]	253	CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
[3]	254	. iimjjmp1klev,ndex3d)
	255	ENDDO
	256	c Condensation:
	257	c DO iq=nmicro+1,nqmax
	258	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_tr_mph(1,1,iq),zx_tmp_3d)
[97]	259	c CALL histwrite(nid_mth,"c_"//tname(iq),itau_w,zx_tmp_3d,
[3]	260	c . iimjjmp1klev,ndex3d)
	261	c ENDDO
	262	endif
	263	endif
	264	c
	265	ENDIF !lev_histmth.GE.2
	266	c
	267	c-------------------------------------------------------
	268	IF(lev_histmth.GE.3) THEN
	269	c
	270	cccccccccccccccccc Radiative transfer
	271	c
	272	c 2D
	273	c
	274	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
[97]	275	CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	276	c
	277	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
[97]	278	CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	279	c
	280	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
[97]	281	CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	282	c
	283	c 3D
	284	c
	285	zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
	286	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	287	CALL histwrite(nid_mth,"SWnet",itau_w,zx_tmp_3d,
[3]	288	. iimjjmp1klev,ndex3d)
	289	c
	290	zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
	291	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	292	CALL histwrite(nid_mth,"LWnet",itau_w,zx_tmp_3d,
[3]	293	. iimjjmp1klev,ndex3d)
	294	c
[175]	295	c --------------
	296	c ----- OPACITE BRUME
[106]	297	do k=7,NSPECV,10
[97]	298	do i=1,klon
	299	do l=1,klev
[106]	300	t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
[97]	301	enddo
	302	enddo
	303	write(str1,'(i2.2)') k
	304	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
	305	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[119]	306	CALL histwrite(nid_mth,"thv"//str1,itau_w,zx_tmp_3d,
[97]	307	. iimjjmp1klev,ndex3d)
[106]	308	enddo ! fin boucle NSPECV
[97]	309
[175]	310	do k=8,NSPECI,10
	311	do i=1,klon
	312	do l=1,klev
	313	t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
	314	enddo
	315	enddo
	316	write(str1,'(i2.2)') k
	317	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
	318	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	319	CALL histwrite(nid_mth,"thi"//str1,itau_w,zx_tmp_3d,
	320	. iimjjmp1klev,ndex3d)
	321	enddo ! fin boucle NSPECI
	322	c
	323	c --------------
	324	c ----- EXTINCTION BRUME
[106]	325	do k=7,NSPECV,10
[97]	326	do i=1,klon
	327	do l=1,klev
[175]	328	if(l.ne.klev)
	329	s t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
	330	s -TAUHVD(i,klev-l+1-1,k)
[97]	331	if(l.eq.klev)
[175]	332	s t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
[97]	333
	334	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	335	enddo
	336	enddo
	337	write(str1,'(i2.2)') k
	338	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
	339	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[119]	340	CALL histwrite(nid_mth,"khv"//str1,itau_w,zx_tmp_3d,
[97]	341	. iimjjmp1klev,ndex3d)
[106]	342	enddo ! fin boucle NSPECV
[97]	343
[175]	344	do k=8,NSPECI,10
[106]	345	do i=1,klon
	346	do l=1,klev
[175]	347	if(l.ne.klev)
	348	s t_khvd(i,l)=TAUHID(i,klev-l+1,k)
	349	s -TAUHID(i,klev-l+1-1,k)
	350	if(l.eq.klev)
	351	s t_khvd(i,l)=TAUHID(i,klev-l+1,k)
	352
	353	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
[106]	354	enddo
	355	enddo
	356	write(str1,'(i2.2)') k
[175]	357	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
[106]	358	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[175]	359	CALL histwrite(nid_mth,"khi"//str1,itau_w,zx_tmp_3d,
[106]	360	. iimjjmp1klev,ndex3d)
[175]	361	enddo ! fin boucle NSPECI
	362	c
	363	c --------------
	364	c ----- OPACITE GAZ
[106]	365	do k=7,NSPECV,10
	366	do i=1,klon
	367	do l=1,klev
[175]	368	t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
[106]	369	enddo
	370	enddo
	371	write(str1,'(i2.2)') k
[175]	372	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
[106]	373	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[175]	374	CALL histwrite(nid_mth,"tgv"//str1,itau_w,zx_tmp_3d,
[106]	375	. iimjjmp1klev,ndex3d)
	376	enddo ! fin boucle NSPECV
	377
	378	do k=8,NSPECI,10
	379	do i=1,klon
	380	do l=1,klev
[175]	381	t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
[106]	382	enddo
	383	enddo
	384	write(str1,'(i2.2)') k
	385	zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
	386	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[175]	387	CALL histwrite(nid_mth,"tgi"//str1,itau_w,zx_tmp_3d,
[106]	388	. iimjjmp1klev,ndex3d)
	389	enddo ! fin boucle NSPECI
[175]	390	c
	391	c --------------
	392	c ----- EXTINCTION GAZ
	393	do k=7,NSPECV,10
[106]	394	do i=1,klon
	395	do l=1,klev
[175]	396	if(l.ne.klev)
	397	s t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
	398	s -TAUGVD(i,klev-l+1-1,k)
[106]	399	if(l.eq.klev)
[175]	400	s t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
[106]	401
	402	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	403	enddo
	404	enddo
	405	write(str1,'(i2.2)') k
	406	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
	407	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[175]	408	CALL histwrite(nid_mth,"kgv"//str1,itau_w,zx_tmp_3d,
[106]	409	. iimjjmp1klev,ndex3d)
[175]	410	enddo ! fin boucle NSPECV
[106]	411
	412	do k=8,NSPECI,10
	413	do i=1,klon
	414	do l=1,klev
[175]	415	if(l.ne.klev)
	416	s t_khvd(i,l)=TAUGID(i,klev-l+1,k)
	417	s -TAUGID(i,klev-l+1-1,k)
[106]	418
	419	if(l.eq.klev)
[175]	420	s t_khvd(i,l)=TAUGID(i,klev-l+1,k)
[106]	421
	422	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
	423	enddo
	424	enddo
	425	write(str1,'(i2.2)') k
	426	zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
	427	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[119]	428	CALL histwrite(nid_mth,"kgi"//str1,itau_w,zx_tmp_3d,
[106]	429	. iimjjmp1klev,ndex3d)
	430	enddo ! fin boucle NSPECI
	431
[175]	432	c --------------
	433	c ----- OPACITE NUAGES (ATTENTION PROXY)
	434	if (clouds.eq.1) then
	435	zx_tmp_fi3d(1:klon,1:klev)=occcld(1:klon,1:klev)
	436	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	437	CALL histwrite(nid_mth,"tcld",itau_w,zx_tmp_3d,
	438	. iimjjmp1klev,ndex3d)
	439	c --------------
	440	c ----- EXTINCTION NUAGES (ATTENTION PROXY)
	441	do i=1,klon
	442	t_kcld(i,klev)=occcld(i,klev)
	443	. /(zzlev(i,klev+1)-zzlev(i,klev))
	444	do j=klev-1,1,-1
	445	t_kcld(i,j)=(occcld(i,j)-occcld(i,j+1))
	446	. /(zzlev(i,j+1)-zzlev(i,j))
	447	enddo
	448	enddo
	449	zx_tmp_fi3d(1:klon,1:klev)=t_kcld(1:klon,1:klev)
	450	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
	451	CALL histwrite(nid_mth,"kcld",itau_w,zx_tmp_3d,
	452	. iimjjmp1klev,ndex3d)
	453	c
	454	c --------------
	455	c ----- OCCURENCE NUAGES
	456	do k=1,12
	457	write(str1,'(i2.2)') k
	458	zx_tmp_fi3d(1:klon,1:klev)=occcld_m(1:klon,1:klev,k)
[474]	459	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[175]	460	CALL histwrite(nid_mth,"occcld"//str1,itau_w,zx_tmp_3d,
	461	. iimjjmp1klev,ndex3d)
	462	enddo
	463	c
	464	endif
	465	c
[3]	466	ENDIF !lev_histmth.GE.3
	467	c
	468	c-------------------------------------------------------
	469	IF(lev_histmth.GE.4) THEN
	470	c
	471	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
[97]	472	CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
[3]	473	. iimjjmp1klev,ndex3d)
	474	c
	475	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
[97]	476	CALL histwrite(nid_mth,"dtphy",itau_w,zx_tmp_3d,
[3]	477	. iimjjmp1klev,ndex3d)
	478	c K/s
	479	zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
	480	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	481	CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
[3]	482	. iimjjmp1klev,ndex3d)
	483	c
	484	c K/s
	485	zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
	486	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	487	CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
[3]	488	. iimjjmp1klev,ndex3d)
	489	c
	490	c K/s
	491	zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
	492	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	493	CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
[3]	494	. iimjjmp1klev,ndex3d)
	495	c
	496	c K/s
	497	zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
	498	CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	499	CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
[3]	500	. iimjjmp1klev,ndex3d)
	501	c K/s
	502	c zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
	503	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]	504	c CALL histwrite(nid_mth,"dtec",itau_w,zx_tmp_3d,
[3]	505	c . iimjjmp1klev,ndex3d)
	506	c
	507	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
[97]	508	CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d,
[3]	509	. iimjjmp1klev,ndex3d)
	510	c
	511	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
[97]	512	CALL histwrite(nid_mth,"dudyn",itau_w,zx_tmp_3d,
[3]	513	. iimjjmp1klev,ndex3d)
	514	c
	515	c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
[97]	516	c CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d,
[3]	517	c . iimjjmp1klev,ndex3d)
	518	c
	519	ENDIF !lev_histmth.GE.4
	520	c
	521	c-------------------------------------------------------
	522	IF(lev_histmth.GE.5) THEN
	523	c
	524	c
	525	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
	526	c CALL histwrite(nid_mth,"taux_",itau_w,
[97]	527	c $ zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	528	c
	529	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
	530	c CALL histwrite(nid_mth,"tauy_",itau_w,
[97]	531	c $ zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	532	c
	533	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
[97]	534	c CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	535	c
	536	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
[97]	537	c CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]	538	c
	539	ENDIF !lev_histmth.GE.5
	540	c-------------------------------------------------------
	541	c
	542	if (ok_sync) then
	543	call histsync(nid_mth)
	544	endif
	545
	546	ENDIF

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

Download in other formats: