Context Navigation

watercloud_mod.F @ 1771

Last change on this file since 1771 was 1758, checked in by aslmd, 8 years ago
MESOSCALE MARS. added MESOSCALE precompiling flags to writediagfis added in r1711
File size: 22.2 KB

Rev	Line
[1711]	1	MODULE watercloud_mod
	2
	3	IMPLICIT NONE
	4
	5	CONTAINS
	6
[633]	7	SUBROUTINE watercloud(ngrid,nlay,ptimestep,
	8	& pplev,pplay,pdpsrf,pzlay,pt,pdt,
[626]	9	& pq,pdq,pdqcloud,pdtcloud,
[358]	10	& nq,tau,tauscaling,rdust,rice,nuice,
[1711]	11	& rsedcloud,rhocloud,totcloudfrac)
[633]	12	! to use 'getin'
	13	USE ioipsl_getincom
[740]	14	USE updaterad
[1226]	15	USE comcstfi_h
[1036]	16	use tracer_mod, only: nqmx, igcm_h2o_vap, igcm_h2o_ice,
	17	& igcm_dust_mass, igcm_dust_number,
	18	& igcm_ccn_mass, igcm_ccn_number,
	19	& rho_dust, nuice_sed, nuice_ref
[1246]	20	use dimradmars_mod, only: naerkind
[38]	21	IMPLICIT NONE
	22
[633]	23
[38]	24	c=======================================================================
[358]	25	c Water-ice cloud formation
	26	c
	27	c Includes two different schemes:
	28	c - A simplified scheme (see simpleclouds.F)
	29	c - An improved microphysical scheme (see improvedclouds.F)
[38]	30	c
[633]	31	c There is a time loop specific to cloud formation
	32	c due to timescales smaller than the GCM integration timestep.
	33	c
[358]	34	c Authors: Franck Montmessin, Francois Forget, Ehouarn Millour,
[522]	35	c J.-B. Madeleine, Thomas Navarro
[38]	36	c
[633]	37	c 2004 - 2012
[38]	38	c=======================================================================
	39
	40	c-----------------------------------------------------------------------
	41	c declarations:
	42	c -------------
	43
	44	#include "callkeys.h"
	45
	46	c Inputs:
	47	c ------
	48
	49	INTEGER ngrid,nlay
[633]	50	INTEGER nq ! nombre de traceurs
[38]	51	REAL ptimestep ! pas de temps physique (s)
	52	REAL pplev(ngrid,nlay+1) ! pression aux inter-couches (Pa)
	53	REAL pplay(ngrid,nlay) ! pression au milieu des couches (Pa)
[633]	54	REAL pdpsrf(ngrid) ! tendence surf pressure
[38]	55	REAL pzlay(ngrid,nlay) ! altitude at the middle of the layers
	56	REAL pt(ngrid,nlay) ! temperature at the middle of the layers (K)
[633]	57	REAL pdt(ngrid,nlay) ! tendence temperature des autres param.
[38]	58
	59	real pq(ngrid,nlay,nq) ! traceur (kg/kg)
[633]	60	real pdq(ngrid,nlay,nq) ! tendence avant condensation (kg/kg.s-1)
[38]	61
[1047]	62	REAL tau(ngrid,naerkind) ! Column dust optical depth at each point
	63	REAL tauscaling(ngrid) ! Convertion factor for dust amount
	64	real rdust(ngrid,nlay) ! Dust geometric mean radius (m)
[38]	65
	66	c Outputs:
	67	c -------
	68
[633]	69	real pdqcloud(ngrid,nlay,nq) ! tendence de la condensation H2O(kg/kg.s-1)
	70	REAL pdtcloud(ngrid,nlay) ! tendence temperature due
	71	! a la chaleur latente
[38]	72
	73	REAL rice(ngrid,nlay) ! Ice mass mean radius (m)
	74	! (r_c in montmessin_2004)
	75	REAL nuice(ngrid,nlay) ! Estimated effective variance
	76	! of the size distribution
[1047]	77	real rsedcloud(ngrid,nlay) ! Cloud sedimentation radius
	78	real rhocloud(ngrid,nlay) ! Cloud density (kg.m-3)
[38]	79
[1711]	80	REAL, INTENT(INOUT):: totcloudfrac(ngrid) ! Cloud fraction (A. Pottier 2013)
[38]	81	c local:
	82	c ------
[633]	83
	84	! for ice radius computation
	85	REAL Mo,No
	86	REAl ccntyp
	87
	88	! for time loop
	89	INTEGER microstep ! time subsampling step variable
	90	INTEGER imicro ! time subsampling for coupled water microphysics & sedimentation
	91	SAVE imicro
	92	REAL microtimestep ! integration timestep for coupled water microphysics & sedimentation
	93	SAVE microtimestep
	94
	95	! tendency given by clouds (inside the micro loop)
	96	REAL subpdqcloud(ngrid,nlay,nq) ! cf. pdqcloud
	97	REAL subpdtcloud(ngrid,nlay) ! cf. pdtcloud
[38]	98
[633]	99	! global tendency (clouds+physics)
	100	REAL subpdq(ngrid,nlay,nq) ! cf. pdqcloud
	101	REAL subpdt(ngrid,nlay) ! cf. pdtcloud
	102
[1467]	103	! no supersaturation when option supersat is false
	104	REAL zt(ngrid,nlay) ! local value of temperature
	105	REAL zqsat(ngrid,nlay) ! saturation
[633]	106
	107	INTEGER iq,ig,l
[38]	108	LOGICAL,SAVE :: firstcall=.true.
	109
[1711]	110	! Representation of sub-grid water ice clouds A. Pottier 2013
	111	! REAL :: zt(ngrid, nlay)
	112	REAL :: zq(ngrid, nlay,nq)
	113	REAL :: zdelt
	114	REAL :: norm
	115	REAL :: ponder
	116	REAL :: tcond(ngrid,nlay)
	117	REAL :: zqvap(ngrid,nlay)
	118	REAL :: zqice(ngrid,nlay)
	119	REAL :: spant ! delta T for the temperature distribution
	120	! REAL :: zqsat(ngrid,nlay) ! saturation
	121	REAL :: zteff(ngrid, nlay)! effective temperature in the cloud,neb
	122	REAL :: pqeff(ngrid, nlay, nq)! effective tracers quantities in the cloud
	123	REAL :: cloudfrac(ngrid,nlay) ! cloud fraction
	124	REAL :: mincloud ! min cloud frac
	125	LOGICAL, save :: flagcloud=.true.
[38]	126	c ** un petit test de coherence
	127	c --------------------------
	128
	129	IF (firstcall) THEN
	130
	131	if (nq.gt.nqmx) then
	132	write(,) 'stop in watercloud (nq.gt.nqmx)!'
	133	write(,) 'nq=',nq,' nqmx=',nqmx
	134	stop
	135	endif
	136
[358]	137	write(,) "watercloud: igcm_h2o_vap=",igcm_h2o_vap
	138	write(,) " igcm_h2o_ice=",igcm_h2o_ice
[633]	139
	140	write(,) "time subsampling for microphysic ?"
	141	#ifdef MESOSCALE
	142	imicro = 2
	143	#else
[951]	144	imicro = 30
[633]	145	#endif
	146	call getin("imicro",imicro)
	147	write(,)"imicro = ",imicro
	148
	149	microtimestep = ptimestep/real(imicro)
	150	write(,)"Physical timestep is",ptimestep
	151	write(,)"Microphysics timestep is",microtimestep
[38]	152
	153	firstcall=.false.
	154	ENDIF ! of IF (firstcall)
[522]	155
[633]	156	c-----Initialization
	157	subpdq(1:ngrid,1:nlay,1:nq) = 0
	158	subpdt(1:ngrid,1:nlay) = 0
	159
	160	! default value if no ice
	161	rhocloud(1:ngrid,1:nlay) = rho_dust
[38]	162
[1711]	163	c-------------------------------------------------------------------
	164	c 0. Representation of sub-grid water ice clouds
	165	c------------------
	166	c-----Tendencies
	167	DO l=1,nlay
	168	DO ig=1,ngrid
	169	zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep
	170	ENDDO
	171	ENDDO
	172	DO l=1,nlay
	173	DO ig=1,ngrid
	174	DO iq=1,nq
	175	zq(ig,l,iq)=pq(ig,l,iq)+pdq(ig,l,iq)*ptimestep
	176	ENDDO
	177	ENDDO
	178	ENDDO
	179	c-----Effective temperature calculation
	180	IF (CLFvarying) THEN
	181	spant=3.0 ! delta T for the temprature distribution
	182	mincloud=0.1 ! min cloudfrac when there is ice
	183	IF (flagcloud) THEN
	184	write(,) "Delta T", spant
	185	write(,) "mincloud", mincloud
	186	flagcloud=.false.
	187	END IF
	188	CALL watersat(ngrid*nlay,zt,pplay,zqsat)
	189	zqvap=zq(:,:,igcm_h2o_vap)
	190	zqice=zq(:,:,igcm_h2o_ice)
	191	CALL tcondwater(ngrid*nlay,pplay,zqvap+zqice,tcond)
	192	DO l=1,nlay
	193	DO ig=1,ngrid
	194	zdelt=spant !MAX(spant*zt(ig,l),1.e-12), now totally in K. Fixed width
	195	IF (tcond(ig,l) .ge. (zt(ig,l)+zdelt)) THEN
	196	zteff(ig,l)=zt(ig,l)
	197	cloudfrac(ig,l)=1.
	198	ELSE IF (tcond(ig,l) .le. (zt(ig,l)-zdelt)) THEN
	199	zteff(ig,l)=zt(ig,l)-zdelt
	200	cloudfrac(ig,l)=mincloud
	201	ELSE
	202	cloudfrac(ig,l)=(tcond(ig,l)-zt(ig,l)+zdelt)/
	203	& (2.0*zdelt)
	204	zteff(ig,l)=(tcond(ig,l)+zt(ig,l)-zdelt)/2.
	205	END IF
	206	zteff(ig,l)=zteff(ig,l)-pdt(ig,l)*ptimestep
	207	IF (cloudfrac(ig,l).le.0) THEN
	208	cloudfrac(ig,l)=mincloud
	209	ELSE IF (cloudfrac(ig,l).gt.1) THEN
	210	cloudfrac(ig,l)=1.
	211	END IF
	212	ENDDO
	213	ENDDO
	214	c-----Calculation of the total cloud coverage of the column
	215	DO ig=1,ngrid
	216	totcloudfrac(ig) = 0.
	217	norm=0.
	218	DO l=1,nlay
	219	ponder=zqice(ig,l)*(pplev(ig,l) - pplev(ig,l+1))
	220	totcloudfrac(ig) = totcloudfrac(ig)
	221	& + cloudfrac(ig,l)*ponder
	222	norm=norm+ponder
	223	ENDDO
	224	totcloudfrac(ig)=MAX(totcloudfrac(ig)/norm,1.e-12) ! min value if NaNs
	225	ENDDO
	226	c-----No sub-grid cloud representation (CLFvarying=false)
	227	ELSE
	228	DO l=1,nlay
	229	DO ig=1,ngrid
	230	zteff(ig,l)=pt(ig,l)
	231	END DO
	232	END DO
	233	END IF ! end if (CLFvarying)
[633]	234
	235	c------------------------------------------------------------------
	236	c Time subsampling for microphysics
[1711]	237	rhocloud(1:ngrid,1:nlay) = rho_dust
[633]	238	DO microstep=1,imicro
[522]	239
[633]	240	c-------------------------------------------------------------------
	241	c 1. Tendencies:
	242	c------------------
[38]	243
[633]	244
	245	c------ Temperature tendency subpdt
	246	! Each microtimestep we give the cloud scheme a stepped entry subpdt instead of pdt
	247	! If imicro=1 subpdt is the same as pdt
	248	DO l=1,nlay
	249	DO ig=1,ngrid
	250	subpdt(ig,l) = subpdt(ig,l)
	251	& + pdt(ig,l) ! At each micro timestep we add pdt in order to have a stepped entry
	252	ENDDO
	253	ENDDO
	254	c------ Tracers tendencies subpdq
	255	c------ At each micro timestep we add pdq in order to have a stepped entry
	256	IF (microphys) THEN
	257	DO l=1,nlay
	258	DO ig=1,ngrid
	259	subpdq(ig,l,igcm_dust_mass) =
	260	& subpdq(ig,l,igcm_dust_mass)
	261	& + pdq(ig,l,igcm_dust_mass)
	262	subpdq(ig,l,igcm_dust_number) =
	263	& subpdq(ig,l,igcm_dust_number)
	264	& + pdq(ig,l,igcm_dust_number)
	265	subpdq(ig,l,igcm_ccn_mass) =
	266	& subpdq(ig,l,igcm_ccn_mass)
	267	& + pdq(ig,l,igcm_ccn_mass)
	268	subpdq(ig,l,igcm_ccn_number) =
	269	& subpdq(ig,l,igcm_ccn_number)
	270	& + pdq(ig,l,igcm_ccn_number)
	271	ENDDO
	272	ENDDO
	273	ENDIF
	274	DO l=1,nlay
	275	DO ig=1,ngrid
	276	subpdq(ig,l,igcm_h2o_ice) =
	277	& subpdq(ig,l,igcm_h2o_ice)
	278	& + pdq(ig,l,igcm_h2o_ice)
	279	subpdq(ig,l,igcm_h2o_vap) =
	280	& subpdq(ig,l,igcm_h2o_vap)
	281	& + pdq(ig,l,igcm_h2o_vap)
	282	ENDDO
	283	ENDDO
[1711]	284	c------ Effective tracers quantities in the cloud fraction
	285	IF (CLFvarying) THEN
	286	pqeff(:,:,:)=pq(:,:,:) ! prevent from buggs (A. Pottier)
	287	pqeff(:,:,igcm_ccn_mass) =pq(:,:,igcm_ccn_mass)/
	288	& cloudfrac(:,:)
	289	pqeff(:,:,igcm_ccn_number)=
	290	& pq(:,:,igcm_ccn_number)/cloudfrac(:,:)
	291	pqeff(:,:,igcm_h2o_ice)= pq(:,:,igcm_h2o_ice)/
	292	& cloudfrac(:,:)
	293	ELSE
	294	pqeff(:,:,:)=pq(:,:,:)
	295	pqeff(:,:,igcm_ccn_mass)= pq(:,:,igcm_ccn_mass)
	296	pqeff(:,:,igcm_ccn_number)= pq(:,:,igcm_ccn_number)
	297	pqeff(:,:,igcm_h2o_ice)= pq(:,:,igcm_h2o_ice)
	298	END IF
[633]	299
	300	c-------------------------------------------------------------------
	301	c 2. Main call to the different cloud schemes:
	302	c------------------------------------------------
	303	IF (microphys) THEN
	304	CALL improvedclouds(ngrid,nlay,microtimestep,
[1711]	305	& pplay,zteff,subpdt,
	306	& pqeff,subpdq,subpdqcloud,subpdtcloud,
[633]	307	& nq,tauscaling)
	308
	309	ELSE
	310	CALL simpleclouds(ngrid,nlay,microtimestep,
[1711]	311	& pplay,pzlay,zteff,subpdt,
	312	& pqeff,subpdq,subpdqcloud,subpdtcloud,
[645]	313	& nq,tau,rice)
[633]	314	ENDIF
	315
	316	c-------------------------------------------------------------------
	317	c 3. Updating tendencies after cloud scheme:
	318	c-----------------------------------------------
	319
	320	IF (microphys) THEN
	321	DO l=1,nlay
	322	DO ig=1,ngrid
	323	subpdq(ig,l,igcm_dust_mass) =
	324	& subpdq(ig,l,igcm_dust_mass)
	325	& + subpdqcloud(ig,l,igcm_dust_mass)
	326	subpdq(ig,l,igcm_dust_number) =
	327	& subpdq(ig,l,igcm_dust_number)
	328	& + subpdqcloud(ig,l,igcm_dust_number)
	329	subpdq(ig,l,igcm_ccn_mass) =
	330	& subpdq(ig,l,igcm_ccn_mass)
	331	& + subpdqcloud(ig,l,igcm_ccn_mass)
	332	subpdq(ig,l,igcm_ccn_number) =
	333	& subpdq(ig,l,igcm_ccn_number)
	334	& + subpdqcloud(ig,l,igcm_ccn_number)
	335	ENDDO
	336	ENDDO
	337	ENDIF
	338	DO l=1,nlay
	339	DO ig=1,ngrid
	340	subpdq(ig,l,igcm_h2o_ice) =
	341	& subpdq(ig,l,igcm_h2o_ice)
	342	& + subpdqcloud(ig,l,igcm_h2o_ice)
	343	subpdq(ig,l,igcm_h2o_vap) =
	344	& subpdq(ig,l,igcm_h2o_vap)
	345	& + subpdqcloud(ig,l,igcm_h2o_vap)
	346	ENDDO
	347	ENDDO
