Context Navigation

source: LMDZ4/trunk/libf/phylmd/write_histhf.h @ 594

Last change on this file since 594 was 594, checked in by Laurent Fairhead, 19 years ago
Bugs introduit par la synchro avec LOOP je sais pas comment GG 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	!
174	! $Header$
175	!
176	if (ok_hf) then
177
178	c Comprendre comment marche el i=nint(zout/zsto)
179	c
180	c print*,'ACRITURE HF !!! ACRITURE HF !!! ACRITURE HF !!! '
181	ndex2d = 0
182	ndex3d = 0
183	c
184	zsto = dtime
185	zout = dtime * ecrit_hf
186	itau_w = itau_phy + itap
187	c
188	IF(lev_histhf.GE.1) THEN
189	c
190	c i = NINT(zout/zsto)
191	c CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
192	c CALL histwrite(nid_hf,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
193	c
194	c i = NINT(zout/zsto)
195	c CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
196	c CALL histwrite(nid_hf,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
197	C
198	CALL gr_fi_ecrit(1, klon,iim,jjmp1, paire_ter, zx_tmp_2d)
199	CALL histwrite(nid_hf,"aireTER",itau_w,
200	$ zx_tmp_2d,iim*jjmp1,ndex2d)
201	c
202	DO i=1, klon
203	zx_tmp_fi2d(i)=pctsrf(i,is_ter)+pctsrf(i,is_lic)
204	ENDDO
205	c
206	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
207	CALL histwrite(nid_hf,"contfracATM",itau_w,
208	$ zx_tmp_2d,iim*jjmp1,ndex2d)
209	c
210	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pctsrf_new(:,is_ter),zx_tmp_2d)
211	CALL histwrite(nid_hf,"contfracOR",itau_w,
212	$ zx_tmp_2d,iim*jjmp1,ndex2d)
213	c
214	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d)
215	CALL histwrite(nid_hf,"t2m",itau_w,zx_tmp_2d,iim*jjmp1,
216	. ndex2d)
217	c
218	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d)
219	CALL histwrite(nid_hf,"q2m",itau_w,zx_tmp_2d,iim*jjmp1,
220	. ndex2d)
221	c
222	DO i = 1, klon
223	zx_tmp_fi2d(i) = paprs(i,1)
224	ENDDO
225	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
226	CALL histwrite(nid_hf,"psol",itau_w,zx_tmp_2d,iim*jjmp1,
227	. ndex2d)
228	c
229	DO i = 1, klon
230	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
231	ENDDO
232	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
233	CALL histwrite(nid_hf,"rain",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
234	c
235	c ENSEMBLES BEG
236	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
237	CALL histwrite(nid_hf,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
238	c
239	CALL gr_fi_ecrit(1, klon,iim,jjmp1, slp,zx_tmp_2d)
240	CALL histwrite(nid_hf,"slp",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
241	c
242	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d)
243	CALL histwrite(nid_hf,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
244	c
245	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d)
246	CALL histwrite(nid_hf,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
247	c
248	DO i=1, klon
249	zx_tmp_fi2d(i)=SQRT(zu10m(i)zu10m(i)+zv10m(i)zv10m(i))
250	ENDDO
251	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
252	CALL histwrite(nid_hf,"wind10m",itau_w,zx_tmp_2d,
253	$ iim*jjmp1,ndex2d)
254	c
255	DO k=1, nlevENS
256	IF(clev(k).EQ."500") THEN
257	CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d)
258	CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d,
259	$ iim*jjmp1,ndex2d)
260	ENDIF !clev(k).EQ."500"
261	ENDDO
262	c
263	ENDIF !lev_histhf.GE.1
264	c
265	IF(lev_histhf.GE.2) THEN
266	c
267	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
268	CALL histwrite(nid_hf,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
269	c
270	c -- LOOP
271	zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter)
272	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
273	CALL histwrite(nid_hf,"SWnetOR",itau_w,
274	$ zx_tmp_2d,iim*jjmp1,ndex2d)
275	c
276	zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol(1:klon))
277	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
278	CALL histwrite(nid_hf,"SWdownOR",itau_w,
279	$ zx_tmp_2d,iim*jjmp1,ndex2d)
280	c -- LOOP
281	c
282	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
283	CALL histwrite(nid_hf,"LWdownOR",itau_w,zx_tmp_2d,iim*jjmp1,
284	$ ndex2d)
285	c
286	c
287	ENDIF !lev_histhf.GE.2
288	c
289	IF(lev_histhf.GE.3) THEN
290	c
291	DO k=1, nlevENS
292	c
293	CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlev(:,k),zx_tmp_2d)
294	CALL histwrite(nid_hf,"t"//clev(k),itau_w,zx_tmp_2d,
295	$ iim*jjmp1,ndex2d)
296	c
297	IF(clev(k).NE."500") THEN !clev(k).NE."500"
298	CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d)
299	CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d,
300	$ iim*jjmp1,ndex2d)
301	ENDIF !clev(k).NE."500"
302	c
303	CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlev(:,k),zx_tmp_2d)
304	CALL histwrite(nid_hf,"q"//clev(k),itau_w,zx_tmp_2d,
305	$ iim*jjmp1,ndex2d)
306	c
307	IF(1.EQ.0) THEN
308	CALL gr_fi_ecrit(1, klon,iim,jjmp1, rhlev(:,k),zx_tmp_2d)
309	CALL histwrite(nid_hf,"rh"//clev(k),itau_w,zx_tmp_2d,
310	$ iim*jjmp1,ndex2d)
311	ENDIF !1.EQ.0
312	c
313	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulev(:,k),zx_tmp_2d)
314	CALL histwrite(nid_hf,"u"//clev(k),itau_w,zx_tmp_2d,
315	$ iim*jjmp1,ndex2d)
316	c
317	CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlev(:,k),zx_tmp_2d)
318	CALL histwrite(nid_hf,"v"//clev(k),itau_w,zx_tmp_2d,
319	$ iim*jjmp1,ndex2d)
320	c
321	ENDDO !nlevENS
322	c
323	IF(1.EQ.0) THEN
324	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
325	CALL histwrite(nid_hf,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
326	c
327	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
328	CALL histwrite(nid_hf,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
329	ENDIF !(1.EQ.0) THEN
330	c
331	ENDIF !lev_histhf.GE.3
332	c
333	IF(lev_histhf.GE.4) THEN
334	c
335	#define histhf3d
336	#ifdef histhf3d
337	#include "write_histhf3d.h"
338	#endif
339	c
340	ENDIF !lev_histhf.GE.4
341	c
342	if (ok_sync) then
343	call histsync(nid_hf)
344	endif
345
346	endif

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

Download in other formats: