Context Navigation

concentrations.F @ 690

Last change on this file since 690 was 635, checked in by emillour, 13 years ago

Mars GCM: Update of the chemistry package, including:

93 reactions are accounted for (instead of 22); tracking 28 species (instead of 11)
computation of photoabsorption using raytracing
improved time stepping in the photochemistry
updated parameters (cross-sections); with this new version input files

are in 'EUV/param_v5' of "datafile" directory.

transition between lower and upper atmosphere chemistry set to 0.1 Pa (calchim.F90)
Lots of code clean-up: removed obsolete files column.F, param_v3.h, flujo.F, phdisrate.F, ch.F, interpfast.F, paramfoto.F, getch.F Converted chemtermos.F -> chemthermos.F90 and euvheat.F -> euvheat.F90. Added paramfoto_compact.F , param_v4.h and iono.h
Upadted surfacearea.F
Cleaned initracer.F and callkeys.h (removed use of obsolete "nqchem" and "oldnames" case when initializing tracers).
Minor correction in "callsedim": compute "rdust" and/or "rice" only when it makes sense.

FGG+FL+EM

File size: 7.5 KB

Line
1	SUBROUTINE concentrations(pplay,pt,pdt,pq,pdq,ptimestep)
2
3	implicit none
4
5	!=======================================================================
6	! CALCULATION OF MEAN MOLECULAR MASS, Cp, Akk and R
7	!
8	! mmean(ngridmx,nlayermx) amu
9	! cpnew(ngridmx,nlayermx) J/kg/K
10	! rnew(ngridmx,nlayermx) J/kg/K
11	! akknew(ngridmx,nlayermx) coefficient of thermal concduction
12	!
13	! version: April 2012 - Franck Lefevre
14	!=======================================================================
15
16	! declarations
17
18	#include "dimensions.h"
19	#include "dimphys.h"
20	#include "comcstfi.h"
21	#include "callkeys.h"
22	#include "comdiurn.h"
23	#include "chimiedata.h"
24	#include "tracer.h"
25	#include "conc.h"
26
27	! input/output
28
29	real pplay(ngridmx,nlayermx)
30	real pt(ngridmx,nlayermx)
31	real pdt(ngridmx,nlayermx)
32	real pq(ngridmx,nlayermx,nqmx)
33	real pdq(ngridmx,nlayermx,nqmx)
34	real ptimestep
35
36	! local variables
37
38	integer :: i, l, ig, iq
39	integer, save :: nbq, niq(nqmx)
40	real :: ni(nqmx), ntot
41	real :: zq(ngridmx, nlayermx, nqmx)
42	real :: zt(ngridmx, nlayermx)
43	real, save :: aki(nqmx)
44	real, save :: cpi(nqmx)
45
46	logical, save :: firstcall = .true.
47
48	if (firstcall) then
49
50	! find index of chemical tracers to use
51	! initialize thermal conductivity and specific heat coefficients
52	! !? values are estimated
53
54	nbq = 0 ! to count number of tracers used in this subroutine
55
56	if (igcm_co2 /= 0) then
57	nbq = nbq + 1
58	niq(nbq) = igcm_co2
59	aki(nbq) = 3.072e-4
60	cpi(nbq) = 0.834e3
61	end if
62	if (igcm_co /= 0) then
63	nbq = nbq + 1
64	niq(nbq) = igcm_co
65	aki(nbq) = 4.87e-4
66	cpi(nbq) = 1.034e3
67	end if
68	if (igcm_o /= 0) then
69	nbq = nbq + 1
70	niq(nbq) = igcm_o
71	aki(nbq) = 7.59e-4
72	cpi(nbq) = 1.3e3
73	end if
74	if (igcm_o1d /= 0) then
75	nbq = nbq + 1
76	niq(nbq) = igcm_o1d
77	aki(nbq) = 7.59e-4 !?
78	cpi(nbq) = 1.3e3 !?
79	end if
80	if (igcm_o2 /= 0) then
81	nbq = nbq + 1
82	niq(nbq) = igcm_o2
83	aki(nbq) = 5.68e-4
84	cpi(nbq) = 0.9194e3
85	end if
86	if (igcm_o3 /= 0) then
87	nbq = nbq + 1
88	niq(nbq) = igcm_o3
89	aki(nbq) = 3.00e-4 !?
90	cpi(nbq) = 0.800e3 !?
91	end if
92	if (igcm_h /= 0) then
93	nbq = nbq + 1
94	niq(nbq) = igcm_h
95	aki(nbq) = 0.0
96	cpi(nbq) = 20.780e3
97	end if
98	if (igcm_h2 /= 0) then
99	nbq = nbq + 1
100	niq(nbq) = igcm_h2
101	aki(nbq) = 36.314e-4
102	cpi(nbq) = 14.266e3
103	end if
104	if (igcm_oh /= 0) then
105	nbq = nbq + 1
106	niq(nbq) = igcm_oh
107	aki(nbq) = 7.00e-4 !?
108	cpi(nbq) = 1.045e3
109	end if
110	if (igcm_ho2 /= 0) then
111	nbq = nbq + 1
112	niq(nbq) = igcm_ho2
113	aki(nbq) = 0.0
114	cpi(nbq) = 1.065e3 !?
115	end if
116	if (igcm_n2 /= 0) then
117	nbq = nbq + 1
118	niq(nbq) = igcm_n2
119	aki(nbq) = 5.6e-4
120	cpi(nbq) = 1.034e3
121	end if
122	if (igcm_ar /= 0) then
123	nbq = nbq + 1
124	niq(nbq) = igcm_ar
125	aki(nbq) = 0.0 !?
126	cpi(nbq) = 1.000e3 !?
127	end if
128	if (igcm_h2o_vap /= 0) then
129	nbq = nbq + 1
130	niq(nbq) = igcm_h2o_vap
131	aki(nbq) = 0.0
132	cpi(nbq) = 1.870e3
133	end if
134	if (igcm_n /= 0) then
135	nbq = nbq + 1
136	niq(nbq) = igcm_n
137	aki(nbq) = 0.0
138	cpi(nbq) = 0.0
139	endif
140	if(igcm_no /= 0) then
141	nbq = nbq + 1
142	niq(nbq) = igcm_no
143	aki(nbq) = 0.0
144	cpi(nbq) = 0.0
145	endif
146	if(igcm_no2 /= 0) then
147	nbq = nbq + 1
148	niq(nbq) = igcm_no2
149	aki(nbq) = 0.0
150	cpi(nbq) = 0.0
151	endif
152	if(igcm_n2d /= 0) then
153	nbq = nbq + 1
154	niq(nbq) = igcm_n2d
155	aki(nbq) = 0.0
156	cpi(nbq) = 0.0
157	endif
158	if(igcm_co2plus /= 0) then
159	nbq = nbq + 1
160	niq(nbq) = igcm_co2plus
161	aki(nbq) = 0.0
162	cpi(nbq) = 0.0
163	endif
164	if(igcm_oplus /= 0) then
165	nbq = nbq + 1
166	niq(nbq) = igcm_oplus
167	aki(nbq) = 0.0
168	cpi(nbq) = 0.0
169	endif
170	if(igcm_o2plus /= 0) then
171	nbq = nbq + 1
172	niq(nbq) = igcm_o2plus
173	aki(nbq) = 0.0
174	cpi(nbq) = 0.0
175	endif
176	if(igcm_coplus /= 0) then
177	nbq = nbq + 1
178	niq(nbq) = igcm_coplus
179	aki(nbq) = 0.0
180	cpi(nbq) = 0.0
181	endif
182	if(igcm_cplus /= 0) then
183	nbq = nbq + 1
184	niq(nbq) = igcm_cplus
185	aki(nbq) = 0.0
186	cpi(nbq) = 0.0
187	endif
188	if(igcm_nplus /= 0) then
189	nbq = nbq + 1
190	niq(nbq) = igcm_nplus
191	aki(nbq) = 0.0
192	cpi(nbq) = 0.0
193	endif
194	if(igcm_noplus /= 0) then
195	nbq = nbq + 1
196	niq(nbq) = igcm_noplus
197	aki(nbq) = 0.0
198	cpi(nbq) = 0.0
199	endif
200	if(igcm_n2plus /= 0) then
201	nbq = nbq + 1
202	niq(nbq) = igcm_n2plus
203	aki(nbq) = 0.0
204	cpi(nbq) = 0.0
205	endif
206	if(igcm_hplus /= 0) then
207	nbq = nbq + 1
208	niq(nbq) = igcm_hplus
209	aki(nbq) = 0.0
210	cpi(nbq) = 0.0
211	endif
212	if(igcm_hco2plus /= 0) then
213	nbq = nbq + 1
214	niq(nbq) = igcm_hco2plus
215	aki(nbq) = 0.0
216	cpi(nbq) = 0.0
217	endif
218
219
220
221	firstcall = .false.
222
223	end if ! if (firstcall)
224
225	! update temperature
226
227	do l = 1,nlayermx
228	do ig = 1,ngridmx
229	zt(ig,l) = pt(ig,l) + pdt(ig,l)*ptimestep
230	end do
231	end do
232
233	! update tracers
234
235	do l = 1,nlayermx
236	do ig = 1,ngridmx
237	do i = 1,nbq
238	iq = niq(i)
239	zq(ig,l,iq) = max(1.e-30, pq(ig,l,iq)
240	$ + pdq(ig,l,iq)*ptimestep)
241	end do
242	end do
243	end do
244
245	! mmean : mean molecular mass
246	! rnew : specific gas constant
247
248	mmean(:,:) = 0.
249
250	do l = 1,nlayermx
251	do ig = 1,ngridmx
252	do i = 1,nbq
253	iq = niq(i)
254	mmean(ig,l) = mmean(ig,l) + zq(ig,l,iq)/mmol(iq)
255	end do
256	mmean(ig,l) = 1./mmean(ig,l)
257	rnew(ig,l) = 8.314/mmean(ig,l)*1.e3 ! J/kg/K
258	end do
259	end do
260
261	! cpnew : specicic heat
262	! akknew : thermal conductivity cofficient
263
264	cpnew(:,:) = 0.
265	akknew(:,:) = 0.
266
267	do l = 1,nlayermx
268	do ig = 1,ngridmx
269	ntot = pplay(ig,l)/(1.381e-23zt(ig,l))1.e-6 ! in #/cm3
270	do i = 1,nbq
271	iq = niq(i)
272	ni(iq) = ntotzq(ig,l,iq)mmean(ig,l)/mmol(iq)
273	cpnew(ig,l) = cpnew(ig,l) + ni(iq)*cpi(iq)
274	akknew(ig,l) = akknew(ig,l) + ni(iq)*aki(iq)
275	end do
276	cpnew(ig,l) = cpnew(ig,l)/ntot
277	akknew(ig,l) = akknew(ig,l)/ntot
278	end do
279	! print*, l, mmean(1,l), cpnew(1,l), rnew(1,l)
280	end do
281
282	return
283	end

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format