Context Navigation

simpleclouds.F @ 3807

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

Rev	Line
[358]	1	subroutine simpleclouds(ngrid,nlay,ptimestep,
[645]	2	& pplay,pzlay,pt,pdt,
[520]	3	& pq,pdq,pdqcloud,pdtcloud,
[633]	4	& nq,tau,rice)
[3726]	5	USE updaterad, ONLY: updaterice_typ
[1996]	6	USE watersat_mod, ONLY: watersat
[2312]	7	use tracer_mod, only: igcm_h2o_vap, igcm_h2o_ice,
[2324]	8	& igcm_hdo_vap, igcm_hdo_ice,
	9	& qperemin
[3726]	10	use comcstfi_h, only: cpp
[1246]	11	use dimradmars_mod, only: naerkind
[3726]	12	use callkeys_mod, only: hdo, hdofrac
[2312]	13
[358]	14	implicit none
	15	c------------------------------------------------------------------
	16	c This routine is used to form clouds when a parcel of the GCM is
	17	c saturated. It is a simplified scheme, and there is almost no
	18	c microphysics involved. When the air is saturated, water-ice
	19	c clouds form on a fraction of the dust particles, specified by
	20	c the constant called "ccn_factor". There is no supersaturation,
	21	c and no nucleation rates computed. A more accurate scheme can
	22	c be found in the routine called "improvedclouds.F".
	23
	24	c Modif de zq si saturation dans l'atmosphere
	25	c si zq(ig,l)> zqsat(ig,l) -> zq(ig,l)=zqsat(ig,l)
	26	c Le test est effectue de bas en haut. L'eau condensee
	27	c (si saturation) est remise dans la couche en dessous.
	28	c L'eau condensee dans la couche du bas est deposee a la surface
	29
	30	c Authors: Franck Montmessin (water ice scheme)
	31	c Francois Forget (changed nuclei density & outputs)
	32	c Ehouarn Millour (sept.2008, tracers are now handled
	33	c by name and not fixed index)
	34	c J.-B. Madeleine (developed a single routine called
	35	c simpleclouds.F, and corrected calculations
	36	c of the typical CCN profile, Oct. 2011)
	37	c------------------------------------------------------------------
	38	c Arguments:
	39	c ---------
	40	c Inputs:
	41	INTEGER ngrid,nlay
	42	integer nq ! nombre de traceurs
	43	REAL ptimestep ! pas de temps physique (s)
	44	REAL pplay(ngrid,nlay) ! pression au milieu des couches (Pa)
	45	REAL pzlay(ngrid,nlay) ! altitude at the middle of the layers
	46	REAL pt(ngrid,nlay) ! temperature at the middle of the
	47	! layers (K)
	48	REAL pdt(ngrid,nlay) ! tendance temperature des autres
	49	! param.
	50	real pq(ngrid,nlay,nq) ! traceur (kg/kg)
	51	real pdq(ngrid,nlay,nq) ! tendance avant condensation
	52	! (kg/kg.s-1)
[1047]	53	REAL tau(ngrid,naerkind) ! Column dust optical depth at each point
[358]	54
	55	c Output:
	56	REAL rice(ngrid,nlay) ! Ice mass mean radius (m)
	57	! (r_c in montmessin_2004)
	58	real pdqcloud(ngrid,nlay,nq) ! tendance de la condensation
	59	! H2O(kg/kg.s-1)
	60	REAL pdtcloud(ngrid,nlay) ! tendance temperature due
	61	! a la chaleur latente
	62
	63	c------------------------------------------------------------------
	64	c Local variables:
	65
[1047]	66	REAL rhocloud(ngrid,nlay) ! Cloud density (kg.m-3)
[358]	67
	68	INTEGER ig,l
	69
[1047]	70	REAL zq(ngrid,nlay,nq) ! local value of tracers
	71	REAL zq0(ngrid,nlay,nq) ! local initial value of tracers
	72	REAL zt(ngrid,nlay) ! local value of temperature
	73	REAL zqsat(ngrid,nlay) ! saturation
[358]	74	REAL*8 dzq ! masse de glace echangee (kg/kg)
	75	REAL lw !Latent heat of sublimation (J.kg-1)
	76	REAL,PARAMETER :: To=273.15 ! reference temperature, T=273.15 K
