source: LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/write_histrac.h @ 3946

Last change on this file since 3946 was 524, checked in by lmdzadmin, 21 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 13.6 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#endif
237      ENDDO
238
239#ifdef INCA
240#ifdef INCA_CH4
241      CALL gr_fi_ecrit(1, klon,iim,jjm+1, o3_tr_col(1), zx_tmp_2d)
242      CALL histwrite(nid_tra,"O3_column",itau_w,zx_tmp_2d,
243     .     iim*(jjm+1),ndex2d)
244
245      CALL gr_fi_ecrit(1, klon,iim,jjm+1, co_tr_col(1), zx_tmp_2d)
246      CALL histwrite(nid_tra,"CO_column",itau_w,zx_tmp_2d,
247     .     iim*(jjm+1),ndex2d)
248
249      CALL gr_fi_ecrit(1, klon,iim,jjm+1, ch4_tr_col(1), zx_tmp_2d)
250      CALL histwrite(nid_tra,"CH4_column",itau_w,zx_tmp_2d,
251     .     iim*(jjm+1),ndex2d)
252
253      CALL gr_fi_ecrit(1, klon,iim,jjm+1, no2_tr_col(1), zx_tmp_2d)
254      CALL histwrite(nid_tra,"NO2_column",itau_w,zx_tmp_2d,
255     .     iim*(jjm+1),ndex2d)
256
257      CALL gr_fi_ecrit(1, klon,iim,jjm+1, o3_st_flx(1), zx_tmp_2d)
258      CALL histwrite(nid_tra,"O3_ste",itau_w,zx_tmp_2d,
259     .     iim*(jjm+1),ndex2d)
260
261      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,o3_prod(1,1),
262     .     zx_tmp_3d)
263      CALL histwrite(nid_tra,"O3_prod",itau_w,zx_tmp_3d,
264     .                                   iim*(jjm+1)*klev,ndex3d)
265
266      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,o3_loss(1,1),
267     .     zx_tmp_3d)
268      CALL histwrite(nid_tra,"O3_loss",itau_w,zx_tmp_3d,
269     .                                   iim*(jjm+1)*klev,ndex3d)
270
271!     ... Special section for daytime averaging
272!       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,day_cnt(1,1),
273!    .       zx_tmp_3d)
274!       CALL histwrite(nid_tra,"day_cnt",itau_w,zx_tmp_3d,
275!    .                                  iim*(jjm+1)*klev,ndex3d)
276!       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,no_daytime(1,1),
277!    .       zx_tmp_3d)
278!       CALL histwrite(nid_tra,"NO_day",itau_w,zx_tmp_3d,
279!    .                                  iim*(jjm+1)*klev,ndex3d)
280
281#endif
282#else
283
284C abder
285         CALL gr_fi_ecrit(1,klon,iim,jjm+1,yu1,zx_tmp_2d)
286         CALL histwrite(nid_tra,"pyu1",itau_w,zx_tmp_2d,
287     s                                  iim*(jjm+1),ndex2d)
288
289         CALL gr_fi_ecrit(1,klon,iim,jjm+1,yv1,zx_tmp_2d)
290         CALL histwrite(nid_tra,"pyv1",itau_w,zx_tmp_2d,
291     s                                  iim*(jjm+1),ndex2d)
292
293         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol1,zx_tmp_2d)
294         CALL histwrite(nid_tra,"ftsol1",itau_w,zx_tmp_2d,
295     s                                       iim*(jjm+1),ndex2d)
296
297         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol2,zx_tmp_2d)
298         CALL histwrite(nid_tra,"ftsol2",itau_w,zx_tmp_2d,
299     s                                       iim*(jjm+1),ndex2d)
300
301         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol3,zx_tmp_2d)
302         CALL histwrite(nid_tra,"ftsol3",itau_w,zx_tmp_2d,
303     s                                      iim*(jjm+1),ndex2d)
304
305         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol4,zx_tmp_2d)
306         CALL histwrite(nid_tra,"ftsol4",itau_w,zx_tmp_2d,
307     s                                      iim*(jjm+1),ndex2d)
308
309         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf1,zx_tmp_2d)
310         CALL histwrite(nid_tra,"psrf1",itau_w,zx_tmp_2d,
311     s                                     iim*(jjm+1),ndex2d)
312
313         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf2,zx_tmp_2d)
314         CALL histwrite(nid_tra,"psrf2",itau_w,zx_tmp_2d,
315     s                                     iim*(jjm+1),ndex2d)
316
317         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf3,zx_tmp_2d)
318         CALL histwrite(nid_tra,"psrf3",itau_w,zx_tmp_2d,
319     s                                     iim*(jjm+1),ndex2d)
320
321         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf4,zx_tmp_2d)
322         CALL histwrite(nid_tra,"psrf4",itau_w,zx_tmp_2d,
323     s                                     iim*(jjm+1),ndex2d)
324        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pplay,zx_tmp_3d)
325        CALL histwrite(nid_tra,"pplay",itau_w,zx_tmp_3d,
326     .                  iim*(jjm+1)*klev,ndex3d)
327
328        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,t_seri,zx_tmp_3d)
329        CALL histwrite(nid_tra,"t",itau_w,zx_tmp_3d,
330     .                  iim*(jjm+1)*klev,ndex3d)
331        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pmfu,zx_tmp_3d)
332        CALL histwrite(nid_tra,"mfu",itau_w,zx_tmp_3d,
333     .                  iim*(jjm+1)*klev,ndex3d)
334        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pmfd,zx_tmp_3d)
335        CALL histwrite(nid_tra,"mfd",itau_w,zx_tmp_3d,
336     .                  iim*(jjm+1)*klev,ndex3d)
337        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pen_u,zx_tmp_3d)
338        CALL histwrite(nid_tra,"en_u",itau_w,zx_tmp_3d,
339     .                  iim*(jjm+1)*klev,ndex3d)
340        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pen_d,zx_tmp_3d)
341        CALL histwrite(nid_tra,"en_d",itau_w,zx_tmp_3d,
342     .                  iim*(jjm+1)*klev,ndex3d)
343        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pde_d,zx_tmp_3d)
344        CALL histwrite(nid_tra,"de_d",itau_w,zx_tmp_3d,
345     .                  iim*(jjm+1)*klev,ndex3d)
346        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pde_u,zx_tmp_3d)
347        CALL histwrite(nid_tra,"de_u",itau_w,zx_tmp_3d,
348     .                  iim*(jjm+1)*klev,ndex3d)
349        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,coefh,zx_tmp_3d)
350        CALL histwrite(nid_tra,"coefh",itau_w,zx_tmp_3d,
351     .                  iim*(jjm+1)*klev,ndex3d)
352
353
354c abder
355#endif
356
357      if (ok_sync) then
358         call histsync(nid_tra)
359#ifdef INCA_AER
360         call histsync(nid_tra2)
361         call histsync(nid_tra3)
362#endif
363       endif
364
365
Note: See TracBrowser for help on using the repository browser.