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

Contents 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 - (show 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
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