source: LMDZ4/trunk/libf/phy_IPCC_AR4/write_histhf.h @ 1068

Last change on this file since 1068 was 868, checked in by Laurent Fairhead, 17 years ago

Preparation du remplacement de la physique utilisee pour l'exercice IPCC_AR4
par la version de la physique avec thermique. On garde le repertoire phylmd
pour un petit moment pour que les utilisateurs ne soient pas trop perdus ...
phy_IPCC_AR4 = phylmd
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
69c        bb=clevSTD(k)
70c
71c        IF(k.GE.2) THEN
72         IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
73         IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
74c         aa=clevSTD(k)
75c         bb=aa(1:lnblnk1(aa))
76c        ENDIF
77c
78      IF(bb2.EQ."500") THEN
79c
80cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, philevSTD(:,k),zx_tmp_2d)
81      CALL histwrite_phy(nid_hf,"phi"//bb2,itau_w, philevSTD(:,k))
82      ENDIF !bb2.EQ."500"
83      ENDDO
84c
85      ENDIF !lev_histhf.GE.1
86c
87      IF(lev_histhf.GE.2) THEN
88c
89cIM 140904 BEG
90      DO i = 1, klon
91         zx_tmp_fi2d(i) = cldt(i)*100.
92      ENDDO
93cIM 140904 END
94cIM 140904   CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
95cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
96      CALL histwrite_phy(nid_hf,"cldt",itau_w,zx_tmp_fi2d)
97c
98      zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter)
99cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
100      CALL histwrite_phy(nid_hf,"SWnetOR",itau_w, zx_tmp_fi2d)
101c
102      zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol(1:klon))
103cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
104      CALL histwrite_phy(nid_hf,"SWdownOR",itau_w, zx_tmp_fi2d)
105c
106cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
107      CALL histwrite_phy(nid_hf,"LWdownOR",itau_w,sollwdown) 
108c
109c
110      ENDIF !lev_histhf.GE.2
111c
112      IF(lev_histhf.GE.3) THEN
113c
114      DO k=1, nlevSTD
115c
116c        bb=clevSTD(k)
117c
118c        IF(k.GE.2) THEN
119         IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
120         IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
121c         aa=clevSTD(k)
122c         bb=aa(1:lnblnk1(aa))
123c        ENDIF
124c
125      IF(bb2.EQ."850".OR.bb2.EQ."700".OR.
126     $   bb2.EQ."500".OR.bb2.EQ."200") THEN
127c
128cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlevSTD(:,k),zx_tmp_2d)
129      CALL histwrite_phy(nid_hf,"t"//bb2,itau_w, tlevSTD(:,k))
130c
131      IF(bb2.NE."500") THEN !bb2.NE."500"
132c
133cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1,philevSTD(:,k),zx_tmp_2d)
134      CALL histwrite_phy(nid_hf,"phi"//bb2,itau_w,philevSTD(:,k))
135      ENDIF !bb2.NE."500"
136c
137cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlevSTD(:,k),zx_tmp_2d)
138      CALL histwrite_phy(nid_hf,"q"//bb2,itau_w, qlevSTD(:,k))
139c
140cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulevSTD(:,k),zx_tmp_2d)
141      CALL histwrite_phy(nid_hf,"u"//bb2,itau_w,ulevSTD(:,k))
142c
143cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlevSTD(:,k),zx_tmp_2d)
144      CALL histwrite_phy(nid_hf,"v"//bb2,itau_w, vlevSTD(:,k))
145c
146      ENDIF !bb2.EQ."850".OR.bb2.EQ."700"
147      ENDDO !nlevENS
148c
149      IF(1.EQ.0) THEN
150cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
151      CALL histwrite_phy(nid_hf,"cdrm",itau_w,cdragm)
152c
153cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
154      CALL histwrite_phy(nid_hf,"cdrh",itau_w,cdragh)
155      ENDIF !(1.EQ.0) THEN
156c
157      ENDIF !lev_histhf.GE.3
158c
159      IF(lev_histhf.GE.4) THEN
160c
161#undef histhf3d
162#define histhf3d
163#ifdef histhf3d
164#include "write_histhf3d.h"
165#endif
166c
167      ENDIF !lev_histhf.GE.4
168c
169      ELSE IF(type_run.EQ."AMIP".OR.type_run.EQ."CFMI") THEN
170c
171      IF(lev_histhf.GE.1) THEN
172c
173      DO k=1, nlevSTD
174c        bb=clevSTD(k)
175c
176c        IF(k.GE.2) THEN
177         IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
178         IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
179c         aa=clevSTD(k)
180c         bb=aa(1:lnblnk1(aa))
181c        ENDIF
182c
183        IF(bb2.EQ."850".or.bb2.EQ."200") THEN
184c
185cym        CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulevSTD(:,k),zx_tmp_2d)
186        CALL histwrite_phy(nid_hf,"u"//bb2,itau_w,ulevSTD(:,k))
187c
188cym        CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlevSTD(:,k),zx_tmp_2d)
189        CALL histwrite_phy(nid_hf,"v"//bb2,itau_w,vlevSTD(:,k))
190c
191        ENDIF !bb2.EQ."850".or.bb2.EQ."200"
192c
193      ENDDO !nlevSTD
194c
195cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
196      CALL histwrite_phy(nid_hf,"topl",itau_w,toplw)
197c
198      DO i = 1, klon
199         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
200      ENDDO
201cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
202      CALL histwrite_phy(nid_hf,"precip",itau_w,zx_tmp_fi2d)
203c
204cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, slp,zx_tmp_2d)
205      CALL histwrite_phy(nid_hf,"slp",itau_w,slp)
206c
207cIM 280504 BEG
208      ENDIF !(lev_histhf.GE.1) THEN
209c
210      IF(lev_histhf.GE.2) THEN
211c
212       DO k=1, nlevSTD
213c
214c        bb=clevSTD(k)
215c
216c        IF(k.GE.2) THEN
217         IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
218         IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
219c         aa=clevSTD(k)
220c         bb=aa(1:lnblnk1(aa))
221c        ENDIF
222c
223        IF(bb2.EQ."850".or.bb2.EQ."500") THEN
224c
225cym         CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlevSTD(:,k),zx_tmp_2d)
226         CALL histwrite_phy(nid_hf,"t"//bb2,itau_w,tlevSTD(:,k))
227c
228cym         CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlevSTD(:,k),zx_tmp_2d)
229         CALL histwrite_phy(nid_hf,"q"//bb2,itau_w, qlevSTD(:,k))
230c
231        ENDIF !bb2.EQ."850".or.bb2.EQ."500"
232c
233        IF(bb2.EQ."500") THEN
234c
235cym         CALL gr_fi_ecrit(1, klon,iim,jjmp1, philevSTD(:,k),zx_tmp_2d)
236         CALL histwrite_phy(nid_hf,"phi"//bb2,itau_w, philevSTD(:,k))
237c
238cym        CALL gr_fi_ecrit(1, klon,iim,jjmp1, wlevSTD(:,k),zx_tmp_2d)
239        CALL histwrite_phy(nid_hf,"w"//bb2,itau_w, wlevSTD(:,k))
240c
241        ENDIF !bb2.EQ."500"
242c
243        IF(bb3.EQ."50") THEN
244c
245cym         CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlevSTD(:,k),zx_tmp_2d)
246         CALL histwrite_phy(nid_hf,"t"//bb3,itau_w, tlevSTD(:,k))
247c
248cym        CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulevSTD(:,k),zx_tmp_2d)
249        CALL histwrite_phy(nid_hf,"u"//bb3,itau_w, ulevSTD(:,k))
250c
251cym        CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlevSTD(:,k),zx_tmp_2d)
252        CALL histwrite_phy(nid_hf,"v"//bb3,itau_w, vlevSTD(:,k))
253c
254        ENDIF !bb3.EQ."50"
255c
256       ENDDO !k=1, nlevSTD
257c
258cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d)
259      CALL histwrite_phy(nid_hf,"u10m",itau_w,zu10m)
260c
261cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d)
262      CALL histwrite_phy(nid_hf,"v10m",itau_w,zv10m)
263c
264cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d)
265      CALL histwrite_phy(nid_hf,"t2m",itau_w, zt2m)
266c
267cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d)
268      CALL histwrite_phy(nid_hf,"q2m",itau_w,zq2m)
269c
270      DO i = 1, klon
271         zx_tmp_fi2d(i) = paprs(i,1)
272      ENDDO
273cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
274      CALL histwrite_phy(nid_hf,"psol",itau_w,zx_tmp_fi2d)
275c
276cIM 140904 BEG
277      DO i = 1, klon
278         zx_tmp_fi2d(i) = cldt(i)*100.
279      ENDDO
280cIM 140904 END
281cIM 140904   CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
282cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
283      CALL histwrite_phy(nid_hf,"cldt",itau_w,zx_tmp_fi2d)
284c
285      zx_tmp_fi2d(1 : klon) = zxfluxu(1 : klon, 1)
286cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
287      CALL histwrite_phy(nid_hf,"taux",itau_w,zx_tmp_fi2d)
288C
289      zx_tmp_fi2d(1 : klon) = zxfluxv(1 : klon, 1)
290cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
291      CALL histwrite_phy(nid_hf,"tauy",itau_w,zx_tmp_fi2d)
292c
293cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, prw,zx_tmp_2d)
294      CALL histwrite_phy(nid_hf,"prw",itau_w,prw)
295c
296      zx_tmp_fi2d(1:klon)=-1*sens(1:klon)
297cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
298      CALL histwrite_phy(nid_hf,"sens",itau_w,zx_tmp_fi2d)
299c
300cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxfluxlat,zx_tmp_2d)
301      CALL histwrite_phy(nid_hf,"flat",itau_w,zxfluxlat)
302c
303c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, zsnow_mass,zx_tmp_2d)
304c     CALL histwrite_phy(nid_hf,"snow_mass",itau_w,zsnow_mass)
305c
306      zx_tmp_fi2d(1 : klon) = swdn ( 1 : klon, 1 )
307cym      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
308      CALL histwrite_phy(nid_hf, "SWdnSFC",itau_w,zx_tmp_fi2d)
309c
310      zx_tmp_fi2d(1 : klon) = swup ( 1 : klon, 1 )
311cym      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
312      CALL histwrite_phy(nid_hf, "SWupSFC",itau_w,zx_tmp_fi2d)
313c
314cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
315      CALL histwrite_phy(nid_hf,"LWdnSFC",itau_w,sollwdown)
316c
317cIM 090904   zx_tmp_fi2d(1:klon)=sollw(1:klon)+sollwdown(1:klon)
318cIM 130904   zx_tmp_fi2d(1:klon)=sollw(1:klon)-sollwdown(1:klon)
319      zx_tmp_fi2d(1:klon)=sollwdown(1:klon)-sollw(1:klon)
320cym      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
321      CALL histwrite_phy(nid_hf,"LWupSFC",itau_w,zx_tmp_fi2d)                   
322c
323      zx_tmp_fi2d(1 : klon) = swdn ( 1 : klon, klevp1 )
324cym      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
325      CALL histwrite_phy(nid_hf, "SWdnTOA",itau_w,zx_tmp_fi2d)
326c
327      zx_tmp_fi2d(1 : klon) = swup ( 1 : klon, klevp1 )
328cym      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
329      CALL histwrite_phy(nid_hf, "SWupTOA",itau_w,zx_tmp_fi2d)
330c
331      IF (is_sequential) THEN
332cym      CALL gr_fi_ecrit(nbteta,klon,iim,jjmp1,PVteta,zx_tmp_3dte)
333      DO k=1, nbteta
334       zx_tmp_fi2d(1:klon) = PVteta(1:klon,k)
335       CALL histwrite_phy(nid_hf,"PV"//ctetaSTD(k),
336     .      itau_w,zx_tmp_fi2d)
337      ENDDO !k=1, nbteta
338      ENDIF
339c
340c
341c planetary boundary layer height
342c
343c     ENDIF !1.EQ.0
344c
345      ENDIF !(lev_histhf.GE.2) THEN
346cIM 280504 END
347c
348      ENDIF !type_run
349c
350      IF (ok_sync) THEN
351c$OMP MASTER
352        call histsync(nid_hf)
353c$OMP END MASTER
354      ENDIF
355
356      ENDIF
Note: See TracBrowser for help on using the repository browser.