Context Navigation

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

Last change on this file since 591 was 591, checked in by Laurent Fairhead, 19 years ago
Synchro avec LOOP, PC LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 10.6 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	CALL gr_fi_ecrit(1, klon,iim,jjmp1, swdownor , zx_tmp_2d)
277	CALL histwrite(nid_hf,"SWdownOR",itau_w,
278	$ zx_tmp_2d,iim*jjmp1,ndex2d)
279	c -- LOOP
280	c
281	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
282	CALL histwrite(nid_hf,"LWdownOR",itau_w,zx_tmp_2d,iim*jjmp1,
283	$ ndex2d)
284	c
285	c
286	ENDIF !lev_histhf.GE.2
287	c
288	IF(lev_histhf.GE.3) THEN
289	c
290	DO k=1, nlevENS
291	c
292	CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlev(:,k),zx_tmp_2d)
293	CALL histwrite(nid_hf,"t"//clev(k),itau_w,zx_tmp_2d,
294	$ iim*jjmp1,ndex2d)
295	c
296	IF(clev(k).NE."500") THEN !clev(k).NE."500"
297	CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d)
298	CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d,
299	$ iim*jjmp1,ndex2d)
300	ENDIF !clev(k).NE."500"
301	c
302	CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlev(:,k),zx_tmp_2d)
303	CALL histwrite(nid_hf,"q"//clev(k),itau_w,zx_tmp_2d,
304	$ iim*jjmp1,ndex2d)
305	c
306	IF(1.EQ.0) THEN
307	CALL gr_fi_ecrit(1, klon,iim,jjmp1, rhlev(:,k),zx_tmp_2d)
308	CALL histwrite(nid_hf,"rh"//clev(k),itau_w,zx_tmp_2d,
309	$ iim*jjmp1,ndex2d)
310	ENDIF !1.EQ.0
311	c
312	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulev(:,k),zx_tmp_2d)
313	CALL histwrite(nid_hf,"u"//clev(k),itau_w,zx_tmp_2d,
314	$ iim*jjmp1,ndex2d)
315	c
316	CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlev(:,k),zx_tmp_2d)
317	CALL histwrite(nid_hf,"v"//clev(k),itau_w,zx_tmp_2d,
318	$ iim*jjmp1,ndex2d)
319	c
320	ENDDO !nlevENS
321	c
322	IF(1.EQ.0) THEN
323	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
324	CALL histwrite(nid_hf,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
325	c
326	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
327	CALL histwrite(nid_hf,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
328	ENDIF !(1.EQ.0) THEN
329	c
330	ENDIF !lev_histhf.GE.3
331	c
332	IF(lev_histhf.GE.4) THEN
333	c
334	#define histhf3d
335	#ifdef histhf3d
336	#include "write_histhf3d.h"
337	#endif
338	c
339	ENDIF !lev_histhf.GE.4
340	c
341	if (ok_sync) then
342	call histsync(nid_hf)
343	endif
344
345	endif

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

Download in other formats: