source: LMDZ4/branches/LMDZ4_V3_patches/libf/phylmd/write_histhf.h @ 918

Last change on this file since 918 was 918, checked in by Laurent Fairhead, 16 years ago
  • correction du bug ISCCP (n'ecrire ptop que quand ISCCP est appelé)
  • petite inversion de boucle dans isccp_cloud_types.F pour aller + vite
  • "CFisation" d'un certain nombre d'unités pour les hist*
  • les suggestions de JL pour rugoro

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