[882]	348
	349	IF (activice) THEN
	350	DO l=1,nlay
	351	DO ig=1,ngrid
	352	subpdt(ig,l) =
	353	& subpdt(ig,l) + subpdtcloud(ig,l)
	354	ENDDO
	355	ENDDO
	356	ENDIF
[633]	357
	358
	359	ENDDO ! of DO microstep=1,imicro
	360
	361	c-------------------------------------------------------------------
	362	c 6. Compute final tendencies after time loop:
	363	c------------------------------------------------
	364
	365	c------ Temperature tendency pdtcloud
	366	DO l=1,nlay
	367	DO ig=1,ngrid
	368	pdtcloud(ig,l) =
	369	& subpdt(ig,l)/real(imicro)-pdt(ig,l)
	370	ENDDO
	371	ENDDO
[740]	372
[633]	373	c------ Tracers tendencies pdqcloud
[703]	374	DO l=1,nlay
[633]	375	DO ig=1,ngrid
[703]	376	pdqcloud(ig,l,igcm_h2o_ice) =
	377	& subpdq(ig,l,igcm_h2o_ice)/real(imicro)
	378	& - pdq(ig,l,igcm_h2o_ice)
	379	pdqcloud(ig,l,igcm_h2o_vap) =
	380	& subpdq(ig,l,igcm_h2o_vap)/real(imicro)
	381	& - pdq(ig,l,igcm_h2o_vap)
[740]	382	ENDDO
	383	ENDDO
	384
	385	IF(microphys) THEN
	386	DO l=1,nlay
	387	DO ig=1,ngrid
[703]	388	pdqcloud(ig,l,igcm_ccn_mass) =
	389	& subpdq(ig,l,igcm_ccn_mass)/real(imicro)
	390	& - pdq(ig,l,igcm_ccn_mass)
	391	pdqcloud(ig,l,igcm_ccn_number) =
	392	& subpdq(ig,l,igcm_ccn_number)/real(imicro)
	393	& - pdq(ig,l,igcm_ccn_number)
[633]	394	ENDDO
[740]	395	ENDDO
	396	ENDIF
	397
	398	IF(scavenging) THEN
	399	DO l=1,nlay
	400	DO ig=1,ngrid
	401	pdqcloud(ig,l,igcm_dust_mass) =
	402	& subpdq(ig,l,igcm_dust_mass)/real(imicro)
	403	& - pdq(ig,l,igcm_dust_mass)
	404	pdqcloud(ig,l,igcm_dust_number) =
	405	& subpdq(ig,l,igcm_dust_number)/real(imicro)
	406	& - pdq(ig,l,igcm_dust_number)
	407	ENDDO
	408	ENDDO
	409	ENDIF
[633]	410
	411	c------- Due to stepped entry, other processes tendencies can add up to negative values
	412	c------- Therefore, enforce positive values and conserve mass
	413	IF(microphys) THEN
	414	DO l=1,nlay
	415	DO ig=1,ngrid
