source: LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/write_histhf.h @ 5415

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

Probleme au moment de la synchro avec LOOP
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.3 KB
Line 
1!
2! $Header$
3!
4      if (ok_hf) then
5
6c   Comprendre comment marche el i=nint(zout/zsto)
7c
8c     print*,'ACRITURE HF !!! ACRITURE HF !!! ACRITURE HF !!! '
9      ndex2d = 0
10      ndex3d = 0
11c
12      zsto = dtime
13      zout = dtime * ecrit_hf
14      itau_w = itau_phy + itap
15c
16      IF(lev_histhf.GE.1) THEN
17c
18c     i = NINT(zout/zsto)
19c     CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
20c     CALL histwrite(nid_hf,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
21c
22c     i = NINT(zout/zsto)
23c     CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
24c     CALL histwrite(nid_hf,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
25C
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)
29c
30      DO i=1, klon
31       zx_tmp_fi2d(i)=pctsrf(i,is_ter)+pctsrf(i,is_lic)
32      ENDDO
33c
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)
37c
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)
41c
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)
45c
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)
49c
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)
56c
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)
62c
63c 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)
66c
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)
69c
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)
72c
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)
75c
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)
82c
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
90c
91      ENDIF !lev_histhf.GE.1
92c
93      IF(lev_histhf.GE.2) THEN
94c
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)
97c
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)
102c
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)
107c
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) 
111c
112c
113      ENDIF !lev_histhf.GE.2
114c
115      IF(lev_histhf.GE.3) THEN
116c
117      DO k=1, nlevENS
118c
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)
122c
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"
128c
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)
132c
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
138c
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)
142c
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)
146c
147      ENDDO !nlevENS
148c
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)
152c
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
156c
157      ENDIF !lev_histhf.GE.3
158c
159      IF(lev_histhf.GE.4) THEN
160c
161#define histhf3d
162#ifdef histhf3d
163#include "write_histhf3d.h"
164#endif
165c
166      ENDIF !lev_histhf.GE.4
167c
168      if (ok_sync) then
169        call histsync(nid_hf)
170      endif
171
172      endif
Note: See TracBrowser for help on using the repository browser.