source: LMDZ4/trunk/libf/phylmd/write_histrac.h @ 541

Last change on this file since 541 was 541, checked in by lmdzadmin, 20 years ago

Convergence avec la version d'Olivia Coindreau incluant:

  • le offline
  • les thermiques
  • mellor & yamada dans la couche limite

LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.2 KB
Line 
1!
2! $Header$
3!
4      ndex = 0
5      ndex2d = 0
6      ndex3d = 0
7c
8      zsto = pdtphys
9      zout = pdtphys * FLOAT(ecrit_tra)
10      itau_w = itau_phy + nstep
11
12     
13      i = NINT(zout/zsto)
14      CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
15      CALL histwrite(nid_tra,"phis",itau_w,zx_tmp_2d,iim*(jjm+1),ndex2d)
16C
17      CALL gr_fi_ecrit(1,klon,iim,jjm+1,airephy,zx_tmp_2d)     
18      CALL histwrite(nid_tra,"aire",itau_w,zx_tmp_2d,iim*(jjm+1),ndex2d)
19#ifdef INCA
20      CALL gr_fi_ecrit(1, klon,iim,jjm+1, ps,zx_tmp_2d)
21      CALL histwrite(nid_tra,"ps",itau_w,zx_tmp_2d,
22     .     iim*(jjm+1),ndex2d)
23
24      CALL gr_fi_ecrit(1, klon,iim,jjm+1, ptrop,zx_tmp_2d)
25      CALL histwrite(nid_tra,"ptrop",itau_w,zx_tmp_2d,
26     .     iim*(jjm+1),ndex2d)
27
28C   3d FIELDS
29
30      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,t_seri, zx_tmp_3d)
31      CALL histwrite(nid_tra,"temp",itau_w,zx_tmp_3d,
32     .                                   iim*(jjm+1)*klev,ndex3d)
33
34      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,u, zx_tmp_3d)
35      CALL histwrite(nid_tra,"u",itau_w,zx_tmp_3d,
36     .                                   iim*(jjm+1)*klev,ndex3d)
37
38      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,v, zx_tmp_3d)
39      CALL histwrite(nid_tra,"v",itau_w,zx_tmp_3d,
40     .                                   iim*(jjm+1)*klev,ndex3d)
41
42      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,sh, zx_tmp_3d)
43      CALL histwrite(nid_tra,"h2o",itau_w,zx_tmp_3d,
44     .                                   iim*(jjm+1)*klev,ndex3d)
45
46      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pdel, zx_tmp_3d)
47      CALL histwrite(nid_tra,"pdel",itau_w,zx_tmp_3d,
48     .                                   iim*(jjm+1)*klev,ndex3d)
49
50      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pplay, zx_tmp_3d)
51      CALL histwrite(nid_tra,"pmid",itau_w,zx_tmp_3d,
52     .                                   iim*(jjm+1)*klev,ndex3d)
53
54#ifdef INCA_CH4
55#ifdef INCAINFO
56      DO it=1, phtcnt
57      WRITE(str2,'(i2.2)') it
58      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,jrates(1,1,it),
59     .     zx_tmp_3d)
60      CALL histwrite(nid_tra,"j"//str2,itau_w,zx_tmp_3d,
61     .                                   iim*(jjm+1)*klev,ndex3d)
62      ENDDO
63
64      DO it=1, hetcnt
65      WRITE(str2,'(i2.2)') it
66      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,hrates(1,1,it),
67     .     zx_tmp_3d)
68      CALL histwrite(nid_tra,"w"//str2,itau_w,zx_tmp_3d,
69     .                                   iim*(jjm+1)*klev,ndex3d)
70      ENDDO
71
72      DO it=1, extcnt
73      WRITE(str2,'(i2.2)') it
74      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,extflx(1,1,it),
75     .     zx_tmp_3d)
76      CALL histwrite(nid_tra,"ext"//str2,itau_w,zx_tmp_3d,
77     .                                   iim*(jjm+1)*klev,ndex3d)
78      ENDDO
79
80      DO it=1, nfs
81      WRITE(str2,'(i2.2)') it
82      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,invariants(1,1,it),
83     .     zx_tmp_3d)
84      CALL histwrite(nid_tra,"INV"//str2,itau_w,zx_tmp_3d,
85     .                                   iim*(jjm+1)*klev,ndex3d)
86      ENDDO
87#else
88      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,jrates(1,1,2),
89     .     zx_tmp_3d)
90      CALL histwrite(nid_tra,"jO3",itau_w,zx_tmp_3d,
91     .                                   iim*(jjm+1)*klev,ndex3d)
92
93      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,jrates(1,1,4),
94     .     zx_tmp_3d)
95      CALL histwrite(nid_tra,"jNO2",itau_w,zx_tmp_3d,
96     .                                   iim*(jjm+1)*klev,ndex3d)
97
98      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,jrates(1,1,13),
99     .     zx_tmp_3d)
100      CALL histwrite(nid_tra,"jH2O2",itau_w,zx_tmp_3d,
101     .                                   iim*(jjm+1)*klev,ndex3d)
102
103      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,hrates(1,1,1),
104     .     zx_tmp_3d)
105      CALL histwrite(nid_tra,"wHNO3",itau_w,zx_tmp_3d,
106     .                                   iim*(jjm+1)*klev,ndex3d)
107
108      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,krates(1,1,1),
109     .     zx_tmp_3d)
110      CALL histwrite(nid_tra,"kN2O5",itau_w,zx_tmp_3d,
111     .                                   iim*(jjm+1)*klev,ndex3d)
112
113      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,extflx(1,1,1),
114     .     zx_tmp_3d)
115      CALL histwrite(nid_tra,"LghtNO",itau_w,zx_tmp_3d,
116     .                                   iim*(jjm+1)*klev,ndex3d)
117#endif
118      DO it=1, grpcnt
119
120      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,nas(1,1,it),zx_tmp_3d)
121      zx_tmp_3d = zx_tmp_3d * dry_mass / nadv_mass(it)
122      CALL histwrite(nid_tra,grpsym(it),itau_w,zx_tmp_3d,
123     .                                   iim*(jjm+1)*klev,ndex3d)
124      ENDDO
125#endif
126
127#ifdef INCA_AER
128
129      it = id_CIDUSTM
130       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,scavcoef_st(1,1,it),
131     .                  zx_tmp_3d)
132       CALL histwrite(nid_tra,"scavcoef_st",itau_w,zx_tmp_3d,
133     .                  iim*(jjm+1)*klev,ndex3d)
134       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,scavcoef_cv(1,1,it),
135     .                  zx_tmp_3d)
136       CALL histwrite(nid_tra,"scavcoef_cv",itau_w,zx_tmp_3d,
137     .                  iim*(jjm+1)*klev,ndex3d)
138
139       CALL gr_fi_ecrit(1, klon,iim,jjm+1,angst(1),zx_tmp_2d)
140       CALL histwrite(nid_tra2,"AngstroemComp",itau_w,zx_tmp_2d,
141     .                     iim*(jjm+1),ndex2d)
142
143#endif
144#endif
145
146      DO it=1,nqmax
147C champs 2D
148#ifdef INCA
149      IF ( prt_flag_ts(it) == 0 ) CYCLE
150      CALL gr_fi_ecrit(1, klon,iim,jjm+1, eflux(1,it),zx_tmp_2d)
151      CALL histwrite(nid_tra,"Emi_"//solsym(it),itau_w,zx_tmp_2d,
152     .     iim*(jjm+1),ndex2d)
153
154      CALL gr_fi_ecrit(1, klon,iim,jjm+1, dvel(1,it),zx_tmp_2d)
155      CALL histwrite(nid_tra,"Dep_"//solsym(it),itau_w,zx_tmp_2d,
156     .     iim*(jjm+1),ndex2d)
157#ifdef INCA_AER
158      call diag(airephy,tr_seri)
159
160      IF  ((it .ge. trmx) .and. (it .le. trnx)) then
161        CALL gr_fi_ecrit(1, klon,iim,jjm+1,sflux(1,it),zx_tmp_2d)
162        CALL histwrite(nid_tra2,"Sed_"//solsym(it),itau_w,
163     .         zx_tmp_2d,iim*(jjm+1),ndex2d)
164
165        CALL gr_fi_ecrit(1, klon,iim,jjm+1,dflux(1,it),zx_tmp_2d)
166        CALL histwrite(nid_tra2,"Dry_"//solsym(it),itau_w,zx_tmp_2d,
167     .                 iim*(jjm+1),ndex2d)
168        CALL gr_fi_ecrit(1, klon,iim,jjm+1,wflux(1,it),zx_tmp_2d)
169        CALL histwrite(nid_tra2,"Wet_"//solsym(it),itau_w,zx_tmp_2d,
170     .               iim*(jjm+1),ndex2d)
171        CALL gr_fi_ecrit(1, klon,iim,jjm+1,wsflux(1,it),zx_tmp_2d)
172        CALL histwrite(nid_tra2,"WetST_"//solsym(it),itau_w,zx_tmp_2d,
173     .            iim*(jjm+1),ndex2d)
174        CALL gr_fi_ecrit(1, klon,iim,jjm+1,wcflux(1,it),zx_tmp_2d)
175        CALL histwrite(nid_tra2,"WetCV_"//solsym(it),itau_w,zx_tmp_2d,
176     .         iim*(jjm+1),ndex2d)
177
178        CALL gr_fi_ecrit(klev, klon,iim,jjm+1,eflux_alt(1,1,it),zx_tmp_3d)
179        CALL histwrite(nid_tra2,"Emi_alt_"//solsym(it),itau_w,zx_tmp_3d,
180     .              iim*(jjm+1)*klev,ndex3d)
181
182        CALL gr_fi_ecrit(1, klon,iim,jjm+1,aload(1,it),zx_tmp_2d)
183        CALL histwrite(nid_tra2,"Load_"//solsym(it),itau_w,zx_tmp_2d,
184     .              iim*(jjm+1),ndex2d)
185        CALL histwrite(nid_tra3,"Inst_Load_"//solsym(it),itau_w,zx_tmp_2d,
186     .             iim*(jjm+1),ndex2d)
187
188        CALL gr_fi_ecrit(1, klon,iim,jjm+1,sconc(1,it),zx_tmp_2d)
189        CALL histwrite(nid_tra2,"SConc_"//solsym(it),itau_w,zx_tmp_2d,
190     .           iim*(jjm+1),ndex2d)
191
192        do la=1,las
193          CALL gr_fi_ecrit(1, klon,iim,jjm+1,tausum(1,la,it),zx_tmp_2d)
194          CALL histwrite(nid_tra2,"OD_"//cla(la)//solsym(it),itau_w,zx_tmp_2d,
195     .                    iim*(jjm+1),ndex2d)
196        enddo
197
198        CALL gr_fi_ecrit(klev, klon,iim,jjm+1,md(1,1,it),zx_tmp_3d)
199        CALL histwrite(nid_tra2,"MD_"//solsym(it),itau_w,zx_tmp_3d,
200     .              iim*(jjm+1)*klev,ndex3d)
201
202      endif
203#endif
204C champs 3D
205       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,tr_seri(1,1,it),zx_tmp_3d)
206
207       !Prefer vmr to mmr for transported species
208       if( adv_mass(it) /= 0. ) then
209#ifdef INCA_AER
210         if (it .lt. trmx) then
211#endif
212       zx_tmp_3d = zx_tmp_3d * dry_mass / adv_mass(it)
213#ifdef INCA_AER
214         endif
215#endif
216       else
217#ifdef INCA_CH4
218       if ( solsym(it) == 'OX' ) then
219       zx_tmp_3d = zx_tmp_3d * dry_mass / nadv_mass(id_o3)
220       end if
221#endif
222       end if
223
224       CALL histwrite(nid_tra,solsym(it),itau_w,zx_tmp_3d,
225     .                                   iim*(jjm+1)*klev,ndex3d)
226#else
227
228       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,tr_seri(1,1,it),zx_tmp_3d)
229       CALL histwrite(nid_tra,tnom(it+2),itau_w,zx_tmp_3d,
230     .                                   iim*(jjm+1)*klev,ndex3d)
231       if (lessivage) THEN
232       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,flestottr(1,1,it),zx_tmp_3d)
233       CALL histwrite(nid_tra,"fl"//tnom(it+2),itau_w,zx_tmp_3d,
234     .                                   iim*(jjm+1)*klev,ndex3d)
235      endif
236     
237c----Olivia
238       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_th(1,1,it),zx_tmp_3d)
239       CALL histwrite(nid_tra,"d_tr_th_"//tnom(it+2),itau_w,zx_tmp_3d,
240     .                                   iim*(jjm+1)*klev,ndex3d)
241       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_cvi(1,1,it),zx_tmp_3d)
242       CALL histwrite(nid_tra,"d_tr_cv_"//tnom(it+2),itau_w,zx_tmp_3d,
243     .                                   iim*(jjm+1)*klev,ndex3d)
244       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_cli(1,1,it),zx_tmp_3d)
245       CALL histwrite(nid_tra,"d_tr_cl_"//tnom(it+2),itau_w,zx_tmp_3d,
246     .                                   iim*(jjm+1)*klev,ndex3d)
247c---fin Olivia     
248     
249#endif
250      ENDDO
251
252#ifdef INCA
253#ifdef INCA_CH4
254      CALL gr_fi_ecrit(1, klon,iim,jjm+1, o3_tr_col(1), zx_tmp_2d)
255      CALL histwrite(nid_tra,"O3_column",itau_w,zx_tmp_2d,
256     .     iim*(jjm+1),ndex2d)
257
258      CALL gr_fi_ecrit(1, klon,iim,jjm+1, co_tr_col(1), zx_tmp_2d)
259      CALL histwrite(nid_tra,"CO_column",itau_w,zx_tmp_2d,
260     .     iim*(jjm+1),ndex2d)
261
262      CALL gr_fi_ecrit(1, klon,iim,jjm+1, ch4_tr_col(1), zx_tmp_2d)
263      CALL histwrite(nid_tra,"CH4_column",itau_w,zx_tmp_2d,
264     .     iim*(jjm+1),ndex2d)
265
266      CALL gr_fi_ecrit(1, klon,iim,jjm+1, no2_tr_col(1), zx_tmp_2d)
267      CALL histwrite(nid_tra,"NO2_column",itau_w,zx_tmp_2d,
268     .     iim*(jjm+1),ndex2d)
269
270      CALL gr_fi_ecrit(1, klon,iim,jjm+1, o3_st_flx(1), zx_tmp_2d)
271      CALL histwrite(nid_tra,"O3_ste",itau_w,zx_tmp_2d,
272     .     iim*(jjm+1),ndex2d)
273
274      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,o3_prod(1,1),
275     .     zx_tmp_3d)
276      CALL histwrite(nid_tra,"O3_prod",itau_w,zx_tmp_3d,
277     .                                   iim*(jjm+1)*klev,ndex3d)
278
279      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,o3_loss(1,1),
280     .     zx_tmp_3d)
281      CALL histwrite(nid_tra,"O3_loss",itau_w,zx_tmp_3d,
282     .                                   iim*(jjm+1)*klev,ndex3d)
283
284!     ... Special section for daytime averaging
285!       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,day_cnt(1,1),
286!    .       zx_tmp_3d)
287!       CALL histwrite(nid_tra,"day_cnt",itau_w,zx_tmp_3d,
288!    .                                  iim*(jjm+1)*klev,ndex3d)
289!       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,no_daytime(1,1),
290!    .       zx_tmp_3d)
291!       CALL histwrite(nid_tra,"NO_day",itau_w,zx_tmp_3d,
292!    .                                  iim*(jjm+1)*klev,ndex3d)
293
294#endif
295#else
296
297C abder
298         CALL gr_fi_ecrit(1,klon,iim,jjm+1,yu1,zx_tmp_2d)
299         CALL histwrite(nid_tra,"pyu1",itau_w,zx_tmp_2d,
300     s                                  iim*(jjm+1),ndex2d)
301
302         CALL gr_fi_ecrit(1,klon,iim,jjm+1,yv1,zx_tmp_2d)
303         CALL histwrite(nid_tra,"pyv1",itau_w,zx_tmp_2d,
304     s                                  iim*(jjm+1),ndex2d)
305
306         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol1,zx_tmp_2d)
307         CALL histwrite(nid_tra,"ftsol1",itau_w,zx_tmp_2d,
308     s                                       iim*(jjm+1),ndex2d)
309
310         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol2,zx_tmp_2d)
311         CALL histwrite(nid_tra,"ftsol2",itau_w,zx_tmp_2d,
312     s                                       iim*(jjm+1),ndex2d)
313
314         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol3,zx_tmp_2d)
315         CALL histwrite(nid_tra,"ftsol3",itau_w,zx_tmp_2d,
316     s                                      iim*(jjm+1),ndex2d)
317
318         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol4,zx_tmp_2d)
319         CALL histwrite(nid_tra,"ftsol4",itau_w,zx_tmp_2d,
320     s                                      iim*(jjm+1),ndex2d)
321
322         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf1,zx_tmp_2d)
323         CALL histwrite(nid_tra,"psrf1",itau_w,zx_tmp_2d,
324     s                                     iim*(jjm+1),ndex2d)
325
326         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf2,zx_tmp_2d)
327         CALL histwrite(nid_tra,"psrf2",itau_w,zx_tmp_2d,
328     s                                     iim*(jjm+1),ndex2d)
329
330         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf3,zx_tmp_2d)
331         CALL histwrite(nid_tra,"psrf3",itau_w,zx_tmp_2d,
332     s                                     iim*(jjm+1),ndex2d)
333
334         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf4,zx_tmp_2d)
335         CALL histwrite(nid_tra,"psrf4",itau_w,zx_tmp_2d,
336     s                                     iim*(jjm+1),ndex2d)
337        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pplay,zx_tmp_3d)
338        CALL histwrite(nid_tra,"pplay",itau_w,zx_tmp_3d,
339     .                  iim*(jjm+1)*klev,ndex3d)
340
341        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,t_seri,zx_tmp_3d)
342        CALL histwrite(nid_tra,"t",itau_w,zx_tmp_3d,
343     .                  iim*(jjm+1)*klev,ndex3d)
344        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pmfu,zx_tmp_3d)
345        CALL histwrite(nid_tra,"mfu",itau_w,zx_tmp_3d,
346     .                  iim*(jjm+1)*klev,ndex3d)
347        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pmfd,zx_tmp_3d)
348        CALL histwrite(nid_tra,"mfd",itau_w,zx_tmp_3d,
349     .                  iim*(jjm+1)*klev,ndex3d)
350        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pen_u,zx_tmp_3d)
351        CALL histwrite(nid_tra,"en_u",itau_w,zx_tmp_3d,
352     .                  iim*(jjm+1)*klev,ndex3d)
353        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pen_d,zx_tmp_3d)
354        CALL histwrite(nid_tra,"en_d",itau_w,zx_tmp_3d,
355     .                  iim*(jjm+1)*klev,ndex3d)
356        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pde_d,zx_tmp_3d)
357        CALL histwrite(nid_tra,"de_d",itau_w,zx_tmp_3d,
358     .                  iim*(jjm+1)*klev,ndex3d)
359        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pde_u,zx_tmp_3d)
360        CALL histwrite(nid_tra,"de_u",itau_w,zx_tmp_3d,
361     .                  iim*(jjm+1)*klev,ndex3d)
362        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,coefh,zx_tmp_3d)
363        CALL histwrite(nid_tra,"coefh",itau_w,zx_tmp_3d,
364     .                  iim*(jjm+1)*klev,ndex3d)
365
366
367c abder
368#endif
369
370      if (ok_sync) then
371         call histsync(nid_tra)
372#ifdef INCA_AER
373         call histsync(nid_tra2)
374         call histsync(nid_tra3)
375#endif
376       endif
377
378
Note: See TracBrowser for help on using the repository browser.