Context Navigation

concentrations.F @ 798

Last change on this file since 798 was 635, checked in by emillour, 13 years ago

Mars GCM: Update of the chemistry package, including:

93 reactions are accounted for (instead of 22); tracking 28 species (instead of 11)
computation of photoabsorption using raytracing
improved time stepping in the photochemistry
updated parameters (cross-sections); with this new version input files

are in 'EUV/param_v5' of "datafile" directory.

transition between lower and upper atmosphere chemistry set to 0.1 Pa (calchim.F90)
Lots of code clean-up: removed obsolete files column.F, param_v3.h, flujo.F, phdisrate.F, ch.F, interpfast.F, paramfoto.F, getch.F Converted chemtermos.F -> chemthermos.F90 and euvheat.F -> euvheat.F90. Added paramfoto_compact.F , param_v4.h and iono.h
Upadted surfacearea.F
Cleaned initracer.F and callkeys.h (removed use of obsolete "nqchem" and "oldnames" case when initializing tracers).
Minor correction in "callsedim": compute "rdust" and/or "rice" only when it makes sense.

FGG+FL+EM

File size: 7.5 KB

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

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

Download in other formats:

Original Format