Context Navigation

callsedim_mod.F @ 2282

Last change on this file since 2282 was 2199, checked in by mvals, 6 years ago
Mars GCM: Implementation of a new parametrization of the dust entrainment by slope winds above the sub-grid scale topography. The parametrization is activated with the flag slpwind=.true. (set to "false" by default) in callphys.def. The new parametrization involves the new tracers topdust_mass and topdust_number. MV
File size: 21.8 KB

Rev	Line
[1962]	1	MODULE callsedim_mod
	2
	3	IMPLICIT NONE
	4
	5	CONTAINS
[1974]	6
	7	SUBROUTINE callsedim(ngrid,nlay,ptimestep,
[2199]	8	& pplev,zlev,zlay,pt,pdt,
	9	& rdust,rstormdust,rtopdust,
	10	& rice,rsedcloud,rhocloud,
[1974]	11	& pq,pdqfi,pdqsed,pdqs_sed,nq,
[740]	12	& tau,tauscaling)
[1974]	13
[1036]	14	USE ioipsl_getincom, only: getin
	15	USE updaterad, only: updaterdust,updaterice_micro,updaterice_typ
	16	USE tracer_mod, only: noms, igcm_dust_mass, igcm_dust_number,
	17	& rho_dust, rho_q, radius, varian,
	18	& igcm_ccn_mass, igcm_ccn_number,
[1617]	19	& igcm_h2o_ice, nuice_sed, nuice_ref,
[1974]	20	& igcm_ccnco2_mass,igcm_ccnco2_number,
	21	& igcm_co2_ice, igcm_stormdust_mass,
[2199]	22	& igcm_stormdust_number,igcm_topdust_mass,
	23	& igcm_topdust_number
[1913]	24	USE newsedim_mod, ONLY: newsedim
	25	USE comcstfi_h, ONLY: g
[1983]	26	USE dimradmars_mod, only: naerkind
[38]	27	IMPLICIT NONE
	28
	29	c=======================================================================
	30	c Sedimentation of the Martian aerosols
	31	c depending on their density and radius
	32	c
	33	c F.Forget 1999
	34	c
	35	c Modified by J.-B. Madeleine 2010: Now includes the doubleq
	36	c technique in order to have only one call to callsedim in
	37	c physiq.F.
	38	c
[1617]	39	c Modified by J. Audouard 09/16: Now includes the co2clouds case
	40	c If the co2 microphysics is on, then co2 theice & ccn tracers
	41	c are being sedimented in the microtimestep (co2cloud.F), not
	42	c in this routine.
	43	c
[38]	44	c=======================================================================
	45
	46	c-----------------------------------------------------------------------
	47	c declarations:
	48	c -------------
[520]	49
[1913]	50	include "callkeys.h"
[38]	51
	52	c
	53	c arguments:
	54	c ----------
	55
[1005]	56	integer,intent(in) :: ngrid ! number of horizontal grid points
	57	integer,intent(in) :: nlay ! number of atmospheric layers
	58	real,intent(in) :: ptimestep ! physics time step (s)
	59	real,intent(in) :: pplev(ngrid,nlay+1) ! pressure at inter-layers (Pa)
	60	real,intent(in) :: zlev(ngrid,nlay+1) ! altitude at layer boundaries
	61	real,intent(in) :: zlay(ngrid,nlay) ! altitude at the middle of the layers
	62	real,intent(in) :: pt(ngrid,nlay) ! temperature at mid-layer (K)
	63	real,intent(in) :: pdt(ngrid,nlay) ! tendency on temperature, from
	64	! previous processes (K/s)
[38]	65	c Aerosol radius provided by the water ice microphysical scheme:
[1005]	66	real,intent(out) :: rdust(ngrid,nlay) ! Dust geometric mean radius (m)
[1974]	67	real,intent(out) :: rstormdust(ngrid,nlay) ! Stormdust geometric mean radius (m)
[2199]	68	real,intent(out) :: rtopdust(ngrid,nlay) ! topdust geometric mean radius (m)
[1005]	69	real,intent(out) :: rice(ngrid,nlay) ! H2O Ice geometric mean radius (m)
	70	c Sedimentation radius of water ice
[1047]	71	real,intent(in) :: rsedcloud(ngrid,nlay)
[1005]	72	c Cloud density (kg.m-3)
[1047]	73	real,intent(inout) :: rhocloud(ngrid,nlay)
[38]	74	c Traceurs :
[1005]	75	real,intent(in) :: pq(ngrid,nlay,nq) ! tracers (kg/kg)
	76	real,intent(in) :: pdqfi(ngrid,nlay,nq) ! tendency before sedimentation (kg/kg.s-1)
	77	real,intent(out) :: pdqsed(ngrid,nlay,nq) ! tendency due to sedimentation (kg/kg.s-1)
	78	real,intent(out) :: pdqs_sed(ngrid,nq) ! flux at surface (kg.m-2.s-1)
	79	integer,intent(in) :: nq ! number of tracers
[1983]	80	real,intent(in) :: tau(ngrid,naerkind) ! dust opacity
[1005]	81	real,intent(in) :: tauscaling(ngrid)
[38]	82
	83	c local:
	84	c ------
	85
	86	INTEGER l,ig, iq
	87
[1005]	88	real zqi(ngrid,nlay,nq) ! to locally store tracers
	89	real zt(ngrid,nlay) ! to locally store temperature
	90	real masse (ngrid,nlay) ! Layer mass (kg.m-2)
	91	real epaisseur (ngrid,nlay) ! Layer thickness (m)
	92	real wq(ngrid,nlay+1) ! displaced tracer mass (kg.m-2)
	93	real r0(ngrid,nlay) ! geometric mean radius used for
[358]	94	! sedimentation (m)
[1005]	95	real r0dust(ngrid,nlay) ! geometric mean radius used for
[358]	96	! dust (m)
[1974]	97	real r0stormdust(ngrid,nlay) ! Geometric mean radius used for stormdust (m)
[740]	98	! ! CCNs (m)
[2199]	99	real r0topdust(ngrid,nlay) ! Geometric mean radius used for topdust (m)
	100	! ! CCNs (m)
[1005]	101	real,save :: beta ! correction for the shape of the ice particles (cf. newsedim)
[411]	102	c for ice radius computation
	103	REAL Mo,No
	104	REAl ccntyp
[38]	105
[358]	106
[411]	107
[38]	108	c Discrete size distributions (doubleq)
	109	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	110	c 1) Parameters used to represent the changes in fall
	111	c velocity as a function of particle size;
[1005]	112	integer ir
	113	integer,parameter :: nr=12 !(nr=7) ! number of bins
	114	real,save :: rd(nr)
	115	real qr(ngrid,nlay,nr)
	116	real,save :: rdi(nr+1) ! extreme and intermediate radii
	117	real Sq(ngrid,nlay)
	118	real,parameter :: rdmin=1.e-8
	119	real,parameter :: rdmax=30.e-6
	120	real,parameter :: rdimin=1.e-8 ! 1.e-7
	121	real,parameter :: rdimax=1.e-4
[38]	122
	123	c 2) Second size distribution for the log-normal integration
	124	c (the mass mixing ratio is computed for each radius)
	125
[1005]	126	integer iint
	127	integer,parameter :: ninter=4 ! number of points between each rdi radii
	128	real,save :: rr(ninter,nr)
[38]	129	integer radpower
[358]	130	real sigma0
[38]	131
	132	c 3) Other local variables used in doubleq
	133
[1005]	134	INTEGER,SAVE :: idust_mass ! index of tracer containing dust mass
	135	! mix. ratio
	136	INTEGER,SAVE :: idust_number ! index of tracer containing dust number
	137	! mix. ratio
	138	INTEGER,SAVE :: iccn_mass ! index of tracer containing CCN mass
	139	! mix. ratio
	140	INTEGER,SAVE :: iccn_number ! index of tracer containing CCN number
	141	! mix. ratio
[1974]	142	INTEGER,SAVE :: istormdust_mass ! index of tracer containing
	143	!stormdust mass mix. ratio
	144	INTEGER,SAVE :: istormdust_number ! index of tracer containing
[2199]	145	!stormdust number mix. ratio
	146	INTEGER,SAVE :: itopdust_mass ! index of tracer containing
	147	!topdust mass mix. ratio
	148	INTEGER,SAVE :: itopdust_number ! index of tracer containing
	149	!topdust number mix. ratio
[1617]	150	INTEGER,SAVE :: iccnco2_number ! index of tracer containing CCN number
	151	INTEGER,SAVE :: iccnco2_mass ! index of tracer containing CCN number
	152	INTEGER,SAVE :: ico2_ice ! index of tracer containing CCN number
[38]	153
[1617]	154
[1005]	155	LOGICAL,SAVE :: firstcall=.true.
[38]	156
[1974]	157
	158
[38]	159	c ** un petit test de coherence
	160	c --------------------------
[1779]	161	! AS: firstcall OK absolute
[38]	162	IF (firstcall) THEN
[411]	163
[38]	164	c Doubleq: initialization
	165	IF (doubleq) THEN
	166	do ir=1,nr
	167	rd(ir)= rdmin(rdmax/rdmin)*(float(ir-1)/float(nr-1))
	168	end do
	169	rdi(1)=rdimin
	170	do ir=2,nr
	171	rdi(ir)= sqrt(rd(ir-1)*rd(ir))
	172	end do
	173	rdi(nr+1)=rdimax
	174
	175	do ir=1,nr
	176	do iint=1,ninter
	177	rr(iint,ir)=
	178	& rdi(ir)*
	179	& (rdi(ir+1)/rdi(ir))**(float(iint-1)/float(ninter-1))
	180	c write(,) rr(iint,ir)
	181	end do
	182	end do
	183
	184	! identify tracers corresponding to mass mixing ratio and
	185	! number mixing ratio
	186	idust_mass=0 ! dummy initialization
	187	idust_number=0 ! dummy initialization
	188
	189	do iq=1,nq
	190	if (noms(iq).eq."dust_mass") then
	191	idust_mass=iq
[1005]	192	write(,)"callsedim: idust_mass=",idust_mass
[38]	193	endif
	194	if (noms(iq).eq."dust_number") then
	195	idust_number=iq
[1005]	196	write(,)"callsedim: idust_number=",idust_number
[38]	197	endif
	198	enddo
	199
	200	! check that we did find the tracers
	201	if ((idust_mass.eq.0).or.(idust_number.eq.0)) then
	202	write(,) 'callsedim: error! could not identify'
	203	write(,) ' tracers for dust mass and number mixing'
	204	write(,) ' ratio and doubleq is activated!'
	205	stop
	206	endif
	207	ENDIF !of if (doubleq)
	208
[740]	209	IF (microphys) THEN
[358]	210	iccn_mass=0
	211	iccn_number=0
	212	do iq=1,nq
	213	if (noms(iq).eq."ccn_mass") then
	214	iccn_mass=iq
[1005]	215	write(,)"callsedim: iccn_mass=",iccn_mass
[358]	216	endif
	217	if (noms(iq).eq."ccn_number") then
	218	iccn_number=iq
[1005]	219	write(,)"callsedim: iccn_number=",iccn_number
[358]	220	endif
	221	enddo
	222	! check that we did find the tracers
	223	if ((iccn_mass.eq.0).or.(iccn_number.eq.0)) then
	224	write(,) 'callsedim: error! could not identify'
	225	write(,) ' tracers for ccn mass and number mixing'
[740]	226	write(,) ' ratio and microphys is activated!'
[358]	227	stop
	228	endif
[740]	229	ENDIF !of if (microphys)
[358]	230
[1720]	231	IF (co2clouds) THEN
[1617]	232	iccnco2_mass=0
	233	iccnco2_number=0
	234	ico2_ice=0
	235	do iq=1,nq
	236	if (noms(iq).eq."ccnco2_mass") then
	237	iccnco2_mass=iq
	238	write(,)"callsedim: iccnco2_mass=",iccnco2_mass
	239	endif
	240	if (noms(iq).eq."co2_ice") then
	241	ico2_ice=iq
	242	write(,)"callsedim: ico2_ice=",ico2_ice
	243	endif
	244	if (noms(iq).eq."ccnco2_number") then
	245	iccnco2_number=iq
	246	write(,)"callsedim: iccnco2_number=",iccnco2_number
	247	endif
	248	enddo
	249	! check that we did find the tracers
	250	if ((iccnco2_mass.eq.0).or.(iccnco2_number.eq.0)) then
	251	write(,) 'callsedim: error! could not identify'
	252	write(,) ' tracers for ccn co2 mass and number mixing'
[1720]	253	write(,) ' ratio and co2clouds are activated!'
[1617]	254	stop
	255	endif
[1720]	256	ENDIF !of if (co2clouds)
[1617]	257
[1974]	258	IF (water) THEN
[626]	259	write(,) "correction for the shape of the ice particles ?"
	260	beta=0.75 ! default value
	261	call getin("ice_shape",beta)
	262	write(,) " ice_shape = ",beta
	263
	264	write(,) "water_param nueff Sedimentation:", nuice_sed
	265	IF (activice) THEN
	266	write(,) "water_param nueff Radiative:", nuice_ref
	267	ENDIF
[1974]	268	ENDIF
	269
	270	IF (rdstorm) THEN ! identifying stormdust tracers for sedimentation
	271	istormdust_mass=0 ! dummy initialization
	272	istormdust_number=0 ! dummy initialization
	273
	274	do iq=1,nq
	275	if (noms(iq).eq."stormdust_mass") then
	276	istormdust_mass=iq
	277	write(,)"callsedim: istormdust_mass=",istormdust_mass
	278	endif
	279	if (noms(iq).eq."stormdust_number") then
	280	istormdust_number=iq
	281	write(,)"callsedim: istormdust_number=",
	282	& istormdust_number
	283	endif
	284	enddo
	285
	286	! check that we did find the tracers
	287	if ((istormdust_mass.eq.0).or.(istormdust_number.eq.0)) then
	288	write(,) 'callsedim: error! could not identify'
	289	write(,) ' tracers for stormdust mass and number mixing'
	290	write(,) ' ratio and rdstorm is activated!'
	291	stop
	292	endif
	293	ENDIF !of if (rdstorm)
[2199]	294
	295	IF (slpwind) THEN ! identifying topdust tracers for sedimentation
	296	itopdust_mass=0 ! dummy initialization
	297	itopdust_number=0 ! dummy initialization
	298
	299	do iq=1,nq
	300	if (noms(iq).eq."topdust_mass") then
	301	itopdust_mass=iq
	302	write(,)"callsedim: itopdust_mass=",itopdust_mass
	303	endif
	304	if (noms(iq).eq."topdust_number") then
	305	itopdust_number=iq
	306	write(,)"callsedim: itopdust_number=",
	307	& itopdust_number
	308	endif
	309	enddo
	310
	311	! check that we did find the tracers
	312	if ((itopdust_mass.eq.0).or.(itopdust_number.eq.0)) then
	313	write(,) 'callsedim: error! could not identify'
	314	write(,) ' tracers for topdust mass and number mixing'
	315	write(,) ' ratio and slpwind is activated!'
	316	stop
	317	endif
	318	ENDIF !of if (slpwind)
	319
[38]	320	firstcall=.false.
	321	ENDIF ! of IF (firstcall)
	322
	323	c-----------------------------------------------------------------------
	324	c 1. Initialization
	325	c -----------------
	326
[1005]	327	! zqi(1:ngrid,1:nlay,1:nqmx) = 0.
	328	c Update the mass mixing ratio and temperature with the tendencies coming
[38]	329	c from other parameterizations:
	330	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
[1005]	331	zqi(1:ngrid,1:nlay,1:nq)=pq(1:ngrid,1:nlay,1:nq)
	332	& +pdqfi(1:ngrid,1:nlay,1:nq)*ptimestep
	333	zt(1:ngrid,1:nlay)=pt(1:ngrid,1:nlay)
	334	& +pdt(1:ngrid,1:nlay)*ptimestep
[38]	335
	336	c Computing the different layer properties
	337	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	338	c Mass (kg.m-2), thickness(m), crossing time (s) etc.
	339
	340	do l=1,nlay
	341	do ig=1, ngrid
	342	masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g
	343	epaisseur(ig,l)= zlev(ig,l+1) - zlev(ig,l)
	344	end do
	345	end do
	346
	347	c =================================================================
[358]	348	c Compute the geometric mean radius used for sedimentation
	349
	350	if (doubleq) then
	351	do l=1,nlay
	352	do ig=1, ngrid
[740]	353
	354	call updaterdust(zqi(ig,l,igcm_dust_mass),
	355	& zqi(ig,l,igcm_dust_number),r0dust(ig,l),
	356	& tauscaling(ig))
	357
[358]	358	end do
	359	end do
	360	endif
[2199]	361	c rocket dust storm
[1974]	362	if (rdstorm) then
	363	do l=1,nlay
	364	do ig=1, ngrid
	365
	366	call updaterdust(zqi(ig,l,igcm_stormdust_mass),
	367	& zqi(ig,l,igcm_stormdust_number),r0stormdust(ig,l),
	368	& tauscaling(ig))
	369
	370	end do
	371	end do
	372	endif
[2199]	373	c entrainment by slope wind
	374	if (slpwind) then
	375	do l=1,nlay
	376	do ig=1, ngrid
	377
	378	call updaterdust(zqi(ig,l,igcm_topdust_mass),
	379	& zqi(ig,l,igcm_topdust_number),r0topdust(ig,l),
	380	& tauscaling(ig))
	381
	382	end do
	383	end do
	384	endif
[358]	385	c =================================================================
[38]	386	do iq=1,nq
[1617]	387	if(radius(iq).gt.1.e-9 .and.(iq.ne.ico2_ice) .and.
	388	& (iq .ne. iccnco2_mass) .and. (iq .ne.
	389	& iccnco2_number)) then ! no sedim for gaz or CO2 clouds (done in microtimestep)
[38]	390
	391	c -----------------------------------------------------------------
	392	c DOUBLEQ CASE
	393	c -----------------------------------------------------------------
[2199]	394	if ( doubleq.and.
[1974]	395	& ((iq.eq.idust_mass).or.(iq.eq.idust_number).or.
[2199]	396	& (iq.eq.istormdust_mass).or.(iq.eq.istormdust_number).or.
	397	& (iq.eq.itopdust_mass).or.(iq.eq.itopdust_number)) ) then
[740]	398
[38]	399	c Computing size distribution:
	400	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	401
[1974]	402	if ((iq.eq.idust_mass).or.(iq.eq.idust_number)) then
[358]	403	do l=1,nlay
	404	do ig=1, ngrid
	405	r0(ig,l)=r0dust(ig,l)
	406	end do
[38]	407	end do
[1974]	408	else if ((iq.eq.istormdust_mass).or.
	409	& (iq.eq.istormdust_number)) then
	410	do l=1,nlay
	411	do ig=1, ngrid
	412	r0(ig,l)=r0stormdust(ig,l)
	413	end do
	414	end do
[2199]	415	else if ((iq.eq.itopdust_mass).or.
	416	& (iq.eq.itopdust_number)) then
	417	do l=1,nlay
	418	do ig=1, ngrid
	419	r0(ig,l)=r0topdust(ig,l)
	420	end do
	421	end do
[1974]	422	endif
	423	sigma0 = varian
[38]	424
	425	c Computing mass mixing ratio for each particle size
	426	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
[2199]	427	IF ((iq.EQ.idust_mass).or.(iq.EQ.istormdust_mass)
	428	& .or.(iq.EQ.itopdust_mass)) then
[38]	429	radpower = 2
[520]	430	ELSE ! number
[38]	431	radpower = -1
	432	ENDIF
	433	Sq(1:ngrid,1:nlay) = 0.
	434	do ir=1,nr
	435	do l=1,nlay
	436	do ig=1,ngrid
	437	c ****************
	438	c Size distribution integration
	439	c (Trapezoid Integration Method)
	440	qr(ig,l,ir)=0.5(rr(2,ir)-rr(1,ir))
	441	& (rr(1,ir)*radpower)
[358]	442	& exp(-(log(rr(1,ir)/r0(ig,l)))*2/(2sigma0**2))
[38]	443	do iint=2,ninter-1
	444	qr(ig,l,ir)=qr(ig,l,ir) +
	445	& 0.5(rr(iint+1,ir)-rr(iint-1,ir))
	446	& (rr(iint,ir)*radpower)
	447	& exp(-(log(rr(iint,ir)/r0(ig,l)))**2/
[358]	448	& (2sigma0*2))
[38]	449	end do
	450	qr(ig,l,ir)=qr(ig,l,ir) +
	451	& 0.5(rr(ninter,ir)-rr(ninter-1,ir))
	452	& (rr(ninter,ir)*radpower)
	453	& exp(-(log(rr(ninter,ir)/r0(ig,l)))**2/
[358]	454	& (2sigma0*2))
[38]	455
	456	c **************** old method (not recommended!)
	457	c qr(ig,l,ir)=(rd(ir)*(5-3iq))*
[358]	458	c & exp( -(log(rd(ir)/r0(ig,l)))*2 / (2sigma0**2) )
[38]	459	c ******************************
	460
	461	Sq(ig,l)=Sq(ig,l)+qr(ig,l,ir)
	462	enddo
	463	enddo
	464	enddo
	465
	466	do ir=1,nr
	467	do l=1,nlay
	468	do ig=1,ngrid
	469	qr(ig,l,ir) = zqi(ig,l,iq)*qr(ig,l,ir)/Sq(ig,l)
	470	enddo
	471	enddo
	472	enddo
	473
	474	c Computing sedimentation for each tracer
	475	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	476
	477	zqi(1:ngrid,1:nlay,iq) = 0.
	478	pdqs_sed(1:ngrid,iq) = 0.
	479
	480	do ir=1,nr
[358]	481	call newsedim(ngrid,nlay,1,1,ptimestep,
[1913]	482	& pplev,masse,epaisseur,zt,rd(ir),(/rho_dust/),qr(1,1,ir),
[358]	483	& wq,0.5)
[38]	484
	485	c Tendencies
	486	c ~~~~~~~~~~
	487	do ig=1,ngrid
	488	pdqs_sed(ig,iq) = pdqs_sed(ig,iq)
	489	& + wq(ig,1)/ptimestep
	490	end do
	491	DO l = 1, nlay
	492	DO ig=1,ngrid
	493	zqi(ig,l,iq)=zqi(ig,l,iq)+qr(ig,l,ir)
	494	ENDDO
[1974]	495	ENDDO
[38]	496	enddo ! of do ir=1,nr
	497	c -----------------------------------------------------------------
[626]	498	c WATER CYCLE CASE
[38]	499	c -----------------------------------------------------------------
[626]	500	else if ((iq .eq. iccn_mass) .or. (iq .eq. iccn_number)
	501	& .or. (iq .eq. igcm_h2o_ice)) then
	502	if (microphys) then
	503	! water ice sedimentation
	504	call newsedim(ngrid,nlay,ngridnlay,ngridnlay,
[1005]	505	& ptimestep,pplev,masse,epaisseur,zt,rsedcloud,rhocloud,
[626]	506	& zqi(1,1,iq),wq,beta)
	507	else
	508	! water ice sedimentation
	509	call newsedim(ngrid,nlay,ngrid*nlay,1,
[1005]	510	& ptimestep,pplev,masse,epaisseur,zt,rsedcloud,rho_q(iq),
[626]	511	& zqi(1,1,iq),wq,beta)
	512	endif ! of if (microphys)