[654]	416	IF ((pq(ig,l,igcm_ccn_number) +
[633]	417	& ptimestep* (pdq(ig,l,igcm_ccn_number) +
[654]	418	& pdqcloud(ig,l,igcm_ccn_number)) .le. 1.)
	419	& .or. (pq(ig,l,igcm_ccn_mass) +
	420	& ptimestep* (pdq(ig,l,igcm_ccn_mass) +
	421	& pdqcloud(ig,l,igcm_ccn_mass)) .le. 1.e-20)) THEN
[633]	422	pdqcloud(ig,l,igcm_ccn_number) =
	423	& - pq(ig,l,igcm_ccn_number)/ptimestep
[654]	424	& - pdq(ig,l,igcm_ccn_number) + 1.
[633]	425	pdqcloud(ig,l,igcm_dust_number) =
	426	& -pdqcloud(ig,l,igcm_ccn_number)
	427	pdqcloud(ig,l,igcm_ccn_mass) =
	428	& - pq(ig,l,igcm_ccn_mass)/ptimestep
[654]	429	& - pdq(ig,l,igcm_ccn_mass) + 1.e-20
[633]	430	pdqcloud(ig,l,igcm_dust_mass) =
	431	& -pdqcloud(ig,l,igcm_ccn_mass)
	432	ENDIF
	433	ENDDO
	434	ENDDO
	435	ENDIF
	436
[740]	437	IF(scavenging) THEN
[633]	438	DO l=1,nlay
	439	DO ig=1,ngrid
[740]	440	IF ((pq(ig,l,igcm_dust_number) +
	441	& ptimestep* (pdq(ig,l,igcm_dust_number) +
	442	& pdqcloud(ig,l,igcm_dust_number)) .le. 1.)
	443	& .or. (pq(ig,l,igcm_dust_mass) +
	444	& ptimestep* (pdq(ig,l,igcm_dust_mass) +
	445	& pdqcloud(ig,l,igcm_dust_mass)) .le. 1.e-20)) THEN
	446	pdqcloud(ig,l,igcm_dust_number) =
	447	& - pq(ig,l,igcm_dust_number)/ptimestep
	448	& - pdq(ig,l,igcm_dust_number) + 1.
	449	pdqcloud(ig,l,igcm_ccn_number) =
	450	& -pdqcloud(ig,l,igcm_dust_number)
	451	pdqcloud(ig,l,igcm_dust_mass) =
	452	& - pq(ig,l,igcm_dust_mass)/ptimestep
	453	& - pdq(ig,l,igcm_dust_mass) + 1.e-20
	454	pdqcloud(ig,l,igcm_ccn_mass) =
	455	& -pdqcloud(ig,l,igcm_dust_mass)
	456	ENDIF
	457	ENDDO
	458	ENDDO
	459	ENDIF
	460
	461	DO l=1,nlay
	462	DO ig=1,ngrid
[633]	463	IF (pq(ig,l,igcm_h2o_ice) + ptimestep*
	464	& (pdq(ig,l,igcm_h2o_ice) + pdqcloud(ig,l,igcm_h2o_ice))
	465	& .le. 1.e-8) THEN
	466	pdqcloud(ig,l,igcm_h2o_ice) =
	467	& - pq(ig,l,igcm_h2o_ice)/ptimestep - pdq(ig,l,igcm_h2o_ice)
	468	pdqcloud(ig,l,igcm_h2o_vap) = -pdqcloud(ig,l,igcm_h2o_ice)
	469	ENDIF
	470	IF (pq(ig,l,igcm_h2o_vap) + ptimestep*
	471	& (pdq(ig,l,igcm_h2o_vap) + pdqcloud(ig,l,igcm_h2o_vap))
	472	& .le. 1.e-8) THEN
	473	pdqcloud(ig,l,igcm_h2o_vap) =
	474	& - pq(ig,l,igcm_h2o_vap)/ptimestep - pdq(ig,l,igcm_h2o_vap)
	475	pdqcloud(ig,l,igcm_h2o_ice) = -pdqcloud(ig,l,igcm_h2o_vap)
	476	ENDIF
	477	ENDDO
	478	ENDDO
	479
	480
	481	c------Update the ice and dust particle size "rice" for output or photochemistry
	482	c------Only rsedcloud is used for the water cycle
	483
	484	IF(scavenging) THEN
	485	DO l=1, nlay
	486	DO ig=1,ngrid
	487
