Context Navigation

concentrations2.F @ 1443

Last change on this file since 1443 was 1442, checked in by slebonnois, 10 years ago
SL: update of the Venus GCM, + corrections on routines used for newstart/start2archive for Titan and Venus, + some modifications on tools
File size: 6.7 KB

Line
1	SUBROUTINE concentrations2(pplay,t_seri,pdt,tr_seri, nqmx,
2	$ ptimestep)
3
4	use dimphy
5	use conc, only: mmean, Akknew, rnew, cpnew
6	use cpdet_mod, only: cpdet
7	USE chemparam_mod
8	use infotrac
9
10	implicit none
11
12	!=======================================================================
13	! CALCULATION OF MEAN MOLECULAR MASS, Cp, Akk and R
14	!
15	! mmean(klon,klev) amu
16	! cpnew(klon,klev) J/kg/K
17	! rnew(klon,klev) J/kg/K
18	! akknew(klon,klev) coefficient of thermal conduction
19	!
20	! version: April 2012 - Franck Lefevre
21	!=======================================================================
22
23	! declarations
24
25	#include "dimensions.h"
26	#include "YOMCST.h"
27	#include "clesphys.h"
28	c#include "comdiurn.h"
29	c#include "chimiedata.h"
30	c#include "tracer.h"
31	c#include "mmol.h"
32
33	! input/output
34
35	real pplay(klon,klev)
36	c real pt(klon,klev)
37	integer,intent(in) :: nqmx ! number of tracers
38	real t_seri(klon, klev)
39	real pdt(klon,klev)
40	real n2vmr_gcm(klon,klev),nvmr_gcm(klon,klev)
41	real tr_seri(klon,klev,nqmx)
42	c real pdq(klon,klev,nqmx)
43	real ptimestep
44
45	! local variables
46
47	integer :: i, l, ig, iq
48	integer, save :: nbq
49	integer,allocatable,save :: niq(:)
50	real :: ni(nqmx), ntot
51	real :: zt(klon, klev)
52	real :: zq(klon, klev, nqmx)
53	real,allocatable,save :: aki(:)
54	real,allocatable,save :: cpi(:)
55	real, save :: akin,akin2
56
57	logical, save :: firstcall = .true.
58
59	if (firstcall) then
60
61	! initialize thermal conductivity and specific heat coefficients
62	! values are taken from the literature [J/kg K]
63
64	! allocate local saved arrays:
65	allocate(aki(nqmx))
66	allocate(cpi(nqmx))
67	allocate(niq(nqmx))
68
69	! find index of chemical tracers to use
70	! initialize thermal conductivity and specific heat coefficients
71	! !? values are estimated
72
73	nbq = 0 ! to count number of tracers used in this subroutine
74
75	if (i_co2 /= 0) then
76	nbq = nbq + 1
77	niq(nbq) = i_co2
78	aki(nbq) = 3.072e-4
79	cpi(nbq) = 0.834e3
80	end if
81	if (i_co /= 0) then
82	nbq = nbq + 1
83	niq(nbq) = i_co
84	aki(nbq) = 4.87e-4
85	cpi(nbq) = 1.034e3
86	end if
87	if (i_o /= 0) then
88	nbq = nbq + 1
89	niq(nbq) = i_o
90	aki(nbq) = 7.59e-4
91	cpi(nbq) = 1.3e3
92	end if
93	if (i_o1d /= 0) then
94	nbq = nbq + 1
95	niq(nbq) = i_o1d
96	aki(nbq) = 7.59e-4 !?
97	cpi(nbq) = 1.3e3 !?
98	end if
99	if (i_o2 /= 0) then
100	nbq = nbq + 1
101	niq(nbq) = i_o2
102	aki(nbq) = 5.68e-4
103	cpi(nbq) = 0.9194e3
104	end if
105	if (i_o3 /= 0) then
106	nbq = nbq + 1
107	niq(nbq) = i_o3
108	aki(nbq) = 3.00e-4 !?
109	cpi(nbq) = 0.800e3 !?
110	end if
111	if (i_h /= 0) then
112	nbq = nbq + 1
113	niq(nbq) = i_h
114	aki(nbq) = 0.0
115	cpi(nbq) = 20.780e3
116	end if
117	if (i_h2 /= 0) then
118	nbq = nbq + 1
119	niq(nbq) = i_h2
120	aki(nbq) = 36.314e-4
121	cpi(nbq) = 14.266e3
122	end if
123	if (i_oh /= 0) then
124	nbq = nbq + 1
125	niq(nbq) = i_oh
126	aki(nbq) = 7.00e-4 !?
127	cpi(nbq) = 1.045e3
128	end if
129	if (i_ho2 /= 0) then
130	nbq = nbq + 1
131	niq(nbq) = i_ho2
132	aki(nbq) = 0.0
133	cpi(nbq) = 1.065e3 !?
134	end if
135	if (i_n2 /= 0) then
136	nbq = nbq + 1
137	niq(nbq) = i_n2
138	aki(nbq) = 5.6e-4
139	cpi(nbq) = 1.034e3
140	end if
141	c if (i_ar /= 0) then
142	c nbq = nbq + 1
143	c niq(nbq) = i_ar
144	c aki(nbq) = 0.0 !?
145	c cpi(nbq) = 1.000e3 !?
146	c end if
147	if (i_h2o /= 0) then
148	nbq = nbq + 1
149	niq(nbq) = i_h2o
150	aki(nbq) = 0.0
151	cpi(nbq) = 1.870e3
152	end if
153	c if (i_n /= 0) then
154	c nbq = nbq + 1
155	c niq(nbq) = i_n
156	c aki(nbq) = 0.0
157	c cpi(nbq) = 0.0
158	c endif
159	c if(i_no /= 0) then
160	c nbq = nbq + 1
161	c niq(nbq) = i_no
162	c aki(nbq) = 0.0
163	c cpi(nbq) = 0.0
164	c endif
165	c if(i_no2 /= 0) then
166	c nbq = nbq + 1
167	c niq(nbq) = i_no2
168	c aki(nbq) = 0.0
169	c cpi(nbq) = 0.0
170	c endif
171	c if(i_n2d /= 0) then
172	c nbq = nbq + 1
173	c niq(nbq) = i_n2d
174	c aki(nbq) = 0.0
175	c cpi(nbq) = 0.0
176	c endif
177
178	! n2
179	c akin2 = 5.6e-4
180	c cpin2 = 1.034e3
181
182
183
184	! tell the world about it:
185	write(,) "concentrations: firstcall, nbq=",nbq
186	! write(,) " niq(1:nbq)=",niq(1:nbq)
187	! write(,) " aki(1:nbq)=",aki(1:nbq)
188	! write(,) " cpi(1:nbq)=",cpi(1:nbq)
189
190
191	firstcall = .false.
192	end if ! if (firstcall)
193
194	! update temperature
195
196	do l = 1,klev
197	do ig = 1,klon
198	zt(ig,l) = t_seri(ig,l)
199	end do
200	end do
201
202
203	! update mass mixing ratio tracers
204
205	do l = 1,klev
206	do ig = 1,klon
207	do i = 1,nqmx
208	! iq = niq(i)
209	zq(ig,l,i) = max(1.e-30, tr_seri(ig,l,i))
210	end do
211	end do
212	end do
213
214	! mmean : mean molecular mass
215	! rnew : specific gas constant
216
217	mmean(:,:) = 0.
218
219	do l = 1,klev
220	do ig = 1,klon
221	do i = 1,nqmx
222	iq = niq(i)
223	mmean(ig,l) = mmean(ig,l) + zq(ig,l,i)/M_tr(i)
224	end do
225	c mmean(ig,l) = RMD
226	mmean(ig,l) = 1./mmean(ig,l)
227	rnew(ig,l) = 8.314/mmean(ig,l)*1.e3 ! J/kg K
228
229	c write(,),'Mmean: ',ig, l, mmean(0,l)
230	end do
231	end do
232
233	! cpnew : specific heat
234	! akknew : thermal conductivity cofficient
235
236	cpnew(:,:) = 0.
237	akknew(:,:) = 0.
238
239	do l = 1,klev
240	do ig = 1,klon
241
242	ntot = pplay(ig,l)/(RKBOLzt(ig,l))1.e-6 ! in #/cm3
243
244	!!! --- INSERT N2 values ----
245	!! WARNING -> Cp here below doesn't depend on T (cpdet)
246
247	do i = 1,nbq
248	c iq = niq(i)
249	ni(i) = ntotzq(ig,l,i)mmean(ig,l)/M_tr(i)
250	cpnew(ig,l) = cpnew(ig,l) + ni(i)*cpi(i)
251	akknew(ig,l) = akknew(ig,l) + ni(i)*aki(i)
252	end do
253
254
255	cpnew(ig,l) = cpnew(ig,l)/ntot
256	akknew(ig,l)= akknew(ig,l)/ntot
257
258
259	end do
260	end do
261
262	return
263	end

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

Download in other formats:

Original Format