[1047]	77	real rdusttyp(ngrid,nlay) ! Typical dust geom. mean radius (m)
	78	REAL ccntyp(ngrid,nlay)
[358]	79	! Typical dust number density (#/kg)
[2312]	80	REAL alpha_c(ngrid,nlay) !!MARGAUX: alpha_c as a spatial variable
	81
[358]	82	c CCN reduction factor
[420]	83	c REAL, PARAMETER :: ccn_factor = 4.5 !! comme TESTS_JB // 1. avant
[2312]	84	REAL DoH_vap(ngrid,nlay)
	85	REAL DoH_ice(ngrid,nlay)
[358]	86	c-----------------------------------------------------------------------
	87	c 1. initialisation
	88	c -----------------
	89
[1036]	90	c On "update" la valeur de q(nq) (water vapor) et temperature.
[358]	91	c On effectue qqes calculs preliminaires sur les couches :
	92
	93	do l=1,nlay
	94	do ig=1,ngrid
	95	zq(ig,l,igcm_h2o_vap)=
	96	& pq(ig,l,igcm_h2o_vap)+pdq(ig,l,igcm_h2o_vap)*ptimestep
	97	zq(ig,l,igcm_h2o_vap)=max(zq(ig,l,igcm_h2o_vap),1.E-30) ! FF 12/2004
	98	zq0(ig,l,igcm_h2o_vap)=zq(ig,l,igcm_h2o_vap)
	99	zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep
	100
	101	zq(ig,l,igcm_h2o_ice)=
	102	& pq(ig,l,igcm_h2o_ice)+pdq(ig,l,igcm_h2o_ice)*ptimestep
	103	zq(ig,l,igcm_h2o_ice)=max(zq(ig,l,igcm_h2o_ice),0.) ! FF 12/2004
	104	zq0(ig,l,igcm_h2o_ice)=zq(ig,l,igcm_h2o_ice)
[2312]	105
	106	if (hdo) then
	107	zq(ig,l,igcm_hdo_vap)=
	108	& pq(ig,l,igcm_hdo_vap)+pdq(ig,l,igcm_hdo_vap)*ptimestep
	109	zq(ig,l,igcm_hdo_vap)=max(zq(ig,l,igcm_hdo_vap),1e-30) ! FF 12/2004
	110	zq0(ig,l,igcm_hdo_vap)=zq(ig,l,igcm_hdo_vap)
	111
	112	zq(ig,l,igcm_hdo_ice)=
	113	& pq(ig,l,igcm_hdo_ice)+pdq(ig,l,igcm_hdo_ice)*ptimestep
	114	zq(ig,l,igcm_hdo_ice)=max(zq(ig,l,igcm_hdo_ice),1e-30) ! FF 12/2004
	115	zq0(ig,l,igcm_hdo_ice)=zq(ig,l,igcm_hdo_ice)
	116
	117	endif !hdo
[358]	118	enddo
	119	enddo
	120
	121	pdqcloud(1:ngrid,1:nlay,1:nq)=0
	122	pdtcloud(1:ngrid,1:nlay)=0
	123
[2312]	124	alpha_c(1:ngrid,1:nlay)=0.
	125
[358]	126	c ----------------------------------------------
	127	c
	128	c Rapport de melange a saturation dans la couche l : -------
	129	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	130
[1047]	131	call watersat(ngrid*nlay,zt,pplay,zqsat)
[358]	132
	133	c taux de condensation (kg/kg/s-1) dans les differentes couches
	134	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	135
	136	do l=1,nlay
	137	do ig=1,ngrid
	138
	139	if (zq(ig,l,igcm_h2o_vap).ge.zqsat(ig,l))then ! Condensation
[2312]	140	dzq=zq(ig,l,igcm_h2o_vap)-zqsat(ig,l)
	141
[358]	142	elseif(zq(ig,l,igcm_h2o_vap).lt.zqsat(ig,l))then ! Sublimation
	143	dzq=-min(zqsat(ig,l)-zq(ig,l,igcm_h2o_vap),
	144	& zq(ig,l,igcm_h2o_ice))
	145	endif
[2312]	146
[358]	147	c Water Mass change
	148	c ~~~~~~~~~~~~~~~~~
	149	zq(ig,l,igcm_h2o_ice)=zq(ig,l,igcm_h2o_ice)+dzq
	150	zq(ig,l,igcm_h2o_vap)=zq(ig,l,igcm_h2o_vap)-dzq
[2312]	151
[358]	152	enddo ! of do ig=1,ngrid
	153	enddo ! of do l=1,nlay
	154
[2312]	155
[358]	156	c Tendance finale
	157	c ~~~~~~~~~~~~~~~
	158	do l=1, nlay
[1047]	159	do ig=1,ngrid
[358]	160	pdqcloud(ig,l,igcm_h2o_vap)=(zq(ig,l,igcm_h2o_vap)
	161	& -zq0(ig,l,igcm_h2o_vap))/ptimestep
	162	pdqcloud(ig,l,igcm_h2o_ice) =
	163	& (zq(ig,l,igcm_h2o_ice) - zq0(ig,l,igcm_h2o_ice))/ptimestep
[2312]	164
[358]	165	lw=(2834.3-0.28(zt(ig,l)-To)-0.004(zt(ig,l)-To)*2)1.e+3
	166	pdtcloud(ig,l)=-pdqcloud(ig,l,igcm_h2o_vap)*lw/cpp
	167
[2312]	168	if (hdo) then
	169	if (pdqcloud(ig,l,igcm_h2o_ice).gt.0.0) then !condens
	170
	171	if (hdofrac) then ! do we use fractionation?
[2378]	172	c alpha_c(ig,l) = exp(16288./zt(ig,l)**2.-9.34d-2)
	173	alpha_c(ig,l) = exp(13525./zt(ig,l)**2.-5.59d-2) !Lamb
[2312]	174	else
	175	alpha_c(ig,l) = 1.d0
	176	endif
	177
[2324]	178	if (zq0(ig,l,igcm_h2o_vap).gt.qperemin) then
[2312]	179	pdqcloud(ig,l,igcm_hdo_ice)=
	180	& pdqcloud(ig,l,igcm_h2o_ice)alpha_c(ig,l)
	181	& ( zq0(ig,l,igcm_hdo_vap)
	182	& /zq0(ig,l,igcm_h2o_vap) )
	183	else
	184	pdqcloud(ig,l,igcm_hdo_ice)= 0.0
	185	endif
	186
	187	pdqcloud(ig,l,igcm_hdo_ice) =
	188	& min(pdqcloud(ig,l,igcm_hdo_ice),
	189	& zq0(ig,l,igcm_hdo_vap)/ptimestep)
	190
	191	pdqcloud(ig,l,igcm_hdo_vap)=
	192	& -pdqcloud(ig,l,igcm_hdo_ice)
	193
	194	else ! sublimation
	195
[2324]	196	if (zq0(ig,l,igcm_h2o_ice).gt.qperemin) then
[2312]	197	pdqcloud(ig,l,igcm_hdo_ice)=
	198	& pdqcloud(ig,l,igcm_h2o_ice)*
	199	& ( zq0(ig,l,igcm_hdo_ice)
	200	& /zq0(ig,l,igcm_h2o_ice) )
	201	else
	202	pdqcloud(ig,l,igcm_hdo_ice)= 0.
	203	endif
	204
	205	pdqcloud(ig,l,igcm_hdo_ice) =
	206	& max(pdqcloud(ig,l,igcm_hdo_ice),
	207	& -zq0(ig,l,igcm_hdo_ice)/ptimestep)
	208
	209	pdqcloud(ig,l,igcm_hdo_vap)=
	210	& -pdqcloud(ig,l,igcm_hdo_ice)
	211
	212	endif ! condensation/sublimation
	213
	214	endif ! hdo
	215
	216	enddo ! of do ig=1,ngrid
	217	enddo ! of do l=1,nlay
	218
[740]	219	c ice crystal radius
	220	do l=1, nlay
[1047]	221	do ig=1,ngrid
[740]	222	call updaterice_typ(zq(ig,l,igcm_h2o_ice),
	223	& tau(ig,1),pzlay(ig,l),rice(ig,l))
	224	end do
	225	end do
	226
[2312]	227	c if (hdo) then
	228	c CALL WRITEDIAGFI(ngrid,'alpha_c',
	229	c & 'alpha_c',
	230	c & ' ',3,alpha_c)
	231	c endif !hdo
[358]	232	c------------------------------------------------------------------
	233	end

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

Download in other formats:

Original Format