source: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/write_histrac.h @ 5080

Last change on this file since 5080 was 634, checked in by Laurent Fairhead, 20 years ago

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