source: LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histhf.h @ 582

Last change on this file since 582 was 582, checked in by Laurent Fairhead, 19 years ago

Sauvegarde des rayonnements solaires net et incident pour Orchidee
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.3 KB
Line 
1      if (ok_hf) then
2
3c   Comprendre comment marche el i=nint(zout/zsto)
4c
5c     print*,'ACRITURE HF !!! ACRITURE HF !!! ACRITURE HF !!! '
6      ndex2d = 0
7      ndex3d = 0
8c
9      zsto = dtime
10      zout = dtime * ecrit_hf
11      itau_w = itau_phy + itap
12c
13      IF(lev_histhf.GE.1) THEN
14c
15c     i = NINT(zout/zsto)
16c     CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
17c     CALL histwrite(nid_hf,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
18c
19c     i = NINT(zout/zsto)
20c     CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
21c     CALL histwrite(nid_hf,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
22C
23      CALL gr_fi_ecrit(1, klon,iim,jjmp1, paire_ter, zx_tmp_2d)
24      CALL histwrite(nid_hf,"aireTER",itau_w,
25     $      zx_tmp_2d,iim*jjmp1,ndex2d)
26c
27      DO i=1, klon
28       zx_tmp_fi2d(i)=pctsrf(i,is_ter)+pctsrf(i,is_lic)
29      ENDDO
30c
31      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
32      CALL histwrite(nid_hf,"contfracATM",itau_w,
33     $      zx_tmp_2d,iim*jjmp1,ndex2d)
34c
35      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pctsrf_new(:,is_ter),zx_tmp_2d)
36      CALL histwrite(nid_hf,"contfracOR",itau_w,
37     $      zx_tmp_2d,iim*jjmp1,ndex2d)
38c
39      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d)
40      CALL histwrite(nid_hf,"t2m",itau_w,zx_tmp_2d,iim*jjmp1,
41     .               ndex2d)
42c
43      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d)
44      CALL histwrite(nid_hf,"q2m",itau_w,zx_tmp_2d,iim*jjmp1,
45     .               ndex2d)
46c
47      DO i = 1, klon
48         zx_tmp_fi2d(i) = paprs(i,1)
49      ENDDO
50      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
51      CALL histwrite(nid_hf,"psol",itau_w,zx_tmp_2d,iim*jjmp1,
52     .               ndex2d)
53c
54      DO i = 1, klon
55         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
56      ENDDO
57      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
58      CALL histwrite(nid_hf,"rain",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
59c
60c ENSEMBLES BEG
61      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
62      CALL histwrite(nid_hf,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
63c
64      CALL gr_fi_ecrit(1, klon,iim,jjmp1, slp,zx_tmp_2d)
65      CALL histwrite(nid_hf,"slp",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
66c
67      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d)
68      CALL histwrite(nid_hf,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
69c
70      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d)
71      CALL histwrite(nid_hf,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
72c
73      DO i=1, klon
74       zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
75      ENDDO
76      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
77      CALL histwrite(nid_hf,"wind10m",itau_w,zx_tmp_2d,
78     $     iim*jjmp1,ndex2d)
79c
80      DO k=1, nlevENS
81      IF(clev(k).EQ."500") THEN
82      CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d)
83      CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d,
84     $       iim*jjmp1,ndex2d)
85      ENDIF !clev(k).EQ."500"
86      ENDDO
87c
88      ENDIF !lev_histhf.GE.1
89c
90      IF(lev_histhf.GE.2) THEN
91c
92      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
93      CALL histwrite(nid_hf,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
94c
95      zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter)
96      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
97      CALL histwrite(nid_hf,"SWnetOR",itau_w,
98     $     zx_tmp_2d,iim*jjmp1,ndex2d)
99c
100      zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol(1:klon))
101      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
102      CALL histwrite(nid_hf,"SWdownOR",itau_w,
103     $     zx_tmp_2d,iim*jjmp1,ndex2d)
104c
105      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
106      CALL histwrite(nid_hf,"LWdownOR",itau_w,zx_tmp_2d,iim*jjmp1,
107     $     ndex2d) 
108c
109c
110      ENDIF !lev_histhf.GE.2
111c
112      IF(lev_histhf.GE.3) THEN
113c
114      DO k=1, nlevENS
115c
116      CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlev(:,k),zx_tmp_2d)
117      CALL histwrite(nid_hf,"t"//clev(k),itau_w,zx_tmp_2d,
118     $       iim*jjmp1,ndex2d)
119c
120      IF(clev(k).NE."500") THEN !clev(k).NE."500"
121      CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d)
122      CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d,
123     $       iim*jjmp1,ndex2d)
124      ENDIF !clev(k).NE."500"
125c
126      CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlev(:,k),zx_tmp_2d)
127      CALL histwrite(nid_hf,"q"//clev(k),itau_w,zx_tmp_2d,
128     $       iim*jjmp1,ndex2d)
129c
130      IF(1.EQ.0) THEN
131      CALL gr_fi_ecrit(1, klon,iim,jjmp1, rhlev(:,k),zx_tmp_2d)
132      CALL histwrite(nid_hf,"rh"//clev(k),itau_w,zx_tmp_2d,
133     $       iim*jjmp1,ndex2d)
134      ENDIF !1.EQ.0
135c
136      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulev(:,k),zx_tmp_2d)
137      CALL histwrite(nid_hf,"u"//clev(k),itau_w,zx_tmp_2d,
138     $       iim*jjmp1,ndex2d)
139c
140      CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlev(:,k),zx_tmp_2d)
141      CALL histwrite(nid_hf,"v"//clev(k),itau_w,zx_tmp_2d,
142     $       iim*jjmp1,ndex2d)
143c
144      ENDDO !nlevENS
145c
146      IF(1.EQ.0) THEN
147      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
148      CALL histwrite(nid_hf,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
149c
150      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
151      CALL histwrite(nid_hf,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
152      ENDIF !(1.EQ.0) THEN
153c
154      ENDIF !lev_histhf.GE.3
155c
156      IF(lev_histhf.GE.4) THEN
157c
158#define histhf3d
159#ifdef histhf3d
160#include "write_histhf3d.h"
161#endif
162c
163      ENDIF !lev_histhf.GE.4
164c
165      if (ok_sync) then
166        call histsync(nid_hf)
167      endif
168
169      endif
Note: See TracBrowser for help on using the repository browser.