Context Navigation

source: LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/write_histhf.h @ 599

Last change on this file since 599 was 599, checked in by Laurent Fairhead, 19 years ago
Pb sur swdownor LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 10.7 KB

Line
1	!
2	! $Header$
3	!
4	if (ok_hf) then
5
6	c Comprendre comment marche el i=nint(zout/zsto)
7	c
8	c print*,'ACRITURE HF !!! ACRITURE HF !!! ACRITURE HF !!! '
9	ndex2d = 0
10	ndex3d = 0
11	c
12	zsto = dtime
13	zout = dtime * ecrit_hf
14	itau_w = itau_phy + itap
15	c
16	IF(lev_histhf.GE.1) THEN
17	c
18	c i = NINT(zout/zsto)
19	c CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
20	c CALL histwrite(nid_hf,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
21	c
22	c i = NINT(zout/zsto)
23	c CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
24	c CALL histwrite(nid_hf,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
25	C
26	CALL gr_fi_ecrit(1, klon,iim,jjmp1, paire_ter, zx_tmp_2d)
27	CALL histwrite(nid_hf,"aireTER",itau_w,
28	$ zx_tmp_2d,iim*jjmp1,ndex2d)
29	c
30	DO i=1, klon
31	zx_tmp_fi2d(i)=pctsrf(i,is_ter)+pctsrf(i,is_lic)
32	ENDDO
33	c
34	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
35	CALL histwrite(nid_hf,"contfracATM",itau_w,
36	$ zx_tmp_2d,iim*jjmp1,ndex2d)
37	c
38	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pctsrf_new(:,is_ter),zx_tmp_2d)
39	CALL histwrite(nid_hf,"contfracOR",itau_w,
40	$ zx_tmp_2d,iim*jjmp1,ndex2d)
41	c
42	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d)
43	CALL histwrite(nid_hf,"t2m",itau_w,zx_tmp_2d,iim*jjmp1,
44	. ndex2d)
45	c
46	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d)
47	CALL histwrite(nid_hf,"q2m",itau_w,zx_tmp_2d,iim*jjmp1,
48	. ndex2d)
49	c
50	DO i = 1, klon
51	zx_tmp_fi2d(i) = paprs(i,1)
52	ENDDO
53	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
54	CALL histwrite(nid_hf,"psol",itau_w,zx_tmp_2d,iim*jjmp1,
55	. ndex2d)
56	c
57	DO i = 1, klon
58	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
59	ENDDO
60	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
61	CALL histwrite(nid_hf,"rain",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
62	c
63	c ENSEMBLES BEG
64	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
65	CALL histwrite(nid_hf,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
66	c
67	CALL gr_fi_ecrit(1, klon,iim,jjmp1, slp,zx_tmp_2d)
68	CALL histwrite(nid_hf,"slp",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
69	c
70	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d)
71	CALL histwrite(nid_hf,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
72	c
73	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d)
74	CALL histwrite(nid_hf,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
75	c
76	DO i=1, klon
77	zx_tmp_fi2d(i)=SQRT(zu10m(i)zu10m(i)+zv10m(i)zv10m(i))
78	ENDDO
79	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
80	CALL histwrite(nid_hf,"wind10m",itau_w,zx_tmp_2d,
81	$ iim*jjmp1,ndex2d)
82	c
83	DO k=1, nlevENS
84	IF(clev(k).EQ."500") THEN
85	CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d)
86	CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d,
87	$ iim*jjmp1,ndex2d)
88	ENDIF !clev(k).EQ."500"
89	ENDDO
90	c
91	ENDIF !lev_histhf.GE.1
92	c
93	IF(lev_histhf.GE.2) THEN
94	c
95	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
96	CALL histwrite(nid_hf,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
97	c
98	zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter)
99	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
100	CALL histwrite(nid_hf,"SWnetOR",itau_w,
101	$ zx_tmp_2d,iim*jjmp1,ndex2d)
102	c
103	zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol(1:klon))
104	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
105	CALL histwrite(nid_hf,"SWdownOR",itau_w,
106	$ zx_tmp_2d,iim*jjmp1,ndex2d)
107	c
108	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
109	CALL histwrite(nid_hf,"LWdownOR",itau_w,zx_tmp_2d,iim*jjmp1,
110	$ ndex2d)
111	c
112	c
113	ENDIF !lev_histhf.GE.2
114	c
115	IF(lev_histhf.GE.3) THEN
116	c
117	DO k=1, nlevENS
118	c
119	CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlev(:,k),zx_tmp_2d)
120	CALL histwrite(nid_hf,"t"//clev(k),itau_w,zx_tmp_2d,
121	$ iim*jjmp1,ndex2d)
122	c
123	IF(clev(k).NE."500") THEN !clev(k).NE."500"
124	CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d)
125	CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d,
126	$ iim*jjmp1,ndex2d)
127	ENDIF !clev(k).NE."500"
128	c
129	CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlev(:,k),zx_tmp_2d)
130	CALL histwrite(nid_hf,"q"//clev(k),itau_w,zx_tmp_2d,
131	$ iim*jjmp1,ndex2d)
132	c
133	IF(1.EQ.0) THEN
134	CALL gr_fi_ecrit(1, klon,iim,jjmp1, rhlev(:,k),zx_tmp_2d)
135	CALL histwrite(nid_hf,"rh"//clev(k),itau_w,zx_tmp_2d,
136	$ iim*jjmp1,ndex2d)
137	ENDIF !1.EQ.0
138	c
139	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulev(:,k),zx_tmp_2d)
140	CALL histwrite(nid_hf,"u"//clev(k),itau_w,zx_tmp_2d,
141	$ iim*jjmp1,ndex2d)
142	c
143	CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlev(:,k),zx_tmp_2d)
144	CALL histwrite(nid_hf,"v"//clev(k),itau_w,zx_tmp_2d,
145	$ iim*jjmp1,ndex2d)
146	c
147	ENDDO !nlevENS
148	c
149	IF(1.EQ.0) THEN
150	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
151	CALL histwrite(nid_hf,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
152	c
153	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
154	CALL histwrite(nid_hf,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
155	ENDIF !(1.EQ.0) THEN
156	c
157	ENDIF !lev_histhf.GE.3
158	c
159	IF(lev_histhf.GE.4) THEN
160	c
161	#define histhf3d
162	#ifdef histhf3d
163	#include "write_histhf3d.h"
164	#endif
165	c
166	ENDIF !lev_histhf.GE.4
167	c
168	if (ok_sync) then
169	call histsync(nid_hf)
170	endif
171
172	endif
173	if (ok_hf) then
174
175	c Comprendre comment marche el i=nint(zout/zsto)
176	c
177	c print*,'ACRITURE HF !!! ACRITURE HF !!! ACRITURE HF !!! '
178	ndex2d = 0
179	ndex3d = 0
180	c
181	zsto = dtime
182	zout = dtime * ecrit_hf
183	itau_w = itau_phy + itap
184	c
185	IF(lev_histhf.GE.1) THEN
186	c
187	c i = NINT(zout/zsto)
188	c CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
189	c CALL histwrite(nid_hf,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
190	c
191	c i = NINT(zout/zsto)
192	c CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
193	c CALL histwrite(nid_hf,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
194	C
195	CALL gr_fi_ecrit(1, klon,iim,jjmp1, paire_ter, zx_tmp_2d)
196	CALL histwrite(nid_hf,"aireTER",itau_w,
197	$ zx_tmp_2d,iim*jjmp1,ndex2d)
198	c
199	DO i=1, klon
200	zx_tmp_fi2d(i)=pctsrf(i,is_ter)+pctsrf(i,is_lic)
201	ENDDO
202	c
203	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
204	CALL histwrite(nid_hf,"contfracATM",itau_w,
205	$ zx_tmp_2d,iim*jjmp1,ndex2d)
206	c
207	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pctsrf_new(:,is_ter),zx_tmp_2d)
208	CALL histwrite(nid_hf,"contfracOR",itau_w,
209	$ zx_tmp_2d,iim*jjmp1,ndex2d)
210	c
211	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d)
212	CALL histwrite(nid_hf,"t2m",itau_w,zx_tmp_2d,iim*jjmp1,
213	. ndex2d)
214	c
215	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d)
216	CALL histwrite(nid_hf,"q2m",itau_w,zx_tmp_2d,iim*jjmp1,
217	. ndex2d)
218	c
219	DO i = 1, klon
220	zx_tmp_fi2d(i) = paprs(i,1)
221	ENDDO
222	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
223	CALL histwrite(nid_hf,"psol",itau_w,zx_tmp_2d,iim*jjmp1,
224	. ndex2d)
225	c
226	DO i = 1, klon
227	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
228	ENDDO
229	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
230	CALL histwrite(nid_hf,"rain",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
231	c
232	c ENSEMBLES BEG
233	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
234	CALL histwrite(nid_hf,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
235	c
236	CALL gr_fi_ecrit(1, klon,iim,jjmp1, slp,zx_tmp_2d)
237	CALL histwrite(nid_hf,"slp",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
238	c
239	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d)
240	CALL histwrite(nid_hf,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
241	c
242	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d)
243	CALL histwrite(nid_hf,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
244	c
245	DO i=1, klon
246	zx_tmp_fi2d(i)=SQRT(zu10m(i)zu10m(i)+zv10m(i)zv10m(i))
247	ENDDO
248	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
249	CALL histwrite(nid_hf,"wind10m",itau_w,zx_tmp_2d,
250	$ iim*jjmp1,ndex2d)
251	c
252	DO k=1, nlevENS
253	IF(clev(k).EQ."500") THEN
254	CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d)
255	CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d,
256	$ iim*jjmp1,ndex2d)
257	ENDIF !clev(k).EQ."500"
258	ENDDO
259	c
260	ENDIF !lev_histhf.GE.1
261	c
262	IF(lev_histhf.GE.2) THEN
263	c
264	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
265	CALL histwrite(nid_hf,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
266	c
267	c -- LOOP
268	zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter)
269	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
270	CALL histwrite(nid_hf,"SWnetOR",itau_w,
271	$ zx_tmp_2d,iim*jjmp1,ndex2d)
272	c
273	zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol(1:klon))
274	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
275	CALL histwrite(nid_hf,"SWdownOR",itau_w,
276	$ zx_tmp_2d,iim*jjmp1,ndex2d)
277	c -- LOOP
278	c
279	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
280	CALL histwrite(nid_hf,"LWdownOR",itau_w,zx_tmp_2d,iim*jjmp1,
281	$ ndex2d)
282	c
283	c
284	ENDIF !lev_histhf.GE.2
285	c
286	IF(lev_histhf.GE.3) THEN
287	c
288	DO k=1, nlevENS
289	c
290	CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlev(:,k),zx_tmp_2d)
291	CALL histwrite(nid_hf,"t"//clev(k),itau_w,zx_tmp_2d,
292	$ iim*jjmp1,ndex2d)
293	c
294	IF(clev(k).NE."500") THEN !clev(k).NE."500"
295	CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d)
296	CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d,
297	$ iim*jjmp1,ndex2d)
298	ENDIF !clev(k).NE."500"
299	c
300	CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlev(:,k),zx_tmp_2d)
301	CALL histwrite(nid_hf,"q"//clev(k),itau_w,zx_tmp_2d,
302	$ iim*jjmp1,ndex2d)
303	c
304	IF(1.EQ.0) THEN
305	CALL gr_fi_ecrit(1, klon,iim,jjmp1, rhlev(:,k),zx_tmp_2d)
306	CALL histwrite(nid_hf,"rh"//clev(k),itau_w,zx_tmp_2d,
307	$ iim*jjmp1,ndex2d)
308	ENDIF !1.EQ.0
309	c
310	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulev(:,k),zx_tmp_2d)
311	CALL histwrite(nid_hf,"u"//clev(k),itau_w,zx_tmp_2d,
312	$ iim*jjmp1,ndex2d)
313	c
314	CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlev(:,k),zx_tmp_2d)
315	CALL histwrite(nid_hf,"v"//clev(k),itau_w,zx_tmp_2d,
316	$ iim*jjmp1,ndex2d)
317	c
318	ENDDO !nlevENS
319	c
320	IF(1.EQ.0) THEN
321	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
322	CALL histwrite(nid_hf,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
323	c
324	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
325	CALL histwrite(nid_hf,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
326	ENDIF !(1.EQ.0) THEN
327	c
328	ENDIF !lev_histhf.GE.3
329	c
330	IF(lev_histhf.GE.4) THEN
331	c
332	#define histhf3d
333	#ifdef histhf3d
334	#include "write_histhf3d.h"
335	#endif
336	c
337	ENDIF !lev_histhf.GE.4
338	c
339	if (ok_sync) then
340	call histsync(nid_hf)
341	endif
342
343	endif

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

Download in other formats: