Context Navigation

concentrations.F @ 1242

Last change on this file since 1242 was 1226, checked in by aslmd, 11 years ago
LMDZ.MARS : Replaced comcstfi and planete includes by modules.
File size: 8.7 KB

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

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

Download in other formats:

Original Format