Context Navigation

concentrations2.F @ 2534

Last change on this file since 2534 was 2464, checked in by slebonnois, 5 years ago
SL: major update related to extension to 250 km. New EUV heating as used in Martian GCM, debug of a few routines, adding He, clean up, updating mmean regularly, modification of the order of processes, add the possibility to use Hedin composition in rad transfer
File size: 6.5 KB

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

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

Download in other formats:

Original Format