Context Navigation

source: LMDZ4/branches/LMDZ4_V2_patch/libf/phylmd/write_histhf.h

Last change on this file was 644, checked in by Laurent Fairhead, 19 years ago
Synchronisation avec tous les diagnostiques de Ionela IM Inclusion du slab ocean IM LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 12.2 KB

Line
1	!
2	! $Header$
3	!
4	if (ok_hf) then
5
6	c
7	ndex2d = 0
8	ndex3d = 0
9	c
10	itau_w = itau_phy + itap
11	c
12	IF(type_run.EQ."CLIM".OR.type_run.EQ."ENSP") THEN
13	c
14	IF(lev_histhf.GE.1) THEN
15	c
16	CALL gr_fi_ecrit(1, klon,iim,jjmp1, paire_ter, zx_tmp_2d)
17	CALL histwrite(nid_hf,"aireTER",itau_w,
18	$ zx_tmp_2d,iim*jjmp1,ndex2d)
19	c
20	DO i=1, klon
21	zx_tmp_fi2d(i)=pctsrf(i,is_ter)+pctsrf(i,is_lic)
22	ENDDO
23	c
24	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
25	CALL histwrite(nid_hf,"contfracATM",itau_w,
26	$ zx_tmp_2d,iim*jjmp1,ndex2d)
27	c
28	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pctsrf_new(:,is_ter),zx_tmp_2d)
29	CALL histwrite(nid_hf,"contfracOR",itau_w,
30	$ zx_tmp_2d,iim*jjmp1,ndex2d)
31	c
32	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d)
33	CALL histwrite(nid_hf,"t2m",itau_w,zx_tmp_2d,iim*jjmp1,
34	. ndex2d)
35	c
36	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d)
37	CALL histwrite(nid_hf,"q2m",itau_w,zx_tmp_2d,iim*jjmp1,
38	. ndex2d)
39	c
40	DO i = 1, klon
41	zx_tmp_fi2d(i) = paprs(i,1)
42	ENDDO
43	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
44	CALL histwrite(nid_hf,"psol",itau_w,zx_tmp_2d,iim*jjmp1,
45	. ndex2d)
46	c
47	DO i = 1, klon
48	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
49	ENDDO
50	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
51	CALL histwrite(nid_hf,"precip",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
52	c
53	c ENSEMBLES BEG
54	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
55	CALL histwrite(nid_hf,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
56	c
57	CALL gr_fi_ecrit(1, klon,iim,jjmp1, slp,zx_tmp_2d)
58	CALL histwrite(nid_hf,"slp",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
59	c
60	c
61	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d)
62	CALL histwrite(nid_hf,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
63	c
64	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d)
65	CALL histwrite(nid_hf,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
66	c
67	DO i=1, klon
68	zx_tmp_fi2d(i)=SQRT(zu10m(i)zu10m(i)+zv10m(i)zv10m(i))
69	ENDDO
70	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
71	CALL histwrite(nid_hf,"wind10m",itau_w,zx_tmp_2d,
72	$ iim*jjmp1,ndex2d)
73	c
74	DO k=1, nlevSTD
75	c
76	c bb=clevSTD(k)
77	c
78	c IF(k.GE.2) THEN
79	IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
80	IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
81	c aa=clevSTD(k)
82	c bb=aa(1:lnblnk1(aa))
83	c ENDIF
84	c
85	IF(bb2.EQ."500") THEN
86	c
87	CALL gr_fi_ecrit(1, klon,iim,jjmp1, philevSTD(:,k),zx_tmp_2d)
88	CALL histwrite(nid_hf,"phi"//bb2,itau_w,zx_tmp_2d,
89	$ iim*jjmp1,ndex2d)
90	ENDIF !bb2.EQ."500"
91	ENDDO
92	c
93	ENDIF !lev_histhf.GE.1
94	c
95	IF(lev_histhf.GE.2) THEN
96	c
97	cIM 140904 BEG
98	DO i = 1, klon
99	zx_tmp_fi2d(i) = cldt(i)*100.
100	ENDDO
101	cIM 140904 END
102	cIM 140904 CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
103	CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
104	CALL histwrite(nid_hf,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
105	c
106	zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter)
107	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
108	CALL histwrite(nid_hf,"SWnetOR",itau_w,
109	$ zx_tmp_2d,iim*jjmp1,ndex2d)
110	c
111	zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol(1:klon))
112	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
113	CALL histwrite(nid_hf,"SWdownOR",itau_w,
114	$ zx_tmp_2d,iim*jjmp1,ndex2d)
115	c
116	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
117	CALL histwrite(nid_hf,"LWdownOR",itau_w,zx_tmp_2d,iim*jjmp1,
118	$ ndex2d)
119	c
120	c
121	ENDIF !lev_histhf.GE.2
122	c
123	IF(lev_histhf.GE.3) THEN
124	c
125	DO k=1, nlevSTD
126	c
127	c bb=clevSTD(k)
128	c
129	c IF(k.GE.2) THEN
130	IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
131	IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
132	c aa=clevSTD(k)
133	c bb=aa(1:lnblnk1(aa))
134	c ENDIF
135	c
136	IF(bb2.EQ."850".OR.bb2.EQ."700".OR.
137	$ bb2.EQ."500".OR.bb2.EQ."200") THEN
138	c
139	CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlevSTD(:,k),zx_tmp_2d)
140	CALL histwrite(nid_hf,"t"//bb2,itau_w,zx_tmp_2d,
141	$ iim*jjmp1,ndex2d)
142	c
143	IF(bb2.NE."500") THEN !bb2.NE."500"
144	c
145	CALL gr_fi_ecrit(1, klon,iim,jjmp1,philevSTD(:,k),zx_tmp_2d)
146	CALL histwrite(nid_hf,"phi"//bb2,itau_w,zx_tmp_2d,
147	$ iim*jjmp1,ndex2d)
148	ENDIF !bb2.NE."500"
149	c
150	CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlevSTD(:,k),zx_tmp_2d)
151	CALL histwrite(nid_hf,"q"//bb2,itau_w,zx_tmp_2d,
152	$ iim*jjmp1,ndex2d)
153	c
154	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulevSTD(:,k),zx_tmp_2d)
155	CALL histwrite(nid_hf,"u"//bb2,itau_w,zx_tmp_2d,
156	$ iim*jjmp1,ndex2d)
157	c
158	CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlevSTD(:,k),zx_tmp_2d)
159	CALL histwrite(nid_hf,"v"//bb2,itau_w,zx_tmp_2d,
160	$ iim*jjmp1,ndex2d)
161	c
162	ENDIF !bb2.EQ."850".OR.bb2.EQ."700"
163	ENDDO !nlevENS
164	c
165	IF(1.EQ.0) THEN
166	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
167	CALL histwrite(nid_hf,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
168	c
169	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
170	CALL histwrite(nid_hf,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
171	ENDIF !(1.EQ.0) THEN
172	c
173	ENDIF !lev_histhf.GE.3
174	c
175	IF(lev_histhf.GE.4) THEN
176	c
177	#undef histhf3d
178	#define histhf3d
179	#ifdef histhf3d
180	#include "write_histhf3d.h"
181	#endif
182	c
183	ENDIF !lev_histhf.GE.4
184	c
185	ELSE IF(type_run.EQ."AMIP".OR.type_run.EQ."CFMI") THEN
186	c
187	IF(lev_histhf.GE.1) THEN
188	c
189	DO k=1, nlevSTD
190	c bb=clevSTD(k)
191	c
192	c IF(k.GE.2) THEN
193	IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
194	IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
195	c aa=clevSTD(k)
196	c bb=aa(1:lnblnk1(aa))
197	c ENDIF
198	c
199	IF(bb2.EQ."850".or.bb2.EQ."200") THEN
200	c
201	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulevSTD(:,k),zx_tmp_2d)
202	CALL histwrite(nid_hf,"u"//bb2,itau_w,zx_tmp_2d,
203	$ iim*jjmp1,ndex2d)
204	c
205	CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlevSTD(:,k),zx_tmp_2d)
206	CALL histwrite(nid_hf,"v"//bb2,itau_w,zx_tmp_2d,
207	$ iim*jjmp1,ndex2d)
208	c
209	ENDIF !bb2.EQ."850".or.bb2.EQ."200"
210	c
211	ENDDO !nlevSTD
212	c
213	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
214	CALL histwrite(nid_hf,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
215	c
216	DO i = 1, klon
217	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
218	ENDDO
219	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
220	CALL histwrite(nid_hf,"precip",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
221	c
222	CALL gr_fi_ecrit(1, klon,iim,jjmp1, slp,zx_tmp_2d)
223	CALL histwrite(nid_hf,"slp",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
224	c
225	cIM 280504 BEG
226	ENDIF !(lev_histhf.GE.1) THEN
227	c
228	IF(lev_histhf.GE.2) THEN
229	c
230	DO k=1, nlevSTD
231	c
232	c bb=clevSTD(k)
233	c
234	c IF(k.GE.2) THEN
235	IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
236	IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
237	c aa=clevSTD(k)
238	c bb=aa(1:lnblnk1(aa))
239	c ENDIF
240	c
241	IF(bb2.EQ."850".or.bb2.EQ."500") THEN
242	c
243	CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlevSTD(:,k),zx_tmp_2d)
244	CALL histwrite(nid_hf,"t"//bb2,itau_w,zx_tmp_2d,
245	$ iim*jjmp1,ndex2d)
246	c
247	CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlevSTD(:,k),zx_tmp_2d)
248	CALL histwrite(nid_hf,"q"//bb2,itau_w,zx_tmp_2d,
249	$ iim*jjmp1,ndex2d)
250	c
251	ENDIF !bb2.EQ."850".or.bb2.EQ."500"
252	c
253	IF(bb2.EQ."500") THEN
254	c
255	CALL gr_fi_ecrit(1, klon,iim,jjmp1, philevSTD(:,k),zx_tmp_2d)
256	CALL histwrite(nid_hf,"phi"//bb2,itau_w,zx_tmp_2d,
257	$ iim*jjmp1,ndex2d)
258	c
259	CALL gr_fi_ecrit(1, klon,iim,jjmp1, wlevSTD(:,k),zx_tmp_2d)
260	CALL histwrite(nid_hf,"w"//bb2,itau_w,zx_tmp_2d,
261	$ iim*jjmp1,ndex2d)
262	c
263	ENDIF !bb2.EQ."500"
264	c
265	IF(bb3.EQ."50") THEN
266	c
267	CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlevSTD(:,k),zx_tmp_2d)
268	CALL histwrite(nid_hf,"t"//bb3,itau_w,zx_tmp_2d,
269	$ iim*jjmp1,ndex2d)
270	c
271	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulevSTD(:,k),zx_tmp_2d)
272	CALL histwrite(nid_hf,"u"//bb3,itau_w,zx_tmp_2d,
273	$ iim*jjmp1,ndex2d)
274	c
275	CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlevSTD(:,k),zx_tmp_2d)
276	CALL histwrite(nid_hf,"v"//bb3,itau_w,zx_tmp_2d,
277	$ iim*jjmp1,ndex2d)
278	c
279	ENDIF !bb3.EQ."50"
280	c
281	ENDDO !k=1, nlevSTD
282	c
283	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d)
284	CALL histwrite(nid_hf,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
285	c
286	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d)
287	CALL histwrite(nid_hf,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
288	c
289	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d)
290	CALL histwrite(nid_hf,"t2m",itau_w,zx_tmp_2d,iim*jjmp1,
291	$ ndex2d)
292	c
293	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d)
294	CALL histwrite(nid_hf,"q2m",itau_w,zx_tmp_2d,iim*jjmp1,
295	$ ndex2d)
296	c
297	DO i = 1, klon
298	zx_tmp_fi2d(i) = paprs(i,1)
299	ENDDO
300	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
301	CALL histwrite(nid_hf,"psol",itau_w,zx_tmp_2d,iim*jjmp1,
302	$ ndex2d)
303	c
304	cIM 140904 BEG
305	DO i = 1, klon
306	zx_tmp_fi2d(i) = cldt(i)*100.
307	ENDDO
308	cIM 140904 END
309	cIM 140904 CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
310	CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
311	CALL histwrite(nid_hf,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
312	c
313	zx_tmp_fi2d(1 : klon) = zxfluxu(1 : klon, 1)
314	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
315	CALL histwrite(nid_hf,"taux",itau_w,
316	$ zx_tmp_2d,iim*jjmp1,ndex2d)
317	C
318	zx_tmp_fi2d(1 : klon) = zxfluxv(1 : klon, 1)
319	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
320	CALL histwrite(nid_hf,"tauy",itau_w,
321	$ zx_tmp_2d,iim*jjmp1,ndex2d)
322	c
323	CALL gr_fi_ecrit(1, klon,iim,jjmp1, prw,zx_tmp_2d)
324	CALL histwrite(nid_hf,"prw",itau_w,zx_tmp_2d,
325	$ iim*jjmp1,ndex2d)
326	c
327	zx_tmp_fi2d(1:klon)=-1*sens(1:klon)
328	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
329	CALL histwrite(nid_hf,"sens",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
330	c
331	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxfluxlat,zx_tmp_2d)
332	CALL histwrite(nid_hf,"flat",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
333	c
334	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zsnow_mass,zx_tmp_2d)
335	c CALL histwrite(nid_hf,"snow_mass",itau_w,zx_tmp_2d,iim*jjmp1,
336	c $ ndex2d)
337	c
338	zx_tmp_fi2d(1 : klon) = swdn ( 1 : klon, 1 )
339	CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
340	CALL histwrite(nid_hf, "SWdnSFC",itau_w,zx_tmp_2d,
341	$ iim*jjmp1,ndex2d)
342	c
343	zx_tmp_fi2d(1 : klon) = swup ( 1 : klon, 1 )
344	CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
345	CALL histwrite(nid_hf, "SWupSFC",itau_w,zx_tmp_2d,
346	$ iim*jjmp1,ndex2d)
347	c
348	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
349	CALL histwrite(nid_hf,"LWdnSFC",itau_w,zx_tmp_2d,iim*jjmp1,
350	$ ndex2d)
351	c
352	cIM 090904 zx_tmp_fi2d(1:klon)=sollw(1:klon)+sollwdown(1:klon)
353	cIM 130904 zx_tmp_fi2d(1:klon)=sollw(1:klon)-sollwdown(1:klon)
354	zx_tmp_fi2d(1:klon)=sollwdown(1:klon)-sollw(1:klon)
355	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
356	CALL histwrite(nid_hf,"LWupSFC",itau_w,zx_tmp_2d,iim*jjmp1,
357	$ ndex2d)
358	c
359	zx_tmp_fi2d(1 : klon) = swdn ( 1 : klon, klevp1 )
360	CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
361	CALL histwrite(nid_hf, "SWdnTOA",itau_w,zx_tmp_2d,
362	$ iim*jjmp1,ndex2d)
363	c
364	zx_tmp_fi2d(1 : klon) = swup ( 1 : klon, klevp1 )
365	CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
366	CALL histwrite(nid_hf, "SWupTOA",itau_w,zx_tmp_2d,
367	$ iim*jjmp1,ndex2d)
368	c
369	CALL gr_fi_ecrit(nbteta,klon,iim,jjmp1,PVteta,zx_tmp_3dte)
370	DO k=1, nbteta
371	CALL histwrite(nid_hf,"PV"//ctetaSTD(k),
372	. itau_w,zx_tmp_3dte(:,:,k),iim*jjmp1,ndex2d)
373	ENDDO !k=1, nbteta
374	c
375	c
376	c planetary boundary layer height
377	c
378	c ENDIF !1.EQ.0
379	c
380	ENDIF !(lev_histhf.GE.2) THEN
381	cIM 280504 END
382	c
383	ENDIF !type_run
384	c
385	IF (ok_sync) THEN
386	call histsync(nid_hf)
387	ENDIF
388
389	ENDIF

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

Download in other formats: