Context Navigation

conc_mod.F90 @ 3567

Last change on this file since 3567 was 3185, checked in by csegonne, 11 months ago

MARS PCM:

conc_mod.F : Added new subroutines init_r_cp_mu and update_r_cp_mu_ak to replace initialization of rnew, cpnew, mmean and akknew as constants and their update if callthermos or photochem (same update as in concentrations.F) that were done in physic_mod.F.
rnew, cpnew, mmean and akknew are now protected meaning they cannot be modified anywhere in the model other than in conc_mod.F .
concentrations.F has been removed.
Knowing where rnew, cpnew, mmean come from is now more explicit. These modifications respond to the need expressed in ticket #90.

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	return
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	! declarations
89
90	include "callkeys.h"
91
92	! input/output
93
94	integer,intent(in) :: ngrid ! number of atmospheric columns
95	integer,intent(in) :: nlayer ! number of atmospheric layers
96	integer,intent(in) :: nq ! number of tracers
97	real,intent(in) :: pplay(ngrid,nlayer)
98	real,intent(in) :: pt(ngrid,nlayer)
99	real,intent(in) :: pdt(ngrid,nlayer)
100	real,intent(in) :: pq(ngrid,nlayer,nq)
101	real,intent(in) :: pdq(ngrid,nlayer,nq)
102	real,intent(in) :: ptimestep
103
104	! local variables
105
106	integer :: i, l, ig, iq
107	integer, save :: nbq
108	integer,allocatable,save :: niq(:)
109	real :: ni(nq), ntot
110	real :: zq(ngrid, nlayer, nq)
111	real :: zt(ngrid, nlayer)
112	real,allocatable,save :: aki(:)
113	real,allocatable,save :: cpi(:)
114
115	logical, save :: firstcall = .true.
116
117	!$OMP THREADPRIVATE(nbq,niq,aki,cpi,firstcall)
118
119	if (firstcall) then
120
121	! allocate local saved arrays:
122	allocate(aki(nq))
123	allocate(cpi(nq))
124	allocate(niq(nq))
125	! find index of chemical tracers to use
126	! initialize thermal conductivity and specific heat coefficients
127	! !? values are estimated
128
129	nbq = 0 ! to count number of tracers used in this subroutine
130
131	if (igcm_co2 /= 0) then
132	nbq = nbq + 1
133	niq(nbq) = igcm_co2
134	aki(nbq) = 3.072e-4
135	cpi(nbq) = 0.834e3
136	end if
137	if (igcm_co /= 0) then
138	nbq = nbq + 1
139	niq(nbq) = igcm_co
140	aki(nbq) = 4.87e-4
141	cpi(nbq) = 1.034e3
142	end if
143	if (igcm_o /= 0) then
144	nbq = nbq + 1
145	niq(nbq) = igcm_o
146	aki(nbq) = 7.59e-4
147	cpi(nbq) = 1.3e3
148	end if
149	if (igcm_o1d /= 0) then
150	nbq = nbq + 1
151	niq(nbq) = igcm_o1d
152	aki(nbq) = 7.59e-4 !?
153	cpi(nbq) = 1.3e3 !?
154	end if
155	if (igcm_o2 /= 0) then
156	nbq = nbq + 1
157	niq(nbq) = igcm_o2
158	aki(nbq) = 5.68e-4
159	cpi(nbq) = 0.9194e3
160	end if
161	if (igcm_o3 /= 0) then
162	nbq = nbq + 1
163	niq(nbq) = igcm_o3
164	aki(nbq) = 3.00e-4 !?
165	cpi(nbq) = 0.800e3 !?
166	end if
167	if (igcm_h /= 0) then
168	nbq = nbq + 1
169	niq(nbq) = igcm_h
170	aki(nbq) = 0.0
171	cpi(nbq) = 20.780e3
172	end if
173	if (igcm_h2 /= 0) then
174	nbq = nbq + 1
175	niq(nbq) = igcm_h2
176	aki(nbq) = 36.314e-4
177	cpi(nbq) = 14.266e3
178	end if
179	if (igcm_oh /= 0) then
180	nbq = nbq + 1
181	niq(nbq) = igcm_oh
182	aki(nbq) = 7.00e-4 !?
183	cpi(nbq) = 1.045e3
184	end if
185	if (igcm_ho2 /= 0) then
186	nbq = nbq + 1
187	niq(nbq) = igcm_ho2
188	aki(nbq) = 0.0
189	cpi(nbq) = 1.065e3 !?
190	end if
191	if (igcm_n2 /= 0) then
192	nbq = nbq + 1
193	niq(nbq) = igcm_n2
194	aki(nbq) = 5.6e-4
195	cpi(nbq) = 1.034e3
196	end if
197	if (igcm_ar /= 0) then
198	nbq = nbq + 1
199	niq(nbq) = igcm_ar
200	aki(nbq) = 3.4e-4
201	cpi(nbq) = 5.2e2
202	! aki/cpi from Leslie A. Guildner,
203	! JOURNAL OF RESEARCH of the National Bureau of Standards-
204	! A. Physics and Chemistry
205	! Vol. 79A, No.2, March-April 1975
206	end if
207	if (igcm_h2o_vap /= 0) then
208	nbq = nbq + 1
209	niq(nbq) = igcm_h2o_vap
210	aki(nbq) = 0.0
211	cpi(nbq) = 1.870e3
212	end if
213	if (igcm_n /= 0) then
214	nbq = nbq + 1
215	niq(nbq) = igcm_n
216	aki(nbq) = 0.0
217	cpi(nbq) = 0.0
218	endif
219	if(igcm_no /= 0) then
220	nbq = nbq + 1
221	niq(nbq) = igcm_no
222	aki(nbq) = 0.0
223	cpi(nbq) = 0.0
224	endif
225	if(igcm_no2 /= 0) then
226	nbq = nbq + 1
227	niq(nbq) = igcm_no2
228	aki(nbq) = 0.0
229	cpi(nbq) = 0.0
230	endif
231	if(igcm_n2d /= 0) then
232	nbq = nbq + 1
233	niq(nbq) = igcm_n2d
234	aki(nbq) = 0.0
235	cpi(nbq) = 0.0
236	endif
237	if(igcm_he /= 0) then
238	nbq = nbq + 1
239	niq(nbq) = igcm_he
240	aki(nbq) = 30.e-4
241	cpi(nbq) = 5.2e3
242	! aki/cpi from Leslie A. Guildner,
243	! JOURNAL OF RESEARCH of the National Bureau of Standards-
244	! A. Physics and Chemistry
245	! Vol. 79A, No.2, March-April 1975
246	endif
247	if(igcm_co2plus /= 0) then
248	nbq = nbq + 1
249	niq(nbq) = igcm_co2plus
250	aki(nbq) = 0.0
251	cpi(nbq) = 0.0
252	endif
253	if(igcm_oplus /= 0) then
254	nbq = nbq + 1
255	niq(nbq) = igcm_oplus
256	aki(nbq) = 0.0
257	cpi(nbq) = 0.0
258	endif
259	if(igcm_o2plus /= 0) then
260	nbq = nbq + 1
261	niq(nbq) = igcm_o2plus
262	aki(nbq) = 0.0
263	cpi(nbq) = 0.0
264	endif
265	if(igcm_coplus /= 0) then
266	nbq = nbq + 1
267	niq(nbq) = igcm_coplus
268	aki(nbq) = 0.0
269	cpi(nbq) = 0.0
270	endif
271	if(igcm_cplus /= 0) then
272	nbq = nbq + 1
273	niq(nbq) = igcm_cplus
274	aki(nbq) = 0.0
275	cpi(nbq) = 0.0
276	endif
277	if(igcm_nplus /= 0) then
278	nbq = nbq + 1
279	niq(nbq) = igcm_nplus
280	aki(nbq) = 0.0
281	cpi(nbq) = 0.0
282	endif
283	if(igcm_noplus /= 0) then
284	nbq = nbq + 1
285	niq(nbq) = igcm_noplus
286	aki(nbq) = 0.0
287	cpi(nbq) = 0.0
288	endif
289	if(igcm_n2plus /= 0) then
290	nbq = nbq + 1
291	niq(nbq) = igcm_n2plus
292	aki(nbq) = 0.0
293	cpi(nbq) = 0.0
294	endif
295	if(igcm_hplus /= 0) then
296	nbq = nbq + 1
297	niq(nbq) = igcm_hplus
298	aki(nbq) = 0.0
299	cpi(nbq) = 0.0
300	endif
301	if(igcm_hco2plus /= 0) then
302	nbq = nbq + 1
303	niq(nbq) = igcm_hco2plus
304	aki(nbq) = 0.0
305	cpi(nbq) = 0.0
306	endif
307	if(igcm_elec /= 0) then
308	nbq = nbq + 1
309	niq(nbq) = igcm_elec
310	aki(nbq) = 0.0
311	cpi(nbq) = 0.0
312	endif
313
314	! tell the world about it:
315	write(,) "concentrations: firstcall, nbq=",nbq
316	write(,) " niq(1:nbq)=",niq(1:nbq)
317	write(,) " aki(1:nbq)=",aki(1:nbq)
318	write(,) " cpi(1:nbq)=",cpi(1:nbq)
319
320	firstcall = .false.
321
322	end if ! if (firstcall)
323
324	! update temperature
325
326	do l = 1,nlayer
327	do ig = 1,ngrid
328	zt(ig,l) = pt(ig,l) + pdt(ig,l)*ptimestep
329	end do
330	end do
331
332	! update tracers
333
334	do l = 1,nlayer
335	do ig = 1,ngrid
336	do i = 1,nbq
337	iq = niq(i)
338	zq(ig,l,iq) = max(1.e-30, pq(ig,l,iq)+pdq(ig,l,iq)*ptimestep)
339	end do
340	end do
341	end do
342
343	! mmean : mean molecular mass
344	! rnew : specific gas constant
345
346	mmean(:,:) = 0.
347
348	do l = 1,nlayer
349	do ig = 1,ngrid
350	do i = 1,nbq
351	iq = niq(i)
352	mmean(ig,l) = mmean(ig,l) + zq(ig,l,iq)/mmol(iq)
353	end do
354	mmean(ig,l) = 1./mmean(ig,l)
355	rnew(ig,l) = 8.314/mmean(ig,l)*1.e3 ! J/kg/K
356	end do
357	end do
358
359	! cpnew : specific heat
360	! akknew : thermal conductivity coefficient
361
362	cpnew(:,:) = 0.
363	akknew(:,:) = 0.
364
365	do l = 1,nlayer
366	do ig = 1,ngrid
367	ntot = pplay(ig,l)/(1.381e-23zt(ig,l))1.e-6 ! in #/cm3
368	do i = 1,nbq
369	iq = niq(i)
370	ni(iq) = ntotzq(ig,l,iq)mmean(ig,l)/mmol(iq)
371	cpnew(ig,l) = cpnew(ig,l) + ni(iq)*cpi(i)
372	akknew(ig,l) = akknew(ig,l) + ni(iq)*aki(i)
373	end do
374	cpnew(ig,l) = cpnew(ig,l)/ntot
375	akknew(ig,l) = akknew(ig,l)/ntot
376	end do
377	end do
378
379	return
380	end subroutine update_r_cp_mu_ak
381
382	end module conc_mod

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

Download in other formats:

Original Format