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
RevLine 
[3]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)
[97]20      CALL histwrite(nid_mth,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]21C
22      CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d)
[97]23      CALL histwrite(nid_mth,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]24c
25ccccccc axe Ls
26      do j=1,jjmp1
27       do i=1,iim
[97]28        zx_tmp_2d(i,j)=zls*180./RPI      ! zls est en radians !!
[3]29       enddo
30      enddo
[97]31      CALL histwrite(nid_mth,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]32c
33ccccccccccccc 2D fields, variables
34c
35      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
[97]36      CALL histwrite(nid_mth,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]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)
[97]42      CALL histwrite(nid_mth,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]43c
44c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
[97]45c     CALL histwrite(nid_mth,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]46c
47c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
[97]48c     CALL histwrite(nid_mth,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]49c
[106]50c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
[110]51c     CALL histwrite(nid_mth,"cdragh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[106]52c
53c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
[110]54c     CALL histwrite(nid_mth,"cdragm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[106]55c
[3]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)
[97]64      CALL histwrite(nid_mth,"temp",itau_w,zx_tmp_3d,
[3]65     .                                   iim*jjmp1*klev,ndex3d)
66c
67      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
[97]68      CALL histwrite(nid_mth,"pres",itau_w,zx_tmp_3d,
[3]69     .                                   iim*jjmp1*klev,ndex3d)
70c
71      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
[97]72      CALL histwrite(nid_mth,"geop",itau_w,zx_tmp_3d,
[3]73     .                                   iim*jjmp1*klev,ndex3d)
74c
75      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
[97]76      CALL histwrite(nid_mth,"vitu",itau_w,zx_tmp_3d,
[3]77     .                                   iim*jjmp1*klev,ndex3d)
78c
79      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
[97]80      CALL histwrite(nid_mth,"vitv",itau_w,zx_tmp_3d,
[3]81     .                                   iim*jjmp1*klev,ndex3d)
82c
83      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
[97]84      CALL histwrite(nid_mth,"vitw",itau_w,zx_tmp_3d,
[3]85     .                                   iim*jjmp1*klev,ndex3d)
86c
[106]87c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ycoefh, zx_tmp_3d)
[110]88c     CALL histwrite(nid_mth,"Kz",itau_w,zx_tmp_3d,
[106]89c    .                                   iim*jjmp1*klev,ndex3d)
90c
[3]91      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
[97]92      CALL histwrite(nid_mth,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]93c
[175]94cccccccccccccccccc  Tracers
95c
[3]96         if (iflag_trac.eq.1) THEN
[175]97          if (microfi.ge.1) then
[97]98c          DO iq=1,nmicro
[474]99c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, 
100c    .                  qaer(1:klon,1:klev,iq), zx_tmp_3d)
[97]101c      CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
102c    .                                   iim*jjmp1*klev,ndex3d)
103c          ENDDO
[175]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)
[306]113
114             if (clouds.eq.1) then
[175]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 --------------
[474]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 --------------
[175]175c ----- PRECIPITATIONS
176c       -----  CH4
[474]177       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,1),zx_tmp_2d)
[175]178       CALL histwrite(nid_mth,"prech4",itau_w,zx_tmp_2d,
179     .                        iim*jjmp1,ndex2d)
180c       -----  C2H6
[474]181       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,2),zx_tmp_2d)
[175]182       CALL histwrite(nid_mth,"prec2h6",itau_w,zx_tmp_2d,
183     .                        iim*jjmp1,ndex2d)
184c       -----  C2H2
[474]185       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,3),zx_tmp_2d)
[175]186       CALL histwrite(nid_mth,"prec2h2",itau_w,zx_tmp_2d,
187     .                        iim*jjmp1,ndex2d)
188c
[474]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)
[175]197c --------------
198c ----- FLUX GLACE
[474]199c       -----  CH4
200       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
201     .                  flxesp_i(1:klon,1:klev,1),zx_tmp_3d)
[175]202       CALL histwrite(nid_mth,"flxgl1", itau_w, zx_tmp_3d,
203     .                                   iim*jjmp1*klev,ndex3d)
[474]204c       -----  C2H6
205       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
206     .                  flxesp_i(1:klon,1:klev,2),zx_tmp_3d)
[175]207       CALL histwrite(nid_mth,"flxgl2", itau_w, zx_tmp_3d,
208     .                                   iim*jjmp1*klev,ndex3d)
[474]209c       -----  C2H2
210       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
211     .                  flxesp_i(1:klon,1:klev,3),zx_tmp_3d)
[175]212       CALL histwrite(nid_mth,"flxgl3", itau_w, zx_tmp_3d,
213     .                                   iim*jjmp1*klev,ndex3d)
[474]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)
[175]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
[97]243          if (nmicro.lt.nqmax) then
[3]244           DO iq=nmicro+1,nqmax
245       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
[97]246       CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
[3]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)
[97]252c      CALL histwrite(nid_mth,"c_"//tname(iq),itau_w,zx_tmp_3d,
[3]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)
[97]268      CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]269c
270      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
[97]271      CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]272c
273      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
[97]274      CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]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)
[97]280      CALL histwrite(nid_mth,"SWnet",itau_w,zx_tmp_3d,
[3]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)
[97]285      CALL histwrite(nid_mth,"LWnet",itau_w,zx_tmp_3d,
[3]286     .                                   iim*jjmp1*klev,ndex3d)
287c
[175]288c --------------
289c ----- OPACITE BRUME
[106]290       do k=7,NSPECV,10
[97]291         do i=1,klon
292         do l=1,klev
[106]293           t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
[97]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)
[119]299      CALL histwrite(nid_mth,"thv"//str1,itau_w,zx_tmp_3d,
[97]300     .                                   iim*jjmp1*klev,ndex3d)
[106]301       enddo      ! fin boucle NSPECV
[97]302
[175]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
[106]318       do k=7,NSPECV,10
[97]319         do i=1,klon
320         do l=1,klev
[175]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)
[97]324          if(l.eq.klev)
[175]325     s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
[97]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)
[119]333      CALL histwrite(nid_mth,"khv"//str1,itau_w,zx_tmp_3d,
[97]334     .                                   iim*jjmp1*klev,ndex3d)
[106]335       enddo      ! fin boucle NSPECV
[97]336
[175]337       do k=8,NSPECI,10
[106]338         do i=1,klon
339         do l=1,klev
[175]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))
[106]347         enddo
348         enddo
349         write(str1,'(i2.2)') k
[175]350      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
[106]351      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[175]352      CALL histwrite(nid_mth,"khi"//str1,itau_w,zx_tmp_3d,
[106]353     .                                   iim*jjmp1*klev,ndex3d)
[175]354       enddo      ! fin boucle NSPECI
355c
356c --------------
357c ----- OPACITE GAZ
[106]358       do k=7,NSPECV,10
359         do i=1,klon
360         do l=1,klev
[175]361           t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
[106]362         enddo
363         enddo
364         write(str1,'(i2.2)') k
[175]365      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
[106]366      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[175]367      CALL histwrite(nid_mth,"tgv"//str1,itau_w,zx_tmp_3d,
[106]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
[175]374           t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
[106]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)
[175]380      CALL histwrite(nid_mth,"tgi"//str1,itau_w,zx_tmp_3d,
[106]381     .                                   iim*jjmp1*klev,ndex3d)
382       enddo      ! fin boucle NSPECI
[175]383c
384c --------------
385c ----- EXTINCTION GAZ
386       do k=7,NSPECV,10
[106]387         do i=1,klon
388         do l=1,klev
[175]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)
[106]392          if(l.eq.klev)
[175]393     s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
[106]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)
[175]401      CALL histwrite(nid_mth,"kgv"//str1,itau_w,zx_tmp_3d,
[106]402     .                                   iim*jjmp1*klev,ndex3d)
[175]403       enddo      ! fin boucle NSPECV
[106]404
405       do k=8,NSPECI,10
406         do i=1,klon
407         do l=1,klev
[175]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)
[106]411
412          if(l.eq.klev)
[175]413     s     t_khvd(i,l)=TAUGID(i,klev-l+1,k)
[106]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)
[119]421      CALL histwrite(nid_mth,"kgi"//str1,itau_w,zx_tmp_3d,
[106]422     .                                   iim*jjmp1*klev,ndex3d)
423       enddo      ! fin boucle NSPECI
424
[175]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)
[474]452             CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[175]453             CALL histwrite(nid_mth,"occcld"//str1,itau_w,zx_tmp_3d,
454     .                                   iim*jjmp1*klev,ndex3d)
455           enddo
456c
457        endif 
458c
[3]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)
[97]465      CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
[3]466     .                                   iim*jjmp1*klev,ndex3d)
467c
468      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
[97]469      CALL histwrite(nid_mth,"dtphy",itau_w,zx_tmp_3d,
[3]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)
[97]474      CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
[3]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)
[97]480      CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
[3]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)
[97]486      CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
[3]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)
[97]492      CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
[3]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)
[97]497c     CALL histwrite(nid_mth,"dtec",itau_w,zx_tmp_3d,
[3]498c    .                                   iim*jjmp1*klev,ndex3d)
499c
500      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
[97]501      CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d,
[3]502     .                                   iim*jjmp1*klev,ndex3d)
503c
504      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
[97]505      CALL histwrite(nid_mth,"dudyn",itau_w,zx_tmp_3d,
[3]506     .                                   iim*jjmp1*klev,ndex3d)
507c
508c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
[97]509c     CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d,
[3]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,
[97]520c    $      zx_tmp_2d,iim*jjmp1,ndex2d) 
[3]521c     
522c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
523c      CALL histwrite(nid_mth,"tauy_",itau_w,
[97]524c    $      zx_tmp_2d,iim*jjmp1,ndex2d)
[3]525c
526c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
[97]527c     CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]528c
529c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
[97]530c     CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]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.