Context Navigation

watercloud.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: 15.5 KB

Rev	Line
[633]	1	SUBROUTINE watercloud(ngrid,nlay,ptimestep,
	2	& pplev,pplay,pdpsrf,pzlay,pt,pdt,
[626]	3	& pq,pdq,pdqcloud,pdtcloud,
[358]	4	& nq,tau,tauscaling,rdust,rice,nuice,
	5	& rsedcloud,rhocloud)
[633]	6	! to use 'getin'
	7	USE ioipsl_getincom
[740]	8	USE updaterad
[1226]	9	USE comcstfi_h
[1036]	10	use tracer_mod, only: nqmx, igcm_h2o_vap, igcm_h2o_ice,
	11	& igcm_dust_mass, igcm_dust_number,
	12	& igcm_ccn_mass, igcm_ccn_number,
	13	& rho_dust, nuice_sed, nuice_ref
[38]	14	IMPLICIT NONE
	15
[633]	16
[38]	17	c=======================================================================
[358]	18	c Water-ice cloud formation
	19	c
	20	c Includes two different schemes:
	21	c - A simplified scheme (see simpleclouds.F)
	22	c - An improved microphysical scheme (see improvedclouds.F)
[38]	23	c
[633]	24	c There is a time loop specific to cloud formation
	25	c due to timescales smaller than the GCM integration timestep.
	26	c
[358]	27	c Authors: Franck Montmessin, Francois Forget, Ehouarn Millour,
[522]	28	c J.-B. Madeleine, Thomas Navarro
[38]	29	c
[633]	30	c 2004 - 2012
[38]	31	c=======================================================================
	32
	33	c-----------------------------------------------------------------------
	34	c declarations:
	35	c -------------
	36
[1047]	37	!#include "dimensions.h"
	38	!#include "dimphys.h"
