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

Last change on this file since 406 was 306, checked in by slebonnois, 14 years ago

SLebonnois: correction de bugs dans la physique Titan:

  • effg.F : Z doit etre en km, donc conversion
  • optc*_1pt_2.F : On utilise cfffv11 et plus optfrac Du coup, les fichiers input testag* ne sont plus necessaires.
  • phytrac.F : passage de la tendance aerosols en intensif dans tous les cas


File size: 18.2 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, qaer(1,1,iq), zx_tmp_3d)
100c      CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
101c    .                                   iim*jjmp1*klev,ndex3d)
102c          ENDDO
103c    -------   NB AER TOT
104               do i=1,klon
105                 do j=1,klev
106                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,1:nrad))
107                 enddo
108               enddo
109       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
110       CALL histwrite(nid_mth,"qaer",itau_w,zx_tmp_3d,
111     .                                   iim*jjmp1*klev,ndex3d)
112
113             if (clouds.eq.1) then
114
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 ----- PRECIPITATIONS
171c       -----  CH4
172       CALL gr_fi_ecrit(1, klon,iim,jjmp1,prec(:,1),zx_tmp_2d)
173       CALL histwrite(nid_mth,"prech4",itau_w,zx_tmp_2d,
174     .                        iim*jjmp1,ndex2d)
175c       -----  C2H6
176       CALL gr_fi_ecrit(1, klon,iim,jjmp1,prec(:,2),zx_tmp_2d)
177       CALL histwrite(nid_mth,"prec2h6",itau_w,zx_tmp_2d,
178     .                        iim*jjmp1,ndex2d)
179c       -----  C2H2
180       CALL gr_fi_ecrit(1, klon,iim,jjmp1,prec(:,3),zx_tmp_2d)
181       CALL histwrite(nid_mth,"prec2h2",itau_w,zx_tmp_2d,
182     .                        iim*jjmp1,ndex2d)
183c
184c --------------
185c ----- FLUX GLACE
186       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,flxesp_i(1,1,1),zx_tmp_3d)
187       CALL histwrite(nid_mth,"flxgl1", itau_w, zx_tmp_3d,
188     .                                   iim*jjmp1*klev,ndex3d)
189       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,flxesp_i(1,1,2),zx_tmp_3d)
190       CALL histwrite(nid_mth,"flxgl2", itau_w, zx_tmp_3d,
191     .                                   iim*jjmp1*klev,ndex3d)
192       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,flxesp_i(1,1,3),zx_tmp_3d)
193       CALL histwrite(nid_mth,"flxgl3", itau_w, zx_tmp_3d,
194     .                                   iim*jjmp1*klev,ndex3d)
195c
196c --------------
197c ----- RAYON MOYEN GOUTTE
198       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, rmcloud,zx_tmp_3d)
199       CALL histwrite(nid_mth,"rcldbar", itau_w, zx_tmp_3d,
200     .                                   iim*jjmp1*klev,ndex3d)
201c
202             endif
203          endif
204c
205c --------------
206c ----- TRACEURS CHIMIQUES
207          if (nmicro.lt.nqmax) then
208           DO iq=nmicro+1,nqmax
209       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
210       CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
211     .                                   iim*jjmp1*klev,ndex3d)
212           ENDDO
213c Condensation:
214c          DO iq=nmicro+1,nqmax
215c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_tr_mph(1,1,iq),zx_tmp_3d)
216c      CALL histwrite(nid_mth,"c_"//tname(iq),itau_w,zx_tmp_3d,
217c    .                                   iim*jjmp1*klev,ndex3d)
218c          ENDDO
219          endif
220         endif
221c
222      ENDIF !lev_histmth.GE.2
223c
224c-------------------------------------------------------
225      IF(lev_histmth.GE.3) THEN
226c
227cccccccccccccccccc  Radiative transfer
228c
229c 2D
230c
231      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
232      CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
233c
234      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
235      CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
236c
237      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
238      CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
239c
240c 3D
241c
242      zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
243      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
244      CALL histwrite(nid_mth,"SWnet",itau_w,zx_tmp_3d,
245     .                                   iim*jjmp1*klev,ndex3d)
246c
247      zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
248      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
249      CALL histwrite(nid_mth,"LWnet",itau_w,zx_tmp_3d,
250     .                                   iim*jjmp1*klev,ndex3d)
251c
252c --------------
253c ----- OPACITE BRUME
254       do k=7,NSPECV,10
255         do i=1,klon
256         do l=1,klev
257           t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
258         enddo
259         enddo
260         write(str1,'(i2.2)') k
261      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
262      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
263      CALL histwrite(nid_mth,"thv"//str1,itau_w,zx_tmp_3d,
264     .                                   iim*jjmp1*klev,ndex3d)
265       enddo      ! fin boucle NSPECV
266
267       do k=8,NSPECI,10
268         do i=1,klon
269         do l=1,klev
270           t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
271         enddo
272         enddo
273         write(str1,'(i2.2)') k
274      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
275      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
276      CALL histwrite(nid_mth,"thi"//str1,itau_w,zx_tmp_3d,
277     .                                   iim*jjmp1*klev,ndex3d)
278       enddo      ! fin boucle NSPECI
279c
280c --------------
281c ----- EXTINCTION BRUME
282       do k=7,NSPECV,10
283         do i=1,klon
284         do l=1,klev
285          if(l.ne.klev)
286     s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
287     s                -TAUHVD(i,klev-l+1-1,k)
288          if(l.eq.klev)
289     s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
290
291         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
292         enddo
293         enddo
294         write(str1,'(i2.2)') k
295      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
296      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
297      CALL histwrite(nid_mth,"khv"//str1,itau_w,zx_tmp_3d,
298     .                                   iim*jjmp1*klev,ndex3d)
299       enddo      ! fin boucle NSPECV
300
301       do k=8,NSPECI,10
302         do i=1,klon
303         do l=1,klev
304          if(l.ne.klev)
305     s     t_khvd(i,l)=TAUHID(i,klev-l+1,k)
306     s                -TAUHID(i,klev-l+1-1,k)
307          if(l.eq.klev)
308     s     t_khvd(i,l)=TAUHID(i,klev-l+1,k)
309
310         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
311         enddo
312         enddo
313         write(str1,'(i2.2)') k
314      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
315      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
316      CALL histwrite(nid_mth,"khi"//str1,itau_w,zx_tmp_3d,
317     .                                   iim*jjmp1*klev,ndex3d)
318       enddo      ! fin boucle NSPECI
319c
320c --------------
321c ----- OPACITE GAZ
322       do k=7,NSPECV,10
323         do i=1,klon
324         do l=1,klev
325           t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
326         enddo
327         enddo
328         write(str1,'(i2.2)') k
329      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
330      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
331      CALL histwrite(nid_mth,"tgv"//str1,itau_w,zx_tmp_3d,
332     .                                   iim*jjmp1*klev,ndex3d)
333       enddo      ! fin boucle NSPECV
334
335       do k=8,NSPECI,10
336         do i=1,klon
337         do l=1,klev
338           t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
339         enddo
340         enddo
341         write(str1,'(i2.2)') k
342      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
343      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
344      CALL histwrite(nid_mth,"tgi"//str1,itau_w,zx_tmp_3d,
345     .                                   iim*jjmp1*klev,ndex3d)
346       enddo      ! fin boucle NSPECI
347c
348c --------------
349c ----- EXTINCTION GAZ
350       do k=7,NSPECV,10
351         do i=1,klon
352         do l=1,klev
353          if(l.ne.klev)
354     s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
355     s                -TAUGVD(i,klev-l+1-1,k)
356          if(l.eq.klev)
357     s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
358
359         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
360         enddo
361         enddo
362         write(str1,'(i2.2)') k
363      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
364      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
365      CALL histwrite(nid_mth,"kgv"//str1,itau_w,zx_tmp_3d,
366     .                                   iim*jjmp1*klev,ndex3d)
367       enddo      ! fin boucle NSPECV
368
369       do k=8,NSPECI,10
370         do i=1,klon
371         do l=1,klev
372          if(l.ne.klev)
373     s     t_khvd(i,l)=TAUGID(i,klev-l+1,k)
374     s                -TAUGID(i,klev-l+1-1,k)
375
376          if(l.eq.klev)
377     s     t_khvd(i,l)=TAUGID(i,klev-l+1,k)
378
379         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
380         enddo
381         enddo
382         write(str1,'(i2.2)') k
383      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
384      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
385      CALL histwrite(nid_mth,"kgi"//str1,itau_w,zx_tmp_3d,
386     .                                   iim*jjmp1*klev,ndex3d)
387       enddo      ! fin boucle NSPECI
388
389c --------------
390c ----- OPACITE NUAGES (ATTENTION PROXY)
391         if (clouds.eq.1) then
392           zx_tmp_fi3d(1:klon,1:klev)=occcld(1:klon,1:klev)
393           CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
394           CALL histwrite(nid_mth,"tcld",itau_w,zx_tmp_3d,
395     .                                   iim*jjmp1*klev,ndex3d)
396c --------------
397c ----- EXTINCTION NUAGES (ATTENTION PROXY)
398           do i=1,klon
399             t_kcld(i,klev)=occcld(i,klev)
400     .       /(zzlev(i,klev+1)-zzlev(i,klev))
401             do j=klev-1,1,-1
402               t_kcld(i,j)=(occcld(i,j)-occcld(i,j+1))
403     .         /(zzlev(i,j+1)-zzlev(i,j))
404             enddo
405           enddo
406           zx_tmp_fi3d(1:klon,1:klev)=t_kcld(1:klon,1:klev)
407           CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
408           CALL histwrite(nid_mth,"kcld",itau_w,zx_tmp_3d,
409     .                                   iim*jjmp1*klev,ndex3d)
410c
411c --------------
412c ----- OCCURENCE NUAGES
413           do k=1,12
414             write(str1,'(i2.2)') k
415             zx_tmp_fi3d(1:klon,1:klev)=occcld_m(1:klon,1:klev,k)
416             CALL histwrite(nid_mth,"occcld"//str1,itau_w,zx_tmp_3d,
417     .                                   iim*jjmp1*klev,ndex3d)
418           enddo
419c
420        endif 
421c
422      ENDIF !lev_histmth.GE.3
423c
424c-------------------------------------------------------
425      IF(lev_histmth.GE.4) THEN
426c
427      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
428      CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
429     .                                   iim*jjmp1*klev,ndex3d)
430c
431      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
432      CALL histwrite(nid_mth,"dtphy",itau_w,zx_tmp_3d,
433     .                                   iim*jjmp1*klev,ndex3d)
434c K/s
435      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
436      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
437      CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
438     .                                   iim*jjmp1*klev,ndex3d)
439c
440c K/s
441      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
442      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
443      CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
444     .                                   iim*jjmp1*klev,ndex3d)
445c
446c K/s
447      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
448      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
449      CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
450     .                                   iim*jjmp1*klev,ndex3d)
451c
452c K/s     
453      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
454      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
455      CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
456     .                                   iim*jjmp1*klev,ndex3d)
457c K/s     
458c     zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
459c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
460c     CALL histwrite(nid_mth,"dtec",itau_w,zx_tmp_3d,
461c    .                                   iim*jjmp1*klev,ndex3d)
462c
463      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
464      CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d,
465     .                                   iim*jjmp1*klev,ndex3d)
466c
467      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
468      CALL histwrite(nid_mth,"dudyn",itau_w,zx_tmp_3d,
469     .                                   iim*jjmp1*klev,ndex3d)
470c
471c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
472c     CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d,
473c    .                                   iim*jjmp1*klev,ndex3d)
474c
475      ENDIF !lev_histmth.GE.4
476c
477c-------------------------------------------------------
478      IF(lev_histmth.GE.5) THEN
479c
480c
481c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
482c      CALL histwrite(nid_mth,"taux_",itau_w,
483c    $      zx_tmp_2d,iim*jjmp1,ndex2d) 
484c     
485c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
486c      CALL histwrite(nid_mth,"tauy_",itau_w,
487c    $      zx_tmp_2d,iim*jjmp1,ndex2d)
488c
489c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
490c     CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
491c
492c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
493c     CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
494c
495      ENDIF !lev_histmth.GE.5
496c-------------------------------------------------------
497c
498      if (ok_sync) then
499        call histsync(nid_mth)
500      endif
501
502      ENDIF
Note: See TracBrowser for help on using the repository browser.