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

Last change on this file since 881 was 808, checked in by slebonnois, 12 years ago

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