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

Last change on this file since 1203 was 634, checked in by Laurent Fairhead, 19 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
RevLine 
[524]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)
[634]14cym      CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
15      CALL histwrite_phy(nid_tra,"phis",itau_w,pphis)
[524]16C
[634]17cym      CALL gr_fi_ecrit(1,klon,iim,jjm+1,airephy,zx_tmp_2d)     
18      CALL histwrite_phy(nid_tra,"aire",itau_w,airephy)
[524]19#ifdef INCA
[634]20cym      CALL gr_fi_ecrit(1, klon,iim,jjm+1, ps,zx_tmp_2d)
21      CALL histwrite_phy(nid_tra,"ps",itau_w,ps)
[524]22
[634]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)
[524]26
27C   3d FIELDS
[634]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)
[524]32
[634]33cym      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,u, zx_tmp_3d)
34      CALL histwrite_phy(nid_tra,"u",itau_w,u)
[524]35
[634]36cym      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,v, zx_tmp_3d)
37      CALL histwrite_phy(nid_tra,"v",itau_w,v)
[524]38
[634]39cym      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,sh, zx_tmp_3d)
40      CALL histwrite_phy(nid_tra,"h2o",itau_w,sh)
[524]41
[634]42cym      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pdel, zx_tmp_3d)
43      CALL histwrite_phy(nid_tra,"pdel",itau_w,pdel)
[524]44
[634]45cym      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pplay, zx_tmp_3d)
46      CALL histwrite_phy(nid_tra,"pmid",itau_w,pplay)
[524]47
48
[616]49! Ajout Anne
50!#ifdef INCA_AER
[634]51c      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,airm, zx_tmp_3d)
52      CALL histwrite_phy(nid_tra,"airm",itau_w,airm)
[616]53!#endif
54
55! Fin ajout Anne
56
57#ifdef INCA
[524]58#ifdef INCAINFO
59      DO it=1, phtcnt
60      WRITE(str2,'(i2.2)') it
[634]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))
[524]64      ENDDO
65
66      DO it=1, hetcnt
67      WRITE(str2,'(i2.2)') it
[634]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))
[524]71      ENDDO
72
73      DO it=1, extcnt
74      WRITE(str2,'(i2.2)') it
[634]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))
[524]78      ENDDO
79
80      DO it=1, nfs
81      WRITE(str2,'(i2.2)') it
[634]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))
[524]85      ENDDO
86#else
[634]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))
[524]90
[634]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))
[524]94
[634]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))
[524]98
[634]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))
[524]102
[634]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))
[524]106
[634]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))
[524]110#endif
111      DO it=1, grpcnt
112
[634]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))
[524]117      ENDDO
118#endif
119
120#ifdef INCA_AER
121
122      it = id_CIDUSTM
[634]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))
[524]131
132       CALL gr_fi_ecrit(1, klon,iim,jjm+1,angst(1),zx_tmp_2d)
[634]133       CALL histwrite_phy(nid_tra2,"AngstroemComp",itau_w,angst(:))
[524]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
[634]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))
[524]145
[634]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))
[524]149#ifdef INCA_AER
150      call diag(airephy,tr_seri)
151
152      IF  ((it .ge. trmx) .and. (it .le. trnx)) then
[634]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))
[524]156
[634]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))
[524]169
[634]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))
[524]173
[634]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))
[524]179
[634]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))
[524]183
184        do la=1,las
[634]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))
[524]188        enddo
189
[634]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))
[524]193
194      endif
195#endif
196C champs 3D
[634]197cym       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,tr_seri(1,1,it),zx_tmp_3d)
[524]198
[634]199       zx_tmp_fi3d(:,:)=tr_seri(:,:,it)
[524]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
[634]205       zx_tmp_fi3d(:,:)= zx_tmp_fi3d(:,:) * dry_mass / adv_mass(it)
[524]206#ifdef INCA_AER
207         endif
208#endif
209       else
[616]210#ifdef INCA
[524]211       if ( solsym(it) == 'OX' ) then
[634]212       zx_tmp_fi3d(:,:)=zx_tmp_fi3d(:,:)*dry_mass/nadv_mass(id_o3)
[524]213       end if
214#endif
215       end if
216
[634]217       CALL histwrite_phy(nid_tra,solsym(it),itau_w,zx_tmp_fi3d)
[524]218#else
219
[634]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))
[524]222       if (lessivage) THEN
[634]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))
[524]226      endif
[541]227     
228c----Olivia
[634]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))
[541]238c---fin Olivia     
239     
[524]240#endif
241      ENDDO
242
243#ifdef INCA
[616]244!#ifdef INCA_CH4
[634]245      CALL histwrite_phy(nid_tra,"O3_column",itau_w,o3_col)
[524]246
[634]247      CALL histwrite_phy(nid_tra,"CO_column",itau_w,co_col)
[524]248
[634]249      CALL histwrite_phy(nid_tra,"CH4_column",itau_w,ch4_col)
[524]250
[634]251      CALL histwrite_phy(nid_tra,"NO2_column",itau_w,no2_col)
[524]252
[634]253      CALL histwrite_phy(nid_tra,"O3_ste",itau_w,o3_st_flx)
[524]254
[634]255      CALL histwrite_phy(nid_tra,"O3_prod",itau_w,o3_prod)
[524]256
[634]257      CALL histwrite_phy(nid_tra,"O3_loss",itau_w,o3_loss)
258
[624]259! Ajout Anne
260#ifdef INCA_AER
261! for sulfur cycle
[524]262
[634]263      CALL histwrite_phy(nid_tra,"SO2_p_dmsoh",itau_w,SO2_p_dmsoh)
[624]264
[634]265      CALL histwrite_phy(nid_tra,"SO2_p_dmsno3",itau_w,SO2_p_dmsno3)
[624]266
[634]267      CALL histwrite_phy(nid_tra,"SO2_p_h2soh",itau_w,SO2_p_h2soh)
[624]268
[634]269      CALL histwrite_phy(nid_tra,"SO2_p_dmsooh",itau_w,SO2_p_dmsooh)
[624]270
[634]271      CALL histwrite_phy(nid_tra,"DMSO_p_dmsoh",itau_w,DMSO_p_dmsoh)
[624]272
[634]273      CALL histwrite_phy(nid_tra,"ASMSAM_p_dmsooh",itau_w,ASMSAM_p_dmsooh)
[624]274
[634]275      CALL histwrite_phy(nid_tra,"ASSO4M_p_so2oh",itau_w,ASSO4M_p_so2oh)
[624]276
[634]277      CALL histwrite_phy(nid_tra,"ASSO4M_p_so2h2o2",itau_w,ASSO4M_p_so2h2o2)
[624]278
[634]279      CALL histwrite_phy(nid_tra,"ASSO4M_p_so2o3",itau_w,ASSO4M_p_so2o3)
280
[624]281c closing the sulfur budget
[634]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)
[624]286
287
[634]288      CALL histwrite_phy(nid_tra,"PH_HIST",itau_w,PH_HIST)
[624]289#endif
290
291#ifdef INCA_NMHC
[634]292      CALL histwrite_phy(nid_tra,"CO2_basprod",itau_w,CO2_basprod)
[624]293
[634]294      CALL histwrite_phy(nid_tra,"CO2_nmhcprod",itau_w,CO2_nmhcprod)
[624]295
[634]296      CALL histwrite_phy(nid_tra,"CO2_radicalprod",itau_w,CO2_radicalprod)
[624]297
[634]298      CALL histwrite_phy(nid_tra,"HNO3_prod",itau_w,hno3_prod)
[624]299
[634]300      CALL histwrite_phy(nid_tra,"HNO3_loss",itau_w,hno3_loss)
[624]301
[634]302      CALL histwrite_phy(nid_tra,"CO_prod",itau_w,co_prod)
[624]303
[634]304      CALL histwrite_phy(nid_tra,"CO_loss",itau_w,co_loss)
[624]305
306#endif
307
308! Fin ajout Anne
309
[524]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
[616]320!#endif
[524]321#else
322
323C abder
[634]324cym         CALL gr_fi_ecrit(1,klon,iim,jjm+1,yu1,zx_tmp_2d)
325         CALL histwrite_phy(nid_tra,"pyu1",itau_w,yu1)
[524]326
[634]327cym         CALL gr_fi_ecrit(1,klon,iim,jjm+1,yv1,zx_tmp_2d)
328         CALL histwrite_phy(nid_tra,"pyv1",itau_w,yv1)
[524]329
[634]330cym         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol1,zx_tmp_2d)
331         CALL histwrite_phy(nid_tra,"ftsol1",itau_w,pftsol1)
[524]332
[634]333cym         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol2,zx_tmp_2d)
334         CALL histwrite_phy(nid_tra,"ftsol2",itau_w,pftsol2)
[524]335
[634]336cym         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol3,zx_tmp_2d)
337         CALL histwrite_phy(nid_tra,"ftsol3",itau_w,pftsol3)
[524]338
[634]339cym         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol4,zx_tmp_2d)
340         CALL histwrite_phy(nid_tra,"ftsol4",itau_w,pftsol4)
[524]341
[634]342cym         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf1,zx_tmp_2d)
343         CALL histwrite_phy(nid_tra,"psrf1",itau_w,ppsrf1)
[524]344
[634]345cym         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf2,zx_tmp_2d)
346         CALL histwrite_phy(nid_tra,"psrf2",itau_w,ppsrf2)
[524]347
[634]348cym         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf3,zx_tmp_2d)
349         CALL histwrite_phy(nid_tra,"psrf3",itau_w,ppsrf3)
[524]350
[634]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)
[524]356
[634]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)
[524]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.