Context Navigation

concentrations.F @ 1242

Last change on this file since 1242 was 1226, checked in by aslmd, 11 years ago
LMDZ.MARS : Replaced comcstfi and planete includes by modules.
File size: 8.7 KB

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

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

Download in other formats:

Original Format