[38]	513	c Tendencies
	514	c ~~~~~~~~~~
[626]	515	do ig=1,ngrid
	516	pdqs_sed(ig,iq)=wq(ig,1)/ptimestep
	517	end do
[38]	518	c -----------------------------------------------------------------
	519	c GENERAL CASE
	520	c -----------------------------------------------------------------
[626]	521	else
[358]	522	call newsedim(ngrid,nlay,1,1,ptimestep,
[1005]	523	& pplev,masse,epaisseur,zt,radius(iq),rho_q(iq),
[38]	524	& zqi(1,1,iq),wq,1.0)
	525	c Tendencies
	526	c ~~~~~~~~~~
	527	do ig=1,ngrid
	528	pdqs_sed(ig,iq)=wq(ig,1)/ptimestep
	529	end do
	530	endif ! of if doubleq and if water
	531	c -----------------------------------------------------------------
	532
[358]	533	c Compute the final tendency:
	534	c ---------------------------
[38]	535	DO l = 1, nlay
	536	DO ig=1,ngrid
	537	pdqsed(ig,l,iq)=(zqi(ig,l,iq)-
	538	$ (pq(ig,l,iq) + pdqfi(ig,l,iq)*ptimestep))/ptimestep
	539	ENDDO
	540	ENDDO
	541
	542	endif ! of if(radius(iq).gt.1.e-9)
	543	c =================================================================
	544	enddo ! of do iq=1,nq
[1005]	545
[358]	546	c Update the dust particle size "rdust"
	547	c -------------------------------------
[635]	548	if (doubleq) then
	549	DO l = 1, nlay
[358]	550	DO ig=1,ngrid
[740]	551
	552
	553	call updaterdust(zqi(ig,l,igcm_dust_mass),
	554	& zqi(ig,l,igcm_dust_number),rdust(ig,l),
	555	& tauscaling(ig))
	556
	557
[358]	558	ENDDO
[635]	559	ENDDO
	560	endif ! of if (doubleq)
[1974]	561
	562	if (rdstorm) then
	563	DO l = 1, nlay
	564	DO ig=1,ngrid
	565	call updaterdust(zqi(ig,l,igcm_stormdust_mass),
	566	& zqi(ig,l,igcm_stormdust_number),rstormdust(ig,l),
	567	& tauscaling(ig))
	568	ENDDO
	569	ENDDO
	570	endif ! of if (rdstorm)
[2199]	571
	572	if (slpwind) then
	573	DO l = 1, nlay
	574	DO ig=1,ngrid
	575	call updaterdust(zqi(ig,l,igcm_topdust_mass),
	576	& zqi(ig,l,igcm_topdust_number),rtopdust(ig,l),
	577	& tauscaling(ig))
	578	ENDDO
	579	ENDDO
	580	endif ! of if (slpwind)
[1974]	581
[411]	582	c Update the ice particle size "rice"
	583	c -------------------------------------
[635]	584	if (water) then
[740]	585	IF(microphys) THEN
	586
	587
[626]	588	DO l = 1, nlay
	589	DO ig=1,ngrid
[740]	590
	591	call updaterice_micro(zqi(ig,l,igcm_h2o_ice),
	592	& zqi(ig,l,igcm_ccn_mass),zqi(ig,l,igcm_ccn_number),
	593	& tauscaling(ig),rice(ig,l),rhocloud(ig,l))
[626]	594
	595	ENDDO
	596	ENDDO
[740]	597
[635]	598	ELSE
[740]	599
[626]	600	DO l = 1, nlay
	601	DO ig=1,ngrid
[740]	602
	603	call updaterice_typ(zqi(ig,l,igcm_h2o_ice),
	604	& tau(ig,1),zlay(ig,l),rice(ig,l))
	605
[626]	606	ENDDO
	607	ENDDO
[740]	608	ENDIF ! of IF(microphys)
[635]	609	endif ! of if (water)
[358]	610
[1962]	611	END SUBROUTINE callsedim
	612
	613	END MODULE callsedim_mod
[1974]	614

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

Download in other formats:

Original Format