Context Navigation

conc_mod.F90 @ 3741

Last change on this file since 3741 was 3726, checked in by emillour, 10 months ago
Mars PCM: Turn "callkeys.h" into module "callkeys_mod.F90" EM
File size: 10.1 KB

Line
1	module conc_mod
2
3	implicit none
4
5	real,save,allocatable,protected :: mmean(:,:) ! mean molecular mass of the atmosphere
6	real,save,allocatable,protected :: Akknew(:,:) ! thermal conductivity coefficient
7	real,save,allocatable,protected :: cpnew(:,:) ! specific heat
8	real,save,allocatable,protected :: rnew(:,:) ! specific gas constant
9
10	!$OMP THREADPRIVATE(mmean,Akknew,cpnew,rnew)
11
12	contains
13
14	subroutine ini_conc_mod(ngrid,nlayer)
15
16	implicit none
17	integer,intent(in) :: ngrid ! number of atmospheric columns
18	integer,intent(in) :: nlayer ! number of atmospheric levels
19
20	allocate(mmean(ngrid,nlayer))
21	allocate(Akknew(ngrid,nlayer))
22	allocate(cpnew(ngrid,nlayer))
23	allocate(rnew(ngrid,nlayer))
24
25	end subroutine ini_conc_mod
26
27
28	subroutine end_conc_mod
29
30	implicit none
31
32	if (allocated(mmean)) deallocate(mmean)
33	if (allocated(Akknew)) deallocate(Akknew)
34	if (allocated(cpnew)) deallocate(cpnew)
35	if (allocated(rnew)) deallocate(rnew)
36
37	end subroutine end_conc_mod
38
39	subroutine init_r_cp_mu(ngrid,nlayer)
40
41	USE comcstfi_h, only: r, cpp, mugaz
42	implicit none
43	! Input
44	integer,intent(in) :: ngrid ! number of atmospheric columns
45	integer,intent(in) :: nlayer ! number of atmospheric layers
46
47	! local variables
48	integer l, ig
49
50	! Initialize R, Cp and mu as constant
51	! do l=1,nlayer
52	! do ig=1,ngrid
53	! rnew(ig,l)=r
54	! cpnew(ig,l)=cpp
55	! mmean(ig,l)=mugaz
56	! enddo
57	! enddo
58	rnew(:,:)=r
59	cpnew(:,:)=cpp
60	mmean(:,:)=mugaz
61
62	end subroutine init_r_cp_mu
63
64
65	subroutine update_r_cp_mu_ak(ngrid,nlayer,nq,pplay,pt,pdt,pq,pdq,ptimestep)
66
67	use tracer_mod, only: igcm_co2, igcm_co, igcm_o, igcm_o1d, &
68	& igcm_o2, igcm_o3, igcm_h, igcm_h2, &
69	& igcm_oh, igcm_ho2, igcm_n2, igcm_ar, &
70	& igcm_h2o_vap, igcm_n, igcm_no, igcm_no2, &
71	& igcm_n2d, igcm_co2plus, igcm_oplus, &
72	& igcm_o2plus, igcm_coplus, igcm_cplus, &
73	& igcm_nplus, igcm_noplus, igcm_n2plus, &
74	& igcm_hplus, igcm_hco2plus, mmol, &
75	& igcm_he, igcm_elec
76	implicit none
77	!=======================================================================
78	! CALCULATION OF MEAN MOLECULAR MASS, Cp, Akk and R
79	!
80	! mmean(ngrid,nlayer) amu
81	! cpnew(ngrid,nlayer) J/kg/K
82	! rnew(ngrid,nlayer) J/kg/K
83	! akknew(ngrid,nlayer) coefficient of thermal conduction
84	!
85	! version: April 2012 - Franck Lefevre
86	!=======================================================================
87
88	! input/output
89
90	integer,intent(in) :: ngrid ! number of atmospheric columns
91	integer,intent(in) :: nlayer ! number of atmospheric layers
92	integer,intent(in) :: nq ! number of tracers
93	real,intent(in) :: pplay(ngrid,nlayer)
94	real,intent(in) :: pt(ngrid,nlayer)
95	real,intent(in) :: pdt(ngrid,nlayer)
96	real,intent(in) :: pq(ngrid,nlayer,nq)
97	real,intent(in) :: pdq(ngrid,nlayer,nq)
98	real,intent(in) :: ptimestep
99
100	! local variables
101
102	integer :: i, l, ig, iq
103	integer, save :: nbq
104	integer,allocatable,save :: niq(:)
105	real :: ni(nq), ntot
106	real :: zq(ngrid, nlayer, nq)
107	real :: zt(ngrid, nlayer)
108	real,allocatable,save :: aki(:)
109	real,allocatable,save :: cpi(:)
110
111	logical, save :: firstcall = .true.
112
113	!$OMP THREADPRIVATE(nbq,niq,aki,cpi,firstcall)
114
115	if (firstcall) then
116
117	! allocate local saved arrays:
118	allocate(aki(nq))
119	allocate(cpi(nq))
120	allocate(niq(nq))
121	! find index of chemical tracers to use
122	! initialize thermal conductivity and specific heat coefficients
123	! !? values are estimated
124
125	nbq = 0 ! to count number of tracers used in this subroutine
126
127	if (igcm_co2 /= 0) then
128	nbq = nbq + 1
129	niq(nbq) = igcm_co2
130	aki(nbq) = 3.072e-4
131	cpi(nbq) = 0.834e3
132	end if
133	if (igcm_co /= 0) then
134	nbq = nbq + 1
135	niq(nbq) = igcm_co
136	aki(nbq) = 4.87e-4
137	cpi(nbq) = 1.034e3
138	end if
139	if (igcm_o /= 0) then
140	nbq = nbq + 1
141	niq(nbq) = igcm_o
142	aki(nbq) = 7.59e-4
143	cpi(nbq) = 1.3e3
144	end if
145	if (igcm_o1d /= 0) then
146	nbq = nbq + 1
147	niq(nbq) = igcm_o1d
148	aki(nbq) = 7.59e-4 !?
149	cpi(nbq) = 1.3e3 !?
150	end if
151	if (igcm_o2 /= 0) then
152	nbq = nbq + 1
153	niq(nbq) = igcm_o2
154	aki(nbq) = 5.68e-4
155	cpi(nbq) = 0.9194e3
156	end if
157	if (igcm_o3 /= 0) then
158	nbq = nbq + 1
159	niq(nbq) = igcm_o3
160	aki(nbq) = 3.00e-4 !?
161	cpi(nbq) = 0.800e3 !?
162	end if
163	if (igcm_h /= 0) then
164	nbq = nbq + 1
165	niq(nbq) = igcm_h
166	aki(nbq) = 0.0
167	cpi(nbq) = 20.780e3
168	end if
169	if (igcm_h2 /= 0) then
170	nbq = nbq + 1
171	niq(nbq) = igcm_h2
172	aki(nbq) = 36.314e-4
173	cpi(nbq) = 14.266e3
174	end if
175	if (igcm_oh /= 0) then
176	nbq = nbq + 1
177	niq(nbq) = igcm_oh
178	aki(nbq) = 7.00e-4 !?
179	cpi(nbq) = 1.045e3
180	end if
181	if (igcm_ho2 /= 0) then
182	nbq = nbq + 1
183	niq(nbq) = igcm_ho2
184	aki(nbq) = 0.0
185	cpi(nbq) = 1.065e3 !?
186	end if
187	if (igcm_n2 /= 0) then
188	nbq = nbq + 1
189	niq(nbq) = igcm_n2
190	aki(nbq) = 5.6e-4
191	cpi(nbq) = 1.034e3
192	end if
193	if (igcm_ar /= 0) then
194	nbq = nbq + 1
195	niq(nbq) = igcm_ar
196	aki(nbq) = 3.4e-4
197	cpi(nbq) = 5.2e2
198	! aki/cpi from Leslie A. Guildner,
199	! JOURNAL OF RESEARCH of the National Bureau of Standards-
200	! A. Physics and Chemistry
201	! Vol. 79A, No.2, March-April 1975
202	end if
203	if (igcm_h2o_vap /= 0) then
204	nbq = nbq + 1
205	niq(nbq) = igcm_h2o_vap
206	aki(nbq) = 0.0
207	cpi(nbq) = 1.870e3
208	end if
209	if (igcm_n /= 0) then
210	nbq = nbq + 1
211	niq(nbq) = igcm_n
212	aki(nbq) = 0.0
213	cpi(nbq) = 0.0
214	endif
215	if(igcm_no /= 0) then
216	nbq = nbq + 1
217	niq(nbq) = igcm_no
218	aki(nbq) = 0.0
219	cpi(nbq) = 0.0
220	endif
221	if(igcm_no2 /= 0) then
222	nbq = nbq + 1
223	niq(nbq) = igcm_no2
224	aki(nbq) = 0.0
225	cpi(nbq) = 0.0
226	endif
227	if(igcm_n2d /= 0) then
228	nbq = nbq + 1
229	niq(nbq) = igcm_n2d
230	aki(nbq) = 0.0
231	cpi(nbq) = 0.0
232	endif
233	if(igcm_he /= 0) then
234	nbq = nbq + 1
235	niq(nbq) = igcm_he
236	aki(nbq) = 30.e-4
237	cpi(nbq) = 5.2e3
238	! aki/cpi from Leslie A. Guildner,
239	! JOURNAL OF RESEARCH of the National Bureau of Standards-
240	! A. Physics and Chemistry
241	! Vol. 79A, No.2, March-April 1975
242	endif
243	if(igcm_co2plus /= 0) then
244	nbq = nbq + 1
245	niq(nbq) = igcm_co2plus
246	aki(nbq) = 0.0
247	cpi(nbq) = 0.0
248	endif
249	if(igcm_oplus /= 0) then
250	nbq = nbq + 1
251	niq(nbq) = igcm_oplus
252	aki(nbq) = 0.0
253	cpi(nbq) = 0.0
254	endif
255	if(igcm_o2plus /= 0) then
256	nbq = nbq + 1
257	niq(nbq) = igcm_o2plus
258	aki(nbq) = 0.0
259	cpi(nbq) = 0.0
260	endif
261	if(igcm_coplus /= 0) then
262	nbq = nbq + 1
263	niq(nbq) = igcm_coplus
264	aki(nbq) = 0.0
265	cpi(nbq) = 0.0
266	endif
267	if(igcm_cplus /= 0) then
268	nbq = nbq + 1
269	niq(nbq) = igcm_cplus
270	aki(nbq) = 0.0
271	cpi(nbq) = 0.0
272	endif
273	if(igcm_nplus /= 0) then
274	nbq = nbq + 1
275	niq(nbq) = igcm_nplus
276	aki(nbq) = 0.0
277	cpi(nbq) = 0.0
278	endif
279	if(igcm_noplus /= 0) then
280	nbq = nbq + 1
281	niq(nbq) = igcm_noplus
282	aki(nbq) = 0.0
283	cpi(nbq) = 0.0
284	endif
285	if(igcm_n2plus /= 0) then
286	nbq = nbq + 1
287	niq(nbq) = igcm_n2plus
288	aki(nbq) = 0.0
289	cpi(nbq) = 0.0
290	endif
291	if(igcm_hplus /= 0) then
292	nbq = nbq + 1
293	niq(nbq) = igcm_hplus
294	aki(nbq) = 0.0
295	cpi(nbq) = 0.0
296	endif
297	if(igcm_hco2plus /= 0) then
298	nbq = nbq + 1
299	niq(nbq) = igcm_hco2plus
300	aki(nbq) = 0.0
301	cpi(nbq) = 0.0
302	endif
303	if(igcm_elec /= 0) then
304	nbq = nbq + 1
305	niq(nbq) = igcm_elec
306	aki(nbq) = 0.0
307	cpi(nbq) = 0.0
308	endif
309
310	! tell the world about it:
311	write(,) "concentrations: firstcall, nbq=",nbq
312	write(,) " niq(1:nbq)=",niq(1:nbq)
313	write(,) " aki(1:nbq)=",aki(1:nbq)
314	write(,) " cpi(1:nbq)=",cpi(1:nbq)
315
316	firstcall = .false.
317
318	end if ! if (firstcall)
319
320	! update temperature
321
322	do l = 1,nlayer
323	do ig = 1,ngrid
324	zt(ig,l) = pt(ig,l) + pdt(ig,l)*ptimestep
325	end do
326	end do
327
328	! update tracers
329
330	do l = 1,nlayer
331	do ig = 1,ngrid
332	do i = 1,nbq
333	iq = niq(i)
334	zq(ig,l,iq) = max(1.e-30, pq(ig,l,iq)+pdq(ig,l,iq)*ptimestep)
335	end do
336	end do
337	end do
338
339	! mmean : mean molecular mass
340	! rnew : specific gas constant
341
342	mmean(:,:) = 0.
343
344	do l = 1,nlayer
345	do ig = 1,ngrid
346	do i = 1,nbq
347	iq = niq(i)
348	mmean(ig,l) = mmean(ig,l) + zq(ig,l,iq)/mmol(iq)
349	end do
350	mmean(ig,l) = 1./mmean(ig,l)
351	rnew(ig,l) = 8.314/mmean(ig,l)*1.e3 ! J/kg/K
352	end do
353	end do
354
355	! cpnew : specific heat
356	! akknew : thermal conductivity coefficient
357
358	cpnew(:,:) = 0.
359	akknew(:,:) = 0.
360
361	do l = 1,nlayer
362	do ig = 1,ngrid
363	ntot = pplay(ig,l)/(1.381e-23zt(ig,l))1.e-6 ! in #/cm3
364	do i = 1,nbq
365	iq = niq(i)
366	ni(iq) = ntotzq(ig,l,iq)mmean(ig,l)/mmol(iq)
367	cpnew(ig,l) = cpnew(ig,l) + ni(iq)*cpi(i)
368	akknew(ig,l) = akknew(ig,l) + ni(iq)*aki(i)
369	end do
370	cpnew(ig,l) = cpnew(ig,l)/ntot
371	akknew(ig,l) = akknew(ig,l)/ntot
372	end do
373	end do
374
375	end subroutine update_r_cp_mu_ak
376
377	end module conc_mod

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

Download in other formats:

Original Format