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

Last change on this file since 665 was 644, checked in by Laurent Fairhead, 20 years ago

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