[38]	39	#include "callkeys.h"
[1036]	40	!#include "tracer.h"
[1047]	41	!#include "comgeomfi.h"
	42	!#include "dimradmars.h"
	43	! naerkind is set in scatterers.h (built when compiling with makegcm -s #)
	44	#include"scatterers.h"
[38]	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
	80	c local:
	81	c ------
[633]	82
	83	! for ice radius computation
	84	REAL Mo,No
	85	REAl ccntyp
	86
	87	! for time loop
	88	INTEGER microstep ! time subsampling step variable
	89	INTEGER imicro ! time subsampling for coupled water microphysics & sedimentation
	90	SAVE imicro
	91	REAL microtimestep ! integration timestep for coupled water microphysics & sedimentation
	92	SAVE microtimestep
	93
	94	! tendency given by clouds (inside the micro loop)
	95	REAL subpdqcloud(ngrid,nlay,nq) ! cf. pdqcloud
	96	REAL subpdtcloud(ngrid,nlay) ! cf. pdtcloud
[38]	97
[633]	98	! global tendency (clouds+physics)
	99	REAL subpdq(ngrid,nlay,nq) ! cf. pdqcloud
	100	REAL subpdt(ngrid,nlay) ! cf. pdtcloud
	101
	102
	103	INTEGER iq,ig,l
[38]	104	LOGICAL,SAVE :: firstcall=.true.
	105
	106	c ** un petit test de coherence
	107	c --------------------------
	108
	109	IF (firstcall) THEN
	110
	111	if (nq.gt.nqmx) then
	112	write(,) 'stop in watercloud (nq.gt.nqmx)!'
	113	write(,) 'nq=',nq,' nqmx=',nqmx
	114	stop
	115	endif
	116
[358]	117	write(,) "watercloud: igcm_h2o_vap=",igcm_h2o_vap
	118	write(,) " igcm_h2o_ice=",igcm_h2o_ice
[633]	119
	120	write(,) "time subsampling for microphysic ?"
	121	#ifdef MESOSCALE
	122	imicro = 2
	123	#else
[951]	124	imicro = 30
[633]	125	#endif
	126	call getin("imicro",imicro)
	127	write(,)"imicro = ",imicro
	128
	129	microtimestep = ptimestep/real(imicro)
	130	write(,)"Physical timestep is",ptimestep
	131	write(,)"Microphysics timestep is",microtimestep
[38]	132
	133	firstcall=.false.
	134	ENDIF ! of IF (firstcall)
[522]	135
[633]	136	c-----Initialization
	137	subpdq(1:ngrid,1:nlay,1:nq) = 0
	138	subpdt(1:ngrid,1:nlay) = 0
	139
	140	! default value if no ice
	141	rhocloud(1:ngrid,1:nlay) = rho_dust
[38]	142
[633]	143
	144
	145	c------------------------------------------------------------------
	146	c Time subsampling for microphysics
	147	c------------------------------------------------------------------
	148	DO microstep=1,imicro
[522]	149
[633]	150	c-------------------------------------------------------------------
	151	c 1. Tendencies:
	152	c------------------
[38]	153
[633]	154
	155	c------ Temperature tendency subpdt
	156	! Each microtimestep we give the cloud scheme a stepped entry subpdt instead of pdt
	157	! If imicro=1 subpdt is the same as pdt
	158	DO l=1,nlay
	159	DO ig=1,ngrid
	160	subpdt(ig,l) = subpdt(ig,l)
	161	& + pdt(ig,l) ! At each micro timestep we add pdt in order to have a stepped entry
	162	ENDDO
	163	ENDDO
	164	c------ Tracers tendencies subpdq
	165	c------ At each micro timestep we add pdq in order to have a stepped entry
	166	IF (microphys) THEN
	167	DO l=1,nlay
	168	DO ig=1,ngrid
	169	subpdq(ig,l,igcm_dust_mass) =
	170	& subpdq(ig,l,igcm_dust_mass)
	171	& + pdq(ig,l,igcm_dust_mass)
	172	subpdq(ig,l,igcm_dust_number) =
	173	& subpdq(ig,l,igcm_dust_number)
	174	& + pdq(ig,l,igcm_dust_number)
	175	subpdq(ig,l,igcm_ccn_mass) =
	176	& subpdq(ig,l,igcm_ccn_mass)
	177	& + pdq(ig,l,igcm_ccn_mass)
	178	subpdq(ig,l,igcm_ccn_number) =
	179	& subpdq(ig,l,igcm_ccn_number)
	180	& + pdq(ig,l,igcm_ccn_number)
	181	ENDDO
	182	ENDDO
	183	ENDIF
	184	DO l=1,nlay
	185	DO ig=1,ngrid
	186	subpdq(ig,l,igcm_h2o_ice) =
	187	& subpdq(ig,l,igcm_h2o_ice)
	188	& + pdq(ig,l,igcm_h2o_ice)
	189	subpdq(ig,l,igcm_h2o_vap) =
	190	& subpdq(ig,l,igcm_h2o_vap)
	191	& + pdq(ig,l,igcm_h2o_vap)
	192	ENDDO
	193	ENDDO
	194
	195
	196	c-------------------------------------------------------------------
	197	c 2. Main call to the different cloud schemes:
	198	c------------------------------------------------
	199	IF (microphys) THEN
	200	CALL improvedclouds(ngrid,nlay,microtimestep,
	201	& pplay,pt,subpdt,
	202	& pq,subpdq,subpdqcloud,subpdtcloud,
	203	& nq,tauscaling)
	204
	205	ELSE
	206	CALL simpleclouds(ngrid,nlay,microtimestep,
	207	& pplay,pzlay,pt,subpdt,
	208	& pq,subpdq,subpdqcloud,subpdtcloud,
[645]	209	& nq,tau,rice)
[633]	210	ENDIF
	211
	212
	213	c-------------------------------------------------------------------
	214	c 3. Updating tendencies after cloud scheme:
	215	c-----------------------------------------------
	216
	217	IF (microphys) THEN
	218	DO l=1,nlay
	219	DO ig=1,ngrid
	220	subpdq(ig,l,igcm_dust_mass) =
	221	& subpdq(ig,l,igcm_dust_mass)
	222	& + subpdqcloud(ig,l,igcm_dust_mass)
	223	subpdq(ig,l,igcm_dust_number) =
	224	& subpdq(ig,l,igcm_dust_number)
	225	& + subpdqcloud(ig,l,igcm_dust_number)
	226	subpdq(ig,l,igcm_ccn_mass) =
	227	& subpdq(ig,l,igcm_ccn_mass)
	228	& + subpdqcloud(ig,l,igcm_ccn_mass)
	229	subpdq(ig,l,igcm_ccn_number) =
	230	& subpdq(ig,l,igcm_ccn_number)
	231	& + subpdqcloud(ig,l,igcm_ccn_number)
	232	ENDDO
	233	ENDDO
	234	ENDIF
	235	DO l=1,nlay
	236	DO ig=1,ngrid
	237	subpdq(ig,l,igcm_h2o_ice) =
	238	& subpdq(ig,l,igcm_h2o_ice)
	239	& + subpdqcloud(ig,l,igcm_h2o_ice)
	240	subpdq(ig,l,igcm_h2o_vap) =
	241	& subpdq(ig,l,igcm_h2o_vap)
	242	& + subpdqcloud(ig,l,igcm_h2o_vap)
	243	ENDDO
	244	ENDDO
[882]	245
	246	IF (activice) THEN
	247	DO l=1,nlay
	248	DO ig=1,ngrid
	249	subpdt(ig,l) =
	250	& subpdt(ig,l) + subpdtcloud(ig,l)
	251	ENDDO
	252	ENDDO
	253	ENDIF
[633]	254
	255
	256	ENDDO ! of DO microstep=1,imicro
	257
	258	c-------------------------------------------------------------------
	259	c 6. Compute final tendencies after time loop:
	260	c------------------------------------------------
	261
	262	c------ Temperature tendency pdtcloud
	263	DO l=1,nlay
	264	DO ig=1,ngrid
	265	pdtcloud(ig,l) =
	266	& subpdt(ig,l)/real(imicro)-pdt(ig,l)
	267	ENDDO
	268	ENDDO
[740]	269
[633]	270	c------ Tracers tendencies pdqcloud
[703]	271	DO l=1,nlay
[633]	272	DO ig=1,ngrid
[703]	273	pdqcloud(ig,l,igcm_h2o_ice) =
	274	& subpdq(ig,l,igcm_h2o_ice)/real(imicro)
	275	& - pdq(ig,l,igcm_h2o_ice)
	276	pdqcloud(ig,l,igcm_h2o_vap) =
	277	& subpdq(ig,l,igcm_h2o_vap)/real(imicro)
	278	& - pdq(ig,l,igcm_h2o_vap)
[740]	279	ENDDO
	280	ENDDO
	281
	282	IF(microphys) THEN
	283	DO l=1,nlay
	284	DO ig=1,ngrid
[703]	285	pdqcloud(ig,l,igcm_ccn_mass) =
	286	& subpdq(ig,l,igcm_ccn_mass)/real(imicro)
	287	& - pdq(ig,l,igcm_ccn_mass)
	288	pdqcloud(ig,l,igcm_ccn_number) =
	289	& subpdq(ig,l,igcm_ccn_number)/real(imicro)
	290	& - pdq(ig,l,igcm_ccn_number)
[633]	291	ENDDO
[740]	292	ENDDO
	293	ENDIF
	294
	295	IF(scavenging) THEN
	296	DO l=1,nlay
	297	DO ig=1,ngrid
	298	pdqcloud(ig,l,igcm_dust_mass) =
	299	& subpdq(ig,l,igcm_dust_mass)/real(imicro)
	300	& - pdq(ig,l,igcm_dust_mass)
	301	pdqcloud(ig,l,igcm_dust_number) =
	302	& subpdq(ig,l,igcm_dust_number)/real(imicro)
	303	& - pdq(ig,l,igcm_dust_number)
	304	ENDDO
	305	ENDDO
	306	ENDIF
[633]	307
	308	c------- Due to stepped entry, other processes tendencies can add up to negative values
	309	c------- Therefore, enforce positive values and conserve mass
	310
[740]	311
[633]	312	IF(microphys) THEN
	313	DO l=1,nlay
	314	DO ig=1,ngrid
[654]	315	IF ((pq(ig,l,igcm_ccn_number) +
[633]	316	& ptimestep* (pdq(ig,l,igcm_ccn_number) +
[654]	317	& pdqcloud(ig,l,igcm_ccn_number)) .le. 1.)
	318	& .or. (pq(ig,l,igcm_ccn_mass) +
	319	& ptimestep* (pdq(ig,l,igcm_ccn_mass) +
	320	& pdqcloud(ig,l,igcm_ccn_mass)) .le. 1.e-20)) THEN
[633]	321	pdqcloud(ig,l,igcm_ccn_number) =
	322	& - pq(ig,l,igcm_ccn_number)/ptimestep
[654]	323	& - pdq(ig,l,igcm_ccn_number) + 1.
[633]	324	pdqcloud(ig,l,igcm_dust_number) =
	325	& -pdqcloud(ig,l,igcm_ccn_number)
	326	pdqcloud(ig,l,igcm_ccn_mass) =
	327	& - pq(ig,l,igcm_ccn_mass)/ptimestep
[654]	328	& - pdq(ig,l,igcm_ccn_mass) + 1.e-20
[633]	329	pdqcloud(ig,l,igcm_dust_mass) =
	330	& -pdqcloud(ig,l,igcm_ccn_mass)
	331	ENDIF
	332	ENDDO
	333	ENDDO
	334	ENDIF
	335
[740]	336	IF(scavenging) THEN
[633]	337	DO l=1,nlay
	338	DO ig=1,ngrid
[740]	339	IF ((pq(ig,l,igcm_dust_number) +
	340	& ptimestep* (pdq(ig,l,igcm_dust_number) +
	341	& pdqcloud(ig,l,igcm_dust_number)) .le. 1.)
	342	& .or. (pq(ig,l,igcm_dust_mass) +
	343	& ptimestep* (pdq(ig,l,igcm_dust_mass) +
	344	& pdqcloud(ig,l,igcm_dust_mass)) .le. 1.e-20)) THEN
	345	pdqcloud(ig,l,igcm_dust_number) =
	346	& - pq(ig,l,igcm_dust_number)/ptimestep
	347	& - pdq(ig,l,igcm_dust_number) + 1.
	348	pdqcloud(ig,l,igcm_ccn_number) =
	349	& -pdqcloud(ig,l,igcm_dust_number)
	350	pdqcloud(ig,l,igcm_dust_mass) =
	351	& - pq(ig,l,igcm_dust_mass)/ptimestep
	352	& - pdq(ig,l,igcm_dust_mass) + 1.e-20
	353	pdqcloud(ig,l,igcm_ccn_mass) =
	354	& -pdqcloud(ig,l,igcm_dust_mass)
	355	ENDIF
	356	ENDDO
	357	ENDDO
	358	ENDIF
	359
	360	DO l=1,nlay
	361	DO ig=1,ngrid
[633]	362	IF (pq(ig,l,igcm_h2o_ice) + ptimestep*
	363	& (pdq(ig,l,igcm_h2o_ice) + pdqcloud(ig,l,igcm_h2o_ice))
	364	& .le. 1.e-8) THEN
	365	pdqcloud(ig,l,igcm_h2o_ice) =
	366	& - pq(ig,l,igcm_h2o_ice)/ptimestep - pdq(ig,l,igcm_h2o_ice)
	367	pdqcloud(ig,l,igcm_h2o_vap) = -pdqcloud(ig,l,igcm_h2o_ice)
	368	ENDIF
	369	IF (pq(ig,l,igcm_h2o_vap) + ptimestep*
	370	& (pdq(ig,l,igcm_h2o_vap) + pdqcloud(ig,l,igcm_h2o_vap))
	371	& .le. 1.e-8) THEN
	372	pdqcloud(ig,l,igcm_h2o_vap) =
	373	& - pq(ig,l,igcm_h2o_vap)/ptimestep - pdq(ig,l,igcm_h2o_vap)
	374	pdqcloud(ig,l,igcm_h2o_ice) = -pdqcloud(ig,l,igcm_h2o_vap)
	375	ENDIF
	376	ENDDO
	377	ENDDO
	378
	379
	380	c------Update the ice and dust particle size "rice" for output or photochemistry
	381	c------Only rsedcloud is used for the water cycle
	382
	383	IF(scavenging) THEN
	384	DO l=1, nlay
	385	DO ig=1,ngrid
	386
[740]	387	call updaterdust(
	388	& pq(ig,l,igcm_dust_mass) + ! dust mass
	389	& (pdq(ig,l,igcm_dust_mass) + ! dust mass
	390	& pdqcloud(ig,l,igcm_dust_mass))*ptimestep, ! dust mass
	391	& pq(ig,l,igcm_dust_number) + ! dust number
	392	& (pdq(ig,l,igcm_dust_number) + ! dust number
	393	& pdqcloud(ig,l,igcm_dust_number))*ptimestep, ! dust number
	394	& rdust(ig,l))
[633]	395
	396	ENDDO
	397	ENDDO
[740]	398	ENDIF
[645]	399
[740]	400
	401	IF(microphys) THEN
	402
	403	DO l=1, nlay
	404	DO ig=1,ngrid
	405
	406	call updaterice_micro(
	407	& pq(ig,l,igcm_h2o_ice) + ! ice mass
	408	& (pdq(ig,l,igcm_h2o_ice) + ! ice mass
	409	& pdqcloud(ig,l,igcm_h2o_ice))*ptimestep, ! ice mass
	410	& pq(ig,l,igcm_ccn_mass) + ! ccn mass
	411	& (pdq(ig,l,igcm_ccn_mass) + ! ccn mass
	412	& pdqcloud(ig,l,igcm_ccn_mass))*ptimestep, ! ccn mass
	413	& pq(ig,l,igcm_ccn_number) + ! ccn number
	414	& (pdq(ig,l,igcm_ccn_number) + ! ccn number
	415	& pdqcloud(ig,l,igcm_ccn_number))*ptimestep, ! ccn number
	416	& tauscaling(ig),rice(ig,l),rhocloud(ig,l))
	417
[645]	418	ENDDO
[740]	419	ENDDO
[645]	420
[740]	421	ELSE ! no microphys
	422
[645]	423	DO l=1,nlay
	424	DO ig=1,ngrid
[740]	425
	426	call updaterice_typ(
	427	& pq(ig,l,igcm_h2o_ice) + ! ice mass
	428	& (pdq(ig,l,igcm_h2o_ice) + ! ice mass
	429	& pdqcloud(ig,l,igcm_h2o_ice))*ptimestep, ! ice mass
[746]	430	& tau(ig,1),pzlay(ig,l),rice(ig,l))
[740]	431
[633]	432	ENDDO
[740]	433	ENDDO
[633]	434
[740]	435	ENDIF ! of IF(microphys)
[633]	436
[740]	437
	438
[358]	439	c A correction if a lot of subliming CO2 fills the 1st layer FF04/2005
	440	c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	441	c Then that should not affect the ice particle radius
[1047]	442	do ig=1,ngrid
[358]	443	if(pdpsrf(ig)ptimestep.gt.0.9(pplev(ig,1)-pplev(ig,2)))then
	444	if(pdpsrf(ig)ptimestep.gt.0.9(pplev(ig,1)-pplev(ig,3)))
	445	& rice(ig,2)=rice(ig,3)
	446	rice(ig,1)=rice(ig,2)
	447	end if
	448	end do
[740]	449
	450
	451	DO l=1,nlay
	452	DO ig=1,ngrid
	453	rsedcloud(ig,l)=max(rice(ig,l)*
	454	& (1.+nuice_sed)(1.+nuice_sed)(1.+nuice_sed),
	455	& rdust(ig,l))
	456	! rsedcloud(ig,l)=min(rsedcloud(ig,l),1.e-4)
	457	ENDDO
	458	ENDDO
	459
	460	! used for rad. transfer calculations
	461	! nuice is constant because a lognormal distribution is prescribed
	462	nuice(1:ngrid,1:nlay)=nuice_ref
[38]	463
[740]	464
	465
[633]	466	c=======================================================================
	467
[38]	468	END
	469

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

Download in other formats:

Original Format