source: trunk/LMDZ.TITAN/libf/phytitan/write_histmth.h @ 778

Last change on this file since 778 was 474, checked in by slebonnois, 14 years ago

Update of Titan physics for clouds.
File size: 19.9 KB
Line 
1      IF (ok_mensuel) THEN
2c
3      ndex2d = 0
4      ndex3d = 0
5      zx_tmp_2d = 0.
6      zx_tmp_3d = 0.
7      zx_tmp_fi2d=0.
8      zx_tmp_fi3d=0.
9c
10         zsto = dtime
11         zout = dtime * FLOAT(ecrit_mth)
12         itau_w = itau_phy + itap
13c
14c-------------------------------------------------------
15      IF(lev_histmth.GE.1) THEN
16c
17ccccccccccccc 2D fields, invariables
18c
19      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
20      CALL histwrite(nid_mth,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
21C
22      CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d)
23      CALL histwrite(nid_mth,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
24c
25ccccccc axe Ls
26      do j=1,jjmp1
27       do i=1,iim
28        zx_tmp_2d(i,j)=zls*180./RPI      ! zls est en radians !!
29       enddo
30      enddo
31      CALL histwrite(nid_mth,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
32c
33ccccccccccccc 2D fields, variables
34c
35      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
36      CALL histwrite(nid_mth,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
37c
38      DO i = 1, klon
39         zx_tmp_fi2d(i) = paprs(i,1)
40      ENDDO
41      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
42      CALL histwrite(nid_mth,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
43c
44c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
45c     CALL histwrite(nid_mth,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
46c
47c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
48c     CALL histwrite(nid_mth,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
49c
50c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
51c     CALL histwrite(nid_mth,"cdragh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
52c
53c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
54c     CALL histwrite(nid_mth,"cdragm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
55c
56      ENDIF !lev_histmth.GE.1
57c
58c-------------------------------------------------------
59      IF(lev_histmth.GE.2) THEN
60c
61ccccccccccccc 3D fields, basics
62c
63      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
64      CALL histwrite(nid_mth,"temp",itau_w,zx_tmp_3d,
65     .                                   iim*jjmp1*klev,ndex3d)
66c
67      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
68      CALL histwrite(nid_mth,"pres",itau_w,zx_tmp_3d,
69     .                                   iim*jjmp1*klev,ndex3d)
70c
71      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
72      CALL histwrite(nid_mth,"geop",itau_w,zx_tmp_3d,
73     .                                   iim*jjmp1*klev,ndex3d)
74c
75      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
76      CALL histwrite(nid_mth,"vitu",itau_w,zx_tmp_3d,
77     .                                   iim*jjmp1*klev,ndex3d)
78c
79      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
80      CALL histwrite(nid_mth,"vitv",itau_w,zx_tmp_3d,
81     .                                   iim*jjmp1*klev,ndex3d)
82c
83      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
84      CALL histwrite(nid_mth,"vitw",itau_w,zx_tmp_3d,
85     .                                   iim*jjmp1*klev,ndex3d)
86c
87c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ycoefh, zx_tmp_3d)
88c     CALL histwrite(nid_mth,"Kz",itau_w,zx_tmp_3d,
89c    .                                   iim*jjmp1*klev,ndex3d)
90c
91      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
92      CALL histwrite(nid_mth,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
93c
94cccccccccccccccccc  Tracers
95c
96         if (iflag_trac.eq.1) THEN
97          if (microfi.ge.1) then
98c          DO iq=1,nmicro
99c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, 
100c    .                  qaer(1:klon,1:klev,iq), zx_tmp_3d)
101c      CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
102c    .                                   iim*jjmp1*klev,ndex3d)
103c          ENDDO
104c    -------   NB AER TOT
105               do i=1,klon
106                 do j=1,klev
107                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,1:nrad))
108                 enddo
109               enddo
110       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
111       CALL histwrite(nid_mth,"qaer",itau_w,zx_tmp_3d,
112     .                                   iim*jjmp1*klev,ndex3d)
113
114             if (clouds.eq.1) then
115c    -------   NB NOY TOT
116               do i=1,klon
117                 do j=1,klev
118                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,nrad+1:2*nrad))
119                 enddo
120               enddo
121       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
122       CALL histwrite(nid_mth,"qnoy",itau_w,zx_tmp_3d,
123     .                                   iim*jjmp1*klev,ndex3d)
124c    -------   V GLA1 TOT
125               do i=1,klon
126                 do j=1,klev
127                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,2*nrad+1:3*nrad))
128                 enddo
129               enddo
130       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
131       CALL histwrite(nid_mth,"qgl1",itau_w,zx_tmp_3d,
132     .                                   iim*jjmp1*klev,ndex3d)
133c    -------   V GLA2 TOT
134               do i=1,klon
135                 do j=1,klev
136                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,3*nrad+1:4*nrad))
137                 enddo
138               enddo
139       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
140       CALL histwrite(nid_mth,"qgl2",itau_w,zx_tmp_3d,
141     .                                   iim*jjmp1*klev,ndex3d)
142c    -------   V GLA3 TOT
143               do i=1,klon
144                 do j=1,klev
145                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,4*nrad+1:5*nrad))
146                 enddo
147               enddo
148       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
149       CALL histwrite(nid_mth,"qgl3",itau_w,zx_tmp_3d,
150     .                                   iim*jjmp1*klev,ndex3d)
151c --------------
152c ----- SATURATION ESP NUAGES
153       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satch4,zx_tmp_3d)
154       CALL histwrite(nid_mth,"ch4sat", itau_w, zx_tmp_3d,
155     .                                   iim*jjmp1*klev,ndex3d)
156
157       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h6,zx_tmp_3d)
158       CALL histwrite(nid_mth,"c2h6sat", itau_w, zx_tmp_3d,
159     .                                   iim*jjmp1*klev,ndex3d)
160
161       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h2,zx_tmp_3d)
162       CALL histwrite(nid_mth,"c2h2sat", itau_w, zx_tmp_3d,
163     .                                   iim*jjmp1*klev,ndex3d)
164c --------------
165c ----- RESERVOIR DE SURFACE
166       CALL gr_fi_ecrit(1, klon,iim,jjmp1,reservoir,zx_tmp_2d)
167       CALL histwrite(nid_mth,"reserv",itau_w,zx_tmp_2d,
168     .                        iim*jjmp1,ndex2d)
169c --------------
170c ----- ECHANGE GAZ SURF/ATM (evaporation)
171       CALL gr_fi_ecrit(1, klon,iim,jjmp1,evapch4,zx_tmp_2d)
172       CALL histwrite(nid_mth,"evapch4",itau_w,zx_tmp_2d,
173     .                        iim*jjmp1,ndex2d)
174c --------------
175c ----- PRECIPITATIONS
176c       -----  CH4
177       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,1),zx_tmp_2d)
178       CALL histwrite(nid_mth,"prech4",itau_w,zx_tmp_2d,
179     .                        iim*jjmp1,ndex2d)
180c       -----  C2H6
181       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,2),zx_tmp_2d)
182       CALL histwrite(nid_mth,"prec2h6",itau_w,zx_tmp_2d,
183     .                        iim*jjmp1,ndex2d)
184c       -----  C2H2
185       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,3),zx_tmp_2d)
186       CALL histwrite(nid_mth,"prec2h2",itau_w,zx_tmp_2d,
187     .                        iim*jjmp1,ndex2d)
188c
189c       -----  NOY
190       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,4),zx_tmp_2d)
191       CALL histwrite(nid_mth,"prenoy",itau_w,zx_tmp_2d,
192     .                        iim*jjmp1,ndex2d)
193c       -----  AER
194       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,5),zx_tmp_2d)
195       CALL histwrite(nid_mth,"preaer",itau_w,zx_tmp_2d,
196     .                        iim*jjmp1,ndex2d)
197c --------------
198c ----- FLUX GLACE
199c       -----  CH4
200       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
201     .                  flxesp_i(1:klon,1:klev,1),zx_tmp_3d)
202       CALL histwrite(nid_mth,"flxgl1", itau_w, zx_tmp_3d,
203     .                                   iim*jjmp1*klev,ndex3d)
204c       -----  C2H6
205       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
206     .                  flxesp_i(1:klon,1:klev,2),zx_tmp_3d)
207       CALL histwrite(nid_mth,"flxgl2", itau_w, zx_tmp_3d,
208     .                                   iim*jjmp1*klev,ndex3d)
209c       -----  C2H2
210       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
211     .                  flxesp_i(1:klon,1:klev,3),zx_tmp_3d)
212       CALL histwrite(nid_mth,"flxgl3", itau_w, zx_tmp_3d,
213     .                                   iim*jjmp1*klev,ndex3d)
214c --------------
215c ----- Source/puits GLACE
216c       -----  CH4
217       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
218     .                          solesp(1:klon,1:klev,1),zx_tmp_3d)
219       CALL histwrite(nid_mth,"solch4", itau_w, zx_tmp_3d,
220     .                                   iim*jjmp1*klev,ndex3d)
221c       -----  C2H6
222       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
223     .                          solesp(1:klon,1:klev,2),zx_tmp_3d)
224       CALL histwrite(nid_mth,"solc2h6", itau_w, zx_tmp_3d,
225     .                                   iim*jjmp1*klev,ndex3d)
226c       -----  C2H2
227       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
228     .                          solesp(1:klon,1:klev,3),zx_tmp_3d)
229       CALL histwrite(nid_mth,"solc2h2", itau_w, zx_tmp_3d,
230     .                                   iim*jjmp1*klev,ndex3d)
231c
232c --------------
233c ----- RAYON MOYEN GOUTTE
234       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, rmcloud,zx_tmp_3d)
235       CALL histwrite(nid_mth,"rcldbar", itau_w, zx_tmp_3d,
236     .                                   iim*jjmp1*klev,ndex3d)
237c
238             endif
239          endif
240c
241c --------------
242c ----- TRACEURS CHIMIQUES
243          if (nmicro.lt.nqmax) then
244           DO iq=nmicro+1,nqmax
245       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
246       CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
247     .                                   iim*jjmp1*klev,ndex3d)
248           ENDDO
249c Condensation:
250c          DO iq=nmicro+1,nqmax
251c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_tr_mph(1,1,iq),zx_tmp_3d)
252c      CALL histwrite(nid_mth,"c_"//tname(iq),itau_w,zx_tmp_3d,
253c    .                                   iim*jjmp1*klev,ndex3d)
254c          ENDDO
255          endif
256         endif
257c
258      ENDIF !lev_histmth.GE.2
259c
260c-------------------------------------------------------
261      IF(lev_histmth.GE.3) THEN
262c
263cccccccccccccccccc  Radiative transfer
264c
265c 2D
266c
267      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
268      CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
269c
270      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
271      CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
272c
273      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
274      CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
275c
276c 3D
277c
278      zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
279      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
280      CALL histwrite(nid_mth,"SWnet",itau_w,zx_tmp_3d,
281     .                                   iim*jjmp1*klev,ndex3d)
282c
283      zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
284      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
285      CALL histwrite(nid_mth,"LWnet",itau_w,zx_tmp_3d,
286     .                                   iim*jjmp1*klev,ndex3d)
287c
288c --------------
289c ----- OPACITE BRUME
290       do k=7,NSPECV,10
291         do i=1,klon
292         do l=1,klev
293           t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
294         enddo
295         enddo
296         write(str1,'(i2.2)') k
297      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
298      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
299      CALL histwrite(nid_mth,"thv"//str1,itau_w,zx_tmp_3d,
300     .                                   iim*jjmp1*klev,ndex3d)
301       enddo      ! fin boucle NSPECV
302
303       do k=8,NSPECI,10
304         do i=1,klon
305         do l=1,klev
306           t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
307         enddo
308         enddo
309         write(str1,'(i2.2)') k
310      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
311      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
312      CALL histwrite(nid_mth,"thi"//str1,itau_w,zx_tmp_3d,
313     .                                   iim*jjmp1*klev,ndex3d)
314       enddo      ! fin boucle NSPECI
315c
316c --------------
317c ----- EXTINCTION BRUME
318       do k=7,NSPECV,10
319         do i=1,klon
320         do l=1,klev
321          if(l.ne.klev)
322     s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
323     s                -TAUHVD(i,klev-l+1-1,k)
324          if(l.eq.klev)
325     s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
326
327         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
328         enddo
329         enddo
330         write(str1,'(i2.2)') k
331      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
332      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
333      CALL histwrite(nid_mth,"khv"//str1,itau_w,zx_tmp_3d,
334     .                                   iim*jjmp1*klev,ndex3d)
335       enddo      ! fin boucle NSPECV
336
337       do k=8,NSPECI,10
338         do i=1,klon
339         do l=1,klev
340          if(l.ne.klev)
341     s     t_khvd(i,l)=TAUHID(i,klev-l+1,k)
342     s                -TAUHID(i,klev-l+1-1,k)
343          if(l.eq.klev)
344     s     t_khvd(i,l)=TAUHID(i,klev-l+1,k)
345
346         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
347         enddo
348         enddo
349         write(str1,'(i2.2)') k
350      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
351      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
352      CALL histwrite(nid_mth,"khi"//str1,itau_w,zx_tmp_3d,
353     .                                   iim*jjmp1*klev,ndex3d)
354       enddo      ! fin boucle NSPECI
355c
356c --------------
357c ----- OPACITE GAZ
358       do k=7,NSPECV,10
359         do i=1,klon
360         do l=1,klev
361           t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
362         enddo
363         enddo
364         write(str1,'(i2.2)') k
365      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
366      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
367      CALL histwrite(nid_mth,"tgv"//str1,itau_w,zx_tmp_3d,
368     .                                   iim*jjmp1*klev,ndex3d)
369       enddo      ! fin boucle NSPECV
370
371       do k=8,NSPECI,10
372         do i=1,klon
373         do l=1,klev
374           t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
375         enddo
376         enddo
377         write(str1,'(i2.2)') k
378      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
379      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
380      CALL histwrite(nid_mth,"tgi"//str1,itau_w,zx_tmp_3d,
381     .                                   iim*jjmp1*klev,ndex3d)
382       enddo      ! fin boucle NSPECI
383c
384c --------------
385c ----- EXTINCTION GAZ
386       do k=7,NSPECV,10
387         do i=1,klon
388         do l=1,klev
389          if(l.ne.klev)
390     s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
391     s                -TAUGVD(i,klev-l+1-1,k)
392          if(l.eq.klev)
393     s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
394
395         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
396         enddo
397         enddo
398         write(str1,'(i2.2)') k
399      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
400      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
401      CALL histwrite(nid_mth,"kgv"//str1,itau_w,zx_tmp_3d,
402     .                                   iim*jjmp1*klev,ndex3d)
403       enddo      ! fin boucle NSPECV
404
405       do k=8,NSPECI,10
406         do i=1,klon
407         do l=1,klev
408          if(l.ne.klev)
409     s     t_khvd(i,l)=TAUGID(i,klev-l+1,k)
410     s                -TAUGID(i,klev-l+1-1,k)
411
412          if(l.eq.klev)
413     s     t_khvd(i,l)=TAUGID(i,klev-l+1,k)
414
415         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
416         enddo
417         enddo
418         write(str1,'(i2.2)') k
419      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
420      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
421      CALL histwrite(nid_mth,"kgi"//str1,itau_w,zx_tmp_3d,
422     .                                   iim*jjmp1*klev,ndex3d)
423       enddo      ! fin boucle NSPECI
424
425c --------------
426c ----- OPACITE NUAGES (ATTENTION PROXY)
427         if (clouds.eq.1) then
428           zx_tmp_fi3d(1:klon,1:klev)=occcld(1:klon,1:klev)
429           CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
430           CALL histwrite(nid_mth,"tcld",itau_w,zx_tmp_3d,
431     .                                   iim*jjmp1*klev,ndex3d)
432c --------------
433c ----- EXTINCTION NUAGES (ATTENTION PROXY)
434           do i=1,klon
435             t_kcld(i,klev)=occcld(i,klev)
436     .       /(zzlev(i,klev+1)-zzlev(i,klev))
437             do j=klev-1,1,-1
438               t_kcld(i,j)=(occcld(i,j)-occcld(i,j+1))
439     .         /(zzlev(i,j+1)-zzlev(i,j))
440             enddo
441           enddo
442           zx_tmp_fi3d(1:klon,1:klev)=t_kcld(1:klon,1:klev)
443           CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
444           CALL histwrite(nid_mth,"kcld",itau_w,zx_tmp_3d,
445     .                                   iim*jjmp1*klev,ndex3d)
446c
447c --------------
448c ----- OCCURENCE NUAGES
449           do k=1,12
450             write(str1,'(i2.2)') k
451             zx_tmp_fi3d(1:klon,1:klev)=occcld_m(1:klon,1:klev,k)
452             CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
453             CALL histwrite(nid_mth,"occcld"//str1,itau_w,zx_tmp_3d,
454     .                                   iim*jjmp1*klev,ndex3d)
455           enddo
456c
457        endif 
458c
459      ENDIF !lev_histmth.GE.3
460c
461c-------------------------------------------------------
462      IF(lev_histmth.GE.4) THEN
463c
464      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
465      CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
466     .                                   iim*jjmp1*klev,ndex3d)
467c
468      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
469      CALL histwrite(nid_mth,"dtphy",itau_w,zx_tmp_3d,
470     .                                   iim*jjmp1*klev,ndex3d)
471c K/s
472      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
473      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
474      CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
475     .                                   iim*jjmp1*klev,ndex3d)
476c
477c K/s
478      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
479      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
480      CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
481     .                                   iim*jjmp1*klev,ndex3d)
482c
483c K/s
484      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
485      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
486      CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
487     .                                   iim*jjmp1*klev,ndex3d)
488c
489c K/s     
490      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
491      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
492      CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
493     .                                   iim*jjmp1*klev,ndex3d)
494c K/s     
495c     zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
496c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
497c     CALL histwrite(nid_mth,"dtec",itau_w,zx_tmp_3d,
498c    .                                   iim*jjmp1*klev,ndex3d)
499c
500      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
501      CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d,
502     .                                   iim*jjmp1*klev,ndex3d)
503c
504      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
505      CALL histwrite(nid_mth,"dudyn",itau_w,zx_tmp_3d,
506     .                                   iim*jjmp1*klev,ndex3d)
507c
508c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
509c     CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d,
510c    .                                   iim*jjmp1*klev,ndex3d)
511c
512      ENDIF !lev_histmth.GE.4
513c
514c-------------------------------------------------------
515      IF(lev_histmth.GE.5) THEN
516c
517c
518c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
519c      CALL histwrite(nid_mth,"taux_",itau_w,
520c    $      zx_tmp_2d,iim*jjmp1,ndex2d) 
521c     
522c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
523c      CALL histwrite(nid_mth,"tauy_",itau_w,
524c    $      zx_tmp_2d,iim*jjmp1,ndex2d)
525c
526c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
527c     CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
528c
529c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
530c     CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
531c
532      ENDIF !lev_histmth.GE.5
533c-------------------------------------------------------
534c
535      if (ok_sync) then
536        call histsync(nid_mth)
537      endif
538
539      ENDIF
Note: See TracBrowser for help on using the repository browser.