/[MITgcm]/MITgcm_contrib/jscott/igsm/src_chem/chemmonth.F
ViewVC logotype

Annotation of /MITgcm_contrib/jscott/igsm/src_chem/chemmonth.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download)
Thu Sep 17 17:40:32 2009 UTC (15 years, 10 months ago) by jscott
Branch: MAIN
CVS Tags: HEAD
chem module archive

1 jscott 1.1
2     #include "ctrparam.h"
3    
4     ! ============================================================
5     !
6     ! CHEMMONTH1.F: Subroutine for accumulating tracer mixing
7     ! ratios prepared for monthly averaging
8     !
9     ! ------------------------------------------------------------
10     !
11     ! Author: Chien Wang
12     ! MIT Joint Program on Science and Policy
13     ! of Global Change
14     !
15     ! ----------------------------------------------------------
16     !
17     ! Revision History:
18     !
19     ! When Who What
20     ! ---- ---------- -------
21     ! 052000 Chien Wang rev.
22     ! 080200 Chien Wang repack based on CliChem3 & add cpp
23     ! 091901 Chien Wang fix "write(180,*),"
24     ! 092001 Chine Wang add bc and oc
25     ! 051804 Chien Wang rev.
26     !
27     ! ==========================================================
28    
29     ! =====================
30     subroutine chemmonth1
31     ! =====================
32    
33     #include "chem_para"
34     #include "chem_com"
35     #include "BD2G04.COM"
36    
37     ! ------------------------------------------------------
38    
39     #if ( defined CPL_CHEM )
40    
41     do i=1,n3d
42     cfc11m(i,1,1) = cfc11m(i,1,1) + cfc11(i,1,1)
43     cfc12m(i,1,1) = cfc12m(i,1,1) + cfc12(i,1,1)
44     xn2om (i,1,1) = xn2om (i,1,1) + xn2o (i,1,1)
45     o3m (i,1,1) = o3m (i,1,1) + o3 (i,1,1)
46     com (i,1,1) = com (i,1,1) + co (i,1,1)
47     zco2m (i,1,1) = zco2m (i,1,1) + zco2 (i,1,1)
48     hoxm (i,1,1) = hoxm (i,1,1)
49     c & + atomh (i,1,1)
50     & + ho (i,1,1)
51     c & + ho2 (i,1,1)
52     znox = xno (i,1,1) + xno2 (i,1,1)
53     xnoxm (i,1,1) = xnoxm (i,1,1) + znox
54     xnoym (i,1,1) = xnoym (i,1,1) + znox
55     & + xn2o5 (i,1,1)
56     & + hno3 (i,1,1)
57     ch4m (i,1,1) = ch4m (i,1,1) + ch4(i,1,1)
58     so2m (i,1,1) = so2m (i,1,1) + so2(i,1,1)
59     h2so4m(i,1,1) = h2so4m(i,1,1) + h2so4(i,1,1)
60     sviodm(i,1,1) = sviodm(i,1,1) + sviod(i,1,1)
61    
62     #ifdef INC_3GASES
63     ! === if hfc, pfc, and sf6 are included:
64     ! === 032698
65     hfc134am(i,1,1) = hfc134am(i,1,1) + hfc134a(i,1,1)
66     pfcm (i,1,1) = pfcm (i,1,1) + pfc(i,1,1)
67     sf6m (i,1,1) = sf6m (i,1,1) + sf6(i,1,1)
68     ! ===
69     #endif
70     bcm (i,1,1) = bcm (i,1,1) + bcarbon(i,1,1)
71     ocm (i,1,1) = ocm (i,1,1) + ocarbon(i,1,1)
72     bcodm (i,1,1) = bcodm (i,1,1) + bcod (i,1,1)
73     ocodm (i,1,1) = ocodm (i,1,1) + ocod (i,1,1)
74     end do
75    
76     monthstep=monthstep+1
77    
78     #endif
79    
80     return
81     end
82    
83     ! =====================
84     subroutine chemmonth2
85     ! =====================
86    
87     ! =============================================================
88     !
89     ! CHEMMONTH2.F: Subroutine for calculating monthly averaged
90     ! mixing ratios of tracers
91     ! -------------------------------------------------------------
92     ! Author: Chien Wang
93     ! MIT Joint Program on Science and Policy
94     ! of Global Change
95     ! Last Revised: June 29, 1999
96     !
97     ! =============================================================
98    
99     #include "chem_para"
100     #include "chem_const1"
101     #include "chem_com"
102     #include "BD2G04.COM"
103    
104     #if ( defined CPL_META )
105     #include "chem_meta"
106     #endif
107    
108     ! ---------------------------------------------------------
109    
110     #if ( defined CPL_CHEM )
111    
112     haha=1./float(monthstep)
113    
114     c calculate monthly averaged values:
115    
116     do i=1,n3d
117     cfc11m(i,1,1) = cfc11m(i,1,1)*haha
118     cfc12m(i,1,1) = cfc12m(i,1,1)*haha
119     xn2om (i,1,1) = xn2om (i,1,1)*haha
120     o3m (i,1,1) = o3m (i,1,1)*haha
121     com (i,1,1) = com (i,1,1)*haha
122     zco2m (i,1,1) = zco2m (i,1,1)*haha
123     hoxm (i,1,1) = hoxm (i,1,1)*haha
124     xnoxm (i,1,1) = xnoxm (i,1,1)*haha
125     xnoym (i,1,1) = xnoym (i,1,1)*haha
126     ch4m (i,1,1) = ch4m (i,1,1)*haha
127     so2m (i,1,1) = so2m (i,1,1)*haha
128     h2so4m(i,1,1) = h2so4m(i,1,1)*haha
129     sviodm(i,1,1) = sviodm(i,1,1)*haha
130    
131     #ifdef INC_3GASES
132     ! === if hfc, pfc, and sf6 are included:
133     ! === 032698:
134     hfc134am(i,1,1) = hfc134am(i,1,1)*haha
135     pfcm (i,1,1) = pfcm (i,1,1)*haha
136     sf6m (i,1,1) = sf6m (i,1,1)*haha
137     #endif
138     bcm (i,1,1) = bcm (i,1,1)*haha
139     ocm (i,1,1) = ocm (i,1,1)*haha
140     bcodm (i,1,1) = bcodm (i,1,1)*haha
141     ocodm (i,1,1) = ocodm (i,1,1)*haha
142     end do
143    
144     write(169)cfc11m
145     write(169)cfc12m
146     write(169)xn2om
147     write(169)o3m
148     write(169)com
149     write(169)zco2m
150     write(169)hoxm
151     write(169)xnoxm
152     write(169)xnoym
153     write(169)ch4m
154     write(169)so2m
155     write(169)h2so4m
156     write(169)sviodm
157     write(169)bcm
158     write(169)ocm
159     write(169)bcodm
160     write(169)ocodm
161    
162     #ifdef INC_3GASES
163     ! === if hfc, pfc, and sf6 are included:
164     ! === 032698:
165     write(179)hfc134am
166     write(179)pfcm
167     write(179)sf6m
168     #endif
169    
170     c === 032697
171     c === add diagnostic output:
172     c
173     write(177)photo_co
174     write(177)photo_ch4
175     write(177)photo_o3
176     write(177)photo_svi
177     write(177)photo_no
178     write(177)photo_no2
179     write(177)photo_nv
180     write(177)photo_ch2o
181    
182     #if ( defined CPL_META )
183     !
184     ! === 020999
185     ! === monthly avaraged meta model results
186     !
187     haha = 1./float(nstep_meta)
188     do j=1,nlat
189     do ntype=1,3
190     do i=1,meta_nvar
191     results_mon(i,ntype,j) = results_mon (i,ntype,j)*haha
192     end do
193     end do
194     end do
195     nstep_meta = 0
196    
197     write(181)results_mon
198    
199     do j=1,nlat
200     do ntype=1,3
201     do i=1,meta_nvar
202     results_mon(i,ntype,j) = 0.0
203     end do
204     end do
205     end do
206     #endif
207    
208     c calculate tropospheric mass-averaged mixing ratios:
209    
210     !
211     ! --- NOTE: Currently for N_LEV == 9 & N_LEV == 11
212     ! troposphere is defined from 1 to 7, therefore
213     ! no cpp control is applied here
214     !
215     tropmass = 0.0
216     do j=1,nlat
217     do k=1,n_tropopause
218     tropmass = tropmass + airmass(1,j,k)
219     enddo
220     enddo
221    
222     globalmass = tropmass
223     do j=1,nlat
224     do k=n_tropopause+1,nlev
225     globalmass = globalmass + airmass(1,j,k)
226     enddo
227     enddo
228    
229     tropmass = 28.97296245/tropmass
230     globalmass_m = 1./globalmass
231     globalmass = 28.97296245/globalmass
232    
233     cfc11global = 0.0
234     cfc12global = 0.0
235     xn2oglobal = 0.0
236     o3global = 0.0
237     zco2trop = 0.0
238     coglobal = 0.0
239     ch4global = 0.0
240     bcglobal = 0.0
241     ocglobal = 0.0
242    
243     #ifdef INC_3GASES
244     ! === 032698:
245     hfc134aglobal = 0.0
246     pfcglobal = 0.0
247     sf6global = 0.0
248     #endif
249    
250     do k=1,n_tropopause
251     do j=1,nlat
252     cfc11global = cfc11global
253     & + airmass(1,j,k)
254     & *cfc11m (1,j,k)
255     cfc12global = cfc12global
256     & + airmass(1,j,k)
257     & *cfc12m (1,j,k)
258     xn2oglobal = xn2oglobal
259     & + airmass(1,j,k)
260     & *xn2om (1,j,k)
261     o3global = o3global
262     & + airmass(1,j,k)
263     & *o3m (1,j,k)
264     zco2trop = zco2trop
265     & + airmass(1,j,k)
266     & *zco2m (1,j,k)
267     coglobal = coglobal
268     & + airmass(1,j,k)
269     & *com (1,j,k)
270     ch4global = ch4global
271     & + airmass(1,j,k)
272     & *ch4m (1,j,k)
273     bcglobal = bcglobal
274     & + airmass(1,j,k)
275     & *bcm (1,j,k)
276     ocglobal = ocglobal
277     & + airmass(1,j,k)
278     & *ocm (1,j,k)
279    
280     #ifdef INC_3GASES
281     ! === if hfc, pfc, and sf6 are included:
282     ! === 032698:
283     hfc134aglobal = hfc134aglobal
284     & + airmass(1,j,k)
285     & *hfc134am (1,j,k)
286     pfcglobal = pfcglobal
287     & + airmass(1,j,k)
288     & *pfcm (1,j,k)
289     sf6global = sf6global
290     & + airmass(1,j,k)
291     & *sf6m (1,j,k)
292     #endif
293     enddo
294     enddo
295    
296     zco2global = zco2trop
297     do k=n_tropopause+1,nlev
298     do j=1,nlat
299     zco2global = zco2global
300     & + airmass(1,j,k)
301     & *zco2m (1,j,k)
302     bcglobal = bcglobal
303     & + airmass(1,j,k)
304     & *bcm (1,j,k)
305     ocglobal = ocglobal
306     & + airmass(1,j,k)
307     & *ocm (1,j,k)
308     enddo
309     enddo
310    
311     cfc11global = cfc11global*tropmass/137.3675*1.e3 !pptv
312     cfc12global = cfc12global*tropmass/120.9054*1.e3 !pptv
313     xn2oglobal = xn2oglobal *tropmass/44.0000 !ppbv
314     o3global = o3global *tropmass/47.9982 !ppbv
315     zco2trop = zco2trop *tropmass/44.0098*1.e-3 !ppmv
316     zco2global = zco2global *globalmass/44.0098*1.e-3 !ppmv
317     coglobal = coglobal *tropmass/28.0104 !ppbv
318     ch4global = ch4global *tropmass/16.0426*1.e-3 !ppmv
319     bcglobal = bcglobal *globalmass_m*1.e3 !pptm
320     ocglobal = ocglobal *globalmass_m*1.e3 !pptm
321    
322     c write(176,101)cfc11global,cfc12global,xn2oglobal,
323     c & o3global,zco2trop,zco2global,coglobal,ch4global
324     c101 format(8f11.3)
325    
326     c 020196:
327     !monthnumber = (myyear - 1)*12 + mymonth
328     monthnumber = (iyearchem - 1)*12 + mymonth
329    
330     write(176,101)monthnumber,cfc11global,cfc12global,xn2oglobal,
331     & o3global,zco2trop,zco2global,coglobal,ch4global,
332     & bcglobal,ocglobal
333     101 format(i6,10f10.3)
334    
335     #ifdef INC_3GASES
336     ! ===== if hfc, pfc, and sf6 are included:
337     ! === 032698:
338     hfc134aglobal = hfc134aglobal
339     & *tropmass/awHFC134a*1.e3 !pptv
340     pfcglobal = pfcglobal
341     & *tropmass/awPFmethane*1.e3 !pptv
342     sf6global = sf6global
343     & *tropmass/awSF6*1.e3 !pptv
344    
345     write(180,102)monthnumber,
346     & hfc134aglobal,pfcglobal,sf6global
347     102 format(i6,3f10.3)
348     #endif
349    
350     do i=1,n3d
351     cfc11m(i,1,1) = 0.0
352     cfc12m(i,1,1) = 0.0
353     xn2om (i,1,1) = 0.0
354     o3m (i,1,1) = 0.0
355     com (i,1,1) = 0.0
356     zco2m (i,1,1) = 0.0
357     hoxm (i,1,1) = 0.0
358     xnoxm (i,1,1) = 0.0
359     xnoym (i,1,1) = 0.0
360     ch4m (i,1,1) = 0.0
361     so2m (i,1,1) = 0.0
362     h2so4m(i,1,1) = 0.0
363     sviodm(i,1,1) = 0.0
364    
365     #ifdef INC_3GASES
366     ! === if hfc, pfc, and sf6 are included:
367     ! === 032698:
368     hfc134am(i,1,1) = 0.0
369     pfcm (i,1,1) = 0.0
370     sf6m (i,1,1) = 0.0
371     #endif
372    
373     bcm (i,1,1) = 0.0
374     ocm (i,1,1) = 0.0
375     bcodm (i,1,1) = 0.0
376     ocodm (i,1,1) = 0.0
377    
378     ! === 032697:
379     photo_co (i,1,1) = 0.0
380     photo_ch4 (i,1,1) = 0.0
381     photo_o3 (i,1,1) = 0.0
382     photo_svi (i,1,1) = 0.0
383     photo_no (i,1,1) = 0.0
384     photo_no2 (i,1,1) = 0.0
385     photo_nv (i,1,1) = 0.0
386     photo_ch2o(i,1,1) = 0.0
387     enddo
388    
389     monthstep=0
390    
391     #endif
392    
393     return
394     end
395    
396    

  ViewVC Help
Powered by ViewVC 1.1.22