[740]	488	call updaterdust(
	489	& pq(ig,l,igcm_dust_mass) + ! dust mass
	490	& (pdq(ig,l,igcm_dust_mass) + ! dust mass
	491	& pdqcloud(ig,l,igcm_dust_mass))*ptimestep, ! dust mass
	492	& pq(ig,l,igcm_dust_number) + ! dust number
	493	& (pdq(ig,l,igcm_dust_number) + ! dust number
	494	& pdqcloud(ig,l,igcm_dust_number))*ptimestep, ! dust number
	495	& rdust(ig,l))
[633]	496
	497	ENDDO
	498	ENDDO
[740]	499	ENDIF
[1467]	500
[740]	501	IF(microphys) THEN
[1467]	502
	503	! In case one does not want to allow supersatured water when using microphysics.
	504	! Not done by default.
	505	IF(.not.supersat) THEN
	506	zt = pt + (pdt+pdtcloud)*ptimestep
	507	call watersat(ngrid*nlay,zt,pplay,zqsat)
	508	DO l=1, nlay
	509	DO ig=1,ngrid
	510	IF (pq(ig,l,igcm_h2o_vap)
	511	& + (pdq(ig,l,igcm_h2o_vap) + pdqcloud(ig,l,igcm_h2o_vap))
	512	& * ptimestep .ge. zqsat(ig,l)) THEN
	513	pdqcloud(ig,l,igcm_h2o_vap) =
	514	& (zqsat(ig,l) - pq(ig,l,igcm_h2o_vap))/ptimestep
	515	& - pdq(ig,l,igcm_h2o_vap)
	516	pdqcloud(ig,l,igcm_h2o_ice) =
	517	& -pdqcloud(ig,l,igcm_h2o_vap)
	518	! no need to correct ccn_number, updaterad can handle this properly.
	519	ENDIF
	520	ENDDO
	521	ENDDO
	522	ENDIF
[740]	523
	524	DO l=1, nlay
	525	DO ig=1,ngrid
	526
	527	call updaterice_micro(
	528	& pq(ig,l,igcm_h2o_ice) + ! ice mass
	529	& (pdq(ig,l,igcm_h2o_ice) + ! ice mass
	530	& pdqcloud(ig,l,igcm_h2o_ice))*ptimestep, ! ice mass
	531	& pq(ig,l,igcm_ccn_mass) + ! ccn mass
	532	& (pdq(ig,l,igcm_ccn_mass) + ! ccn mass
	533	& pdqcloud(ig,l,igcm_ccn_mass))*ptimestep, ! ccn mass
	534	& pq(ig,l,igcm_ccn_number) + ! ccn number
	535	& (pdq(ig,l,igcm_ccn_number) + ! ccn number
	536	& pdqcloud(ig,l,igcm_ccn_number))*ptimestep, ! ccn number
	537	& tauscaling(ig),rice(ig,l),rhocloud(ig,l))
	538
[645]	539	ENDDO
[740]	540	ENDDO
[645]	541
[740]	542	ELSE ! no microphys
	543
[645]	544	DO l=1,nlay
	545	DO ig=1,ngrid
[740]	546
	547	call updaterice_typ(
	548	& pq(ig,l,igcm_h2o_ice) + ! ice mass
	549	& (pdq(ig,l,igcm_h2o_ice) + ! ice mass
	550	& pdqcloud(ig,l,igcm_h2o_ice))*ptimestep, ! ice mass
[746]	551	& tau(ig,1),pzlay(ig,l),rice(ig,l))
[740]	552
[633]	553	ENDDO
[740]	554	ENDDO
[633]	555
[740]	556	ENDIF ! of IF(microphys)
[633]	557
[740]	558
	559
