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

Annotation of /MITgcm_contrib/jscott/igsm/src_chem/chemmass.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     ! CHEMAIRMASS.F: Subroutine for calculating air mass
7     ! in MIT Global Chemistry Model
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     ! 122095 Chien Wang rev.
22     ! 080200 Chien Wang repack based on CliChem3 & add cpp
23     ! 051804 Chien Wang rev.
24     !
25     ! ==========================================================
26    
27     ! =========================
28     Subroutine chemairmass(p)
29     ! =========================
30    
31     #include "chem_para"
32     #include "chem_com"
33     #include "BD2G04.COM"
34    
35     ! ----------------------------------------------------------
36    
37     #if ( defined CPL_CHEM )
38    
39     c-------------------------------
40     c Calculate air mass:
41     c
42     do k=1,nlev
43     do i=1,n2dh
44     airmass(i,1,k) = airmass0(i,1,k)*p(i,1)
45     end do
46     end do
47    
48     #endif
49    
50     return
51     end
52    
53     ! ================================
54     Subroutine chemmass1(x11,xtotal)
55     ! ================================
56    
57     c==================================================================c
58     c c
59     c CHEMMASS1.F: Subroutine for calculating total amount (mass) c
60     c of tracers in MIT Global Chemistry Model c
61     c ------------------------------------------------- c
62     c Author: Chien Wang c
63     c MIT Joint Program on Science and Policy c
64     c of Global Change c
65     c Last Revised on: August 8, 1995 c
66     c c
67     c==================================================================c
68    
69     #include "chem_para"
70     #include "chem_com"
71    
72     dimension x11 (nlon,nlat,nlev)
73    
74     ! --------------------------------------------------------
75    
76     #if ( defined CPL_CHEM )
77    
78     c-------------------------------
79     c Calculate total amount of tracer:
80     c
81     xtotal = 0.0
82     do i=1,n3d
83     xtotal = xtotal
84     & + airmass(i,1,1)
85     & * x11(i,1,1)
86     end do
87    
88     #endif
89    
90     return
91     end
92    
93     ! =======================================
94     Subroutine chemmass2(adjcoe,x11,xtotal)
95     ! =======================================
96    
97     c==================================================================c
98     c c
99     c CHEMMASS2.F: Subroutine for conpensating mass loss during c
100     c simulation based on unified mapping c
101     c in MIT Global Chemistry Model c
102     c ------------------------------------------------- c
103     c Author: Chien Wang c
104     c MIT Joint Program on Science and Policy c
105     c of Global Change c
106     c Last Revised on: September 15, 1995 c
107     c c
108     c==================================================================c
109    
110     #include "chem_para"
111     #include "chem_com"
112    
113     dimension x11 (nlon,nlat,nlev)
114    
115     ! -------------------------------------------------
116    
117     #if ( defined CPL_CHEM )
118    
119     c---------------------------
120     c Readjust tracer's mass:
121     c
122     xtotal2 = 0.0
123     do i=1,n3d
124     xtotal2 = xtotal2
125     & + airmass(i,1,1)
126     & * x11(i,1,1)
127     end do
128    
129     xgain = (xtotal-xtotal2)
130     if(xgain.gt.0) xgain = xgain*adjcoe
131    
132     xratio = xgain
133     & /float(nlat*nlev)
134    
135     do i=1,n3d
136     x11(i,1,1) = max(0.0,x11(i,1,1)
137     & + xratio/airmass(i,1,1))
138     end do
139    
140     #endif
141    
142     return
143     end
144    
145     ! =======================================
146     Subroutine chemmass3(adjcoe,x11,xtotal)
147     ! =======================================
148    
149     c==================================================================c
150     c c
151     c CHEMMASS3.F: Subroutine for conpensating mass loss during c
152     c simulation based on unified mapping c
153     c in MIT Global Chemistry Model c
154     c Old chemmass2
155     c ------------------------------------------------- c
156     c Author: Chien Wang c
157     c MIT Joint Program on Science and Policy c
158     c of Global Change c
159     c Last Revised on: September 15, 1995 c
160     c c
161     c==================================================================c
162    
163     #include "chem_para"
164     #include "chem_com"
165    
166     dimension x11 (nlon,nlat,nlev)
167    
168     ! -------------------------------------------------------
169    
170     #if ( defined CPL_CHEM )
171    
172     c---------------------------
173     c Readjust tracer's mass:
174     c
175     xtotal2 = 0.0
176     do i=1,n3d
177     xtotal2 = xtotal2
178     & + airmass(i,1,1)
179     & * x11(i,1,1)
180     end do
181    
182     xgain = (xtotal-xtotal2)*adjcoe
183     c if(xgain.gt.0) xgain = xgain*adjcoe
184    
185     xratio = xgain
186     & /float(nlat*nlev)
187    
188     do i=1,n3d
189     x11(i,1,1) = max(0.0,x11(i,1,1)
190     & + xratio/airmass(i,1,1))
191     end do
192    
193     #endif
194    
195     return
196     end
197    
198     ! =======================================
199     Subroutine chemmass4(adjcoe,x11,xtotal)
200     ! =======================================
201    
202     c==================================================================c
203     c c
204     c CHEMMASS4.F: Subroutine for conpensating mass loss during c
205     c simulation based on unified mass mapping c
206     c plus N.H. extra share due to lbc loss c
207     c in MIT Global Chemistry Model c
208     c ------------------------------------------------- c
209     c Author: Chien Wang c
210     c MIT Joint Program on Science and Policy c
211     c of Global Change c
212     c Last Revised on: August 8, 1995 c
213     c c
214     c==================================================================c
215    
216     #include "chem_para"
217     #include "chem_com"
218    
219     dimension x11 (nlon,nlat,nlev)
220    
221     ! ----------------------------------------------------
222    
223     #if ( defined CPL_CHEM )
224    
225     c---------------------------
226     c Readjust tracer's mass:
227     c
228     xtotal2 = 0.0
229     do i=1,n3d
230     xtotal2 = xtotal2
231     & + airmass(i,1,1)
232     & * x11(i,1,1)
233     end do
234    
235     xxx = (xtotal-xtotal2)
236     & /float(nlat*nlev)
237    
238     xratio = xxx
239     & *adjcoe
240    
241     xratio2= xxx
242     & *(1.0-adjcoe)/144.
243    
244     do i=1,n3d
245     x11(i,1,1) = x11(i,1,1)
246     & + xratio/airmass(i,1,1)
247     end do
248    
249     i=1
250     ntropics = nlat/2
251     do k=1,n_tropopause
252     do j=ntropics+1,nlat1
253     x11(i,j,k)
254     & = x11(i,j,k)
255     & +(float(ntropics-j))**2
256     & *xratio2/airmass(i,j,k)
257     end do
258     end do
259    
260     #endif
261    
262     return
263     end
264    
265     ! =============================================
266     Subroutine chemmass6(adjyr,adjcoe,x11,xtotal)
267     ! =============================================
268    
269     c==================================================================c
270     c c
271     c CHEMMASS2.F: Subroutine for conpensating mass loss during c
272     c simulation based on unified mapping c
273     c and take away lossed mass directly according c
274     c to the tropospheric life time c
275     c in MIT Global Chemistry Model c
276     c ------------------------------------------------- c
277     c Author: Chien Wang c
278     c MIT Joint Program on Science and Policy c
279     c of Global Change c
280     c Last Revised on: September 15, 1995 c
281     c c
282     c==================================================================c
283    
284     #include "chem_para"
285     #include "chem_com"
286    
287     dimension x11 (nlon,nlat,nlev)
288    
289     ! ----------------------------------------------------
290    
291     #if ( defined CPL_CHEM )
292    
293     c---------------------------
294     c Readjust tracer's mass:
295     c
296     xtotal2 = 0.0
297     do i=1,n3d
298     xtotal2 = xtotal2
299     & + airmass(i,1,1)
300     & * x11(i,1,1)
301     end do
302    
303     xloss = xtotal/(adjyr*8760.) !8760 = 365d x 24h
304     ! and adjyr is in yr
305     xgain = (xtotal-xtotal2)
306     if(xgain.gt.0) xgain = xgain*adjcoe
307    
308     xratio =( xgain
309     & - xloss )
310     & /float(nlat*nlev)
311    
312     do i=1,n3d
313     x11(i,1,1) = max(0.0, x11(i,1,1)
314     & + xratio/airmass(i,1,1))
315     end do
316    
317     #endif
318    
319     return
320     end
321    
322     ! ==============================================
323     Subroutine chemmass66(adjyr,adjcoe,x11,xtotal)
324     ! ==============================================
325    
326     c==================================================================c
327     c c
328     c CHEMMASS2.F: Subroutine for conpensating mass loss during c
329     c simulation based on unified mapping c
330     c and take away lossed mass directly according c
331     c to the tropospheric life time c
332     c in MIT Global Chemistry Model c
333     c ------------------------------------------------- c
334     c Author: Chien Wang c
335     c MIT Joint Program on Science and Policy c
336     c of Global Change c
337     c Last Revised on: July 23, 1997 c
338     c c
339     c==================================================================c
340    
341     #include "chem_para"
342     #include "chem_com"
343    
344     dimension x11 (nlon,nlat,nlev)
345    
346     ! ----------------------------------------------------
347    
348     #if ( defined CPL_CHEM )
349    
350     c---------------------------
351     c Readjust tracer's mass:
352     c
353     c ======
354     c 102596
355     c close this ocean sink to use ocean model calculate co2 uptake
356     !
357     ! --- 080200 reopen under the cpp parameter
358     !
359     #if ( !defined CPL_OCEANCO2 )
360     tropmass = 28.97296245*1.e-3/44.009
361     co2ref = 275./tropmass
362     & /(adjyr*8760.) ! 8760 = 365d x 24h
363     ! and adjyr is in yr
364     #endif
365    
366     xtotal2 = 0.0
367     do i=1,n3d
368     xtotal2 = xtotal2
369     & + airmass(i,1,1)
370     & * x11(i,1,1)
371     end do
372    
373     c 072397:
374     c 101300:
375     #if ( !defined CPL_TEM )
376     xloss = bio_uptake *4.185692e17 ! GTC/yr to 10-9kg/hr
377     #else
378     xloss = 0.0
379     #endif
380    
381     #if ( !defined CPL_OCEANCO2 )
382     & + xtotal/(adjyr*8760.)
383     #endif
384    
385     xgain = (xtotal-xtotal2)
386     if(xgain.gt.0) xgain = xgain*adjcoe
387    
388     xratio =( xgain
389     & - xloss )
390     & /float(nlat*nlev)
391    
392     do i=1,n3d
393     x11(i,1,1) = x11(i,1,1)
394     & + xratio/airmass(i,1,1)
395     #if ( !defined CPL_OCEANCO2 )
396     & + co2ref
397     #endif
398     if ( x11(i,1,1) .le. 0.0 ) x11(i,1,1) = 0.0
399    
400     end do
401    
402     #endif
403    
404     return
405     end
406    

  ViewVC Help
Powered by ViewVC 1.1.22