[358]	560	c A correction if a lot of subliming CO2 fills the 1st layer FF04/2005
	561	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	562	c Then that should not affect the ice particle radius
[1047]	563	do ig=1,ngrid
[358]	564	if(pdpsrf(ig)ptimestep.gt.0.9(pplev(ig,1)-pplev(ig,2)))then
	565	if(pdpsrf(ig)ptimestep.gt.0.9(pplev(ig,1)-pplev(ig,3)))
	566	& rice(ig,2)=rice(ig,3)
	567	rice(ig,1)=rice(ig,2)
	568	end if
	569	end do
[740]	570
	571
	572	DO l=1,nlay
	573	DO ig=1,ngrid
	574	rsedcloud(ig,l)=max(rice(ig,l)*
	575	& (1.+nuice_sed)(1.+nuice_sed)(1.+nuice_sed),
	576	& rdust(ig,l))
	577	! rsedcloud(ig,l)=min(rsedcloud(ig,l),1.e-4)
	578	ENDDO
	579	ENDDO
	580
	581	! used for rad. transfer calculations
	582	! nuice is constant because a lognormal distribution is prescribed
	583	nuice(1:ngrid,1:nlay)=nuice_ref
[38]	584
[1711]	585	c------Update tendencies for sub-grid water ice clouds
	586	IF (CLFvarying) THEN
	587	DO ig=1,ngrid
	588	DO l=1,nlay
	589	pdqcloud(ig,l,igcm_dust_mass)=pdqcloud(ig,l,igcm_dust_mass)
	590	& *cloudfrac(ig,l)
	591	pdqcloud(ig,l,igcm_ccn_mass)=pdqcloud(ig,l,igcm_ccn_mass)
	592	& *cloudfrac(ig,l)
	593	pdqcloud(ig,l,igcm_dust_number)=pdqcloud(ig,l,
	594	& igcm_dust_number) *cloudfrac(ig,l)
	595	pdqcloud(ig,l,igcm_ccn_number)=pdqcloud(ig,l,
	596	& igcm_ccn_number) *cloudfrac(ig,l)
	597	pdqcloud(ig,l,igcm_h2o_vap)=pdqcloud(ig,l,
	598	& igcm_h2o_vap) *cloudfrac(ig,l)
	599	pdqcloud(ig,l,igcm_h2o_ice)=pdqcloud(ig,l,
	600	& igcm_h2o_ice) *cloudfrac(ig,l)
	601	ENDDO
	602	ENDDO
	603	pdtcloud(:,:)=pdtcloud(:,:)*cloudfrac(:,:)
	604	ENDIF
[1758]	605	#ifndef MESOSCALE
[1711]	606	c=======================================================================
	607	call WRITEDIAGFI(ngrid,"pdqice2","pdqcloudice apres microphysique"
	608	& ,"kg/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,igcm_h2o_ice))
	609	call WRITEDIAGFI(ngrid,"pdqvap2","pdqcloudvap apres microphysique"
	610	& ,"kg/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
	611	& igcm_h2o_vap))
	612	call WRITEDIAGFI(ngrid,"pdqccn2","pdqcloudccn apres microphysique"
	613	& ,"kg/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
	614	& igcm_ccn_mass))
	615	call WRITEDIAGFI(ngrid,"pdqccnN2","pdqcloudccnN apres
	616	& microphysique","nb/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
	617	& igcm_ccn_number))
	618	call WRITEDIAGFI(ngrid,"pdqdust2", "pdqclouddust apres
	619	& microphysique","kg/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
	620	& igcm_dust_mass))
	621	call WRITEDIAGFI(ngrid,"pdqdustN2", "pdqclouddustN apres
	622	& microphysique","nb/kg.s-1",3,pdqcloud(1:ngrid,1:nlay,
	623	& igcm_dust_number))
[633]	624	c=======================================================================
[1758]	625	#endif
[633]	626
[1711]	627	END SUBROUTINE watercloud
	628
	629	END MODULE watercloud_mod

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

Download in other formats:

Original Format