Context Navigation

newmicro.F @ 1989

Last change on this file since 1989 was 1989, checked in by Laurent Fairhead, 11 years ago

Inclusion du code RRTM

Adding RRTM code

MPL

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory
Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 21.6 KB

Rev	Line
[1279]	1	! $Id: newmicro.F 1989 2014-03-03 09:57:40Z fairhead $
[1523]	2
	3
[1279]	4	!
[1712]	5	SUBROUTINE newmicro (ok_cdnc, bl95_b0, bl95_b1,
	6	. paprs, pplay,
[524]	7	. t, pqlwp, pclc, pcltau, pclemi,
	8	. pch, pcl, pcm, pct, pctlwp,
[1712]	9	. xflwp, xfiwp, xflwc, xfiwc,
	10	. mass_solu_aero, mass_solu_aero_pi,
[1989]	11	. pcldtaupi, re, fl,
	12	. reliq, reice, reliq_pi, reice_pi)
[1712]	13	c
[766]	14	USE dimphy
[1337]	15	USE phys_local_var_mod, only: scdnc,cldncl,reffclwtop,lcc,
	16	. reffclws,reffclwc,cldnvi,lcc3d,
	17	. lcc3dcon,lcc3dstra
	18	USE phys_state_var_mod, only: rnebcon,clwcon
[524]	19	IMPLICIT none
	20	c======================================================================
	21	c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930910
[1712]	22	c O. Boucher (LMD/CNRS) mise a jour en 201212
[524]	23	c Objet: Calculer epaisseur optique et emmissivite des nuages
	24	c======================================================================
	25	c Arguments:
[1712]	26	c ok_cdnc-input-L-flag pour calculer les rayons a partir des aerosols
	27	c
[524]	28	c t-------input-R-temperature
[1712]	29	c pqlwp---input-R-eau liquide nuageuse dans l'atmosphere dans la partie nuageuse (kg/kg)
[524]	30	c pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1)
[1279]	31	c mass_solu_aero-----input-R-total mass concentration for all soluble aerosols[ug/m^3]
[1712]	32	c mass_solu_aero_pi--input-R-ditto, pre-industrial value
	33	c
	34	c bl95_b0-input-R-a PARAMETER, may be varied for tests (s-sea, l-land)
	35	c bl95_b1-input-R-a PARAMETER, may be varied for tests ( -"- )
[524]	36	c
	37	c re------output-R-Cloud droplet effective radius multiplied by fl [um]
	38	c fl------output-R-Denominator to re, introduced to avoid problems in
	39	c the averaging of the output. fl is the fraction of liquid
	40	c water clouds within a grid cell
[1712]	41	c
[524]	42	c pcltau--output-R-epaisseur optique des nuages
	43	c pclemi--output-R-emissivite des nuages (0 a 1)
[1712]	44	c pcldtaupi-output-R-pre-industrial value of cloud optical thickness,
	45	c
	46	c pcl-output-R-2D low-level cloud cover
	47	c pcm-output-R-2D mid-level cloud cover
	48	c pch-output-R-2D high-level cloud cover
	49	c pct-output-R-2D total cloud cover
[524]	50	c======================================================================
	51	C
	52	#include "YOMCST.h"
	53	#include "nuage.h"
[685]	54	#include "radepsi.h"
	55	#include "radopt.h"
[1712]	56
[1337]	57	c choix de l'hypothese de recouvrememnt nuageuse
[1712]	58	LOGICAL RANDOM, MAXIMUM_RANDOM, MAXIMUM
	59	PARAMETER (RANDOM=.FALSE., MAXIMUM_RANDOM=.TRUE., MAXIMUM=.FALSE.)
	60	c
[1479]	61	LOGICAL, SAVE :: FIRST=.TRUE.
	62	!$OMP THREADPRIVATE(FIRST)
[1337]	63	INTEGER flag_max
[1712]	64	c
	65	c threshold PARAMETERs
[1337]	66	REAL thres_tau,thres_neb
	67	PARAMETER (thres_tau=0.3, thres_neb=0.001)
	68	c
[1712]	69	REAL phase3d(klon, klev)
	70	REAL tcc(klon), ftmp(klon), lcc_integrat(klon), height(klon)
	71	c
	72	REAL paprs(klon,klev+1)
	73	REAL pplay(klon,klev)
[524]	74	REAL t(klon,klev)
	75	REAL pclc(klon,klev)
	76	REAL pqlwp(klon,klev)
[1712]	77	REAL pcltau(klon,klev)
	78	REAL pclemi(klon,klev)
	79	REAL pcldtaupi(klon, klev)
[524]	80	c
[1712]	81	REAL pct(klon)
	82	REAL pcl(klon)
	83	REAL pcm(klon)
	84	REAL pch(klon)
	85	REAL pctlwp(klon)
[524]	86	c
	87	LOGICAL lo
	88	c
[1523]	89	!!Abderr modif JL mail du 19.01.2011 18:31
	90	! REAL cetahb, cetamb
	91	! PARAMETER (cetahb = 0.45, cetamb = 0.80)
	92	! Remplacer
[1712]	93	! cetahb*paprs(i,1) par prmhc
	94	! cetamb*paprs(i,1) par prlmc
	95	REAL prmhc ! Pressure between medium and high level cloud in Pa
	96	REAL prlmc ! Pressure between low and medium level cloud in Pa
[1523]	97	PARAMETER (prmhc = 440.100., prlmc = 680.100.)
[524]	98	C
	99	INTEGER i, k
	100	REAL xflwp(klon), xfiwp(klon)
	101	REAL xflwc(klon,klev), xfiwc(klon,klev)
	102	c
[1712]	103	REAL radius
	104	c
	105	REAL coef_froi, coef_chau
[524]	106	PARAMETER (coef_chau=0.13, coef_froi=0.09)
[1712]	107	c
[1286]	108	REAL seuil_neb
	109	PARAMETER (seuil_neb=0.001)
[1712]	110	c
[524]	111	INTEGER nexpo ! exponentiel pour glace/eau
	112	PARAMETER (nexpo=6)
[1712]	113	c PARAMETER (nexpo=1)
[524]	114
[1712]	115	REAL rel, tc, rei
	116	REAL k_ice0, k_ice, DF
	117	PARAMETER (k_ice0=0.005) ! units=m2/g
	118	PARAMETER (DF=1.66) ! diffusivity factor
	119	c
[524]	120	cjq for the aerosol indirect effect
	121	cjq introduced by Johannes Quaas (quaas@lmd.jussieu.fr), 27/11/2003
	122	cjq
[1279]	123	REAL mass_solu_aero(klon, klev) ! total mass concentration for all soluble aerosols [ug m-3]
	124	REAL mass_solu_aero_pi(klon, klev) ! - " - (pre-industrial value)
[524]	125	REAL cdnc(klon, klev) ! cloud droplet number concentration [m-3]
	126	REAL re(klon, klev) ! cloud droplet effective radius [um]
	127	REAL cdnc_pi(klon, klev) ! cloud droplet number concentration [m-3] (pi value)
	128	REAL re_pi(klon, klev) ! cloud droplet effective radius [um] (pi value)
	129
	130	REAL fl(klon, klev) ! xliq * rneb (denominator to re; fraction of liquid water clouds within the grid cell)
	131
[1712]	132	LOGICAL ok_cdnc
[524]	133	REAL bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula
	134
	135	cjq-end
[685]	136	cIM cf. CR:parametres supplementaires
	137	REAL zclear(klon)
	138	REAL zcloud(klon)
[1523]	139	REAL zcloudh(klon)
	140	REAL zcloudm(klon)
	141	REAL zcloudl(klon)
[1712]	142	REAL rhodz(klon, klev) !--rho*dz pour la couche
	143	REAL zrho(klon, klev) !--rho pour la couche
	144	REAL dh(klon, klev) !--dz pour la couche
	145	REAL zfice(klon, klev)
[1989]	146	REAL rad_chaud(klon, klev) !--rayon pour les nuages chauds
	147	REAL rad_chaud_pi(klon, klev) !--rayon pour les nuages chauds pre-industriels
[1712]	148	REAL zflwp_var, zfiwp_var
[1525]	149	REAL d_rei_dt
[1146]	150
[1279]	151	! Abderrahmane oct 2009
	152	Real reliq(klon, klev), reice(klon, klev)
[1989]	153	Real reliq_pi(klon, klev), reice_pi(klon, klev)
[1279]	154
[1525]	155	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	156	! FH : 2011/05/24
	157	!
	158	! rei = ( rei_max - rei_min ) * T(°C) / 81.4 + rei_max
	159	! to be used for a temperature in celcius T(°C) < 0
	160	! rei=rei_min for T(°C) < -81.4
	161	!
	162	! Calcul de la pente de la relation entre rayon effective des cristaux
	163	! et la température.
	164	! Pour retrouver les résultats numériques de la version d'origine,
	165	! on impose 0.71 quand on est proche de 0.71
[1712]	166	c
[1525]	167	d_rei_dt=(rei_max-rei_min)/81.4
	168	if (abs(d_rei_dt-0.71)<1.e-4) d_rei_dt=0.71
	169	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[524]	170	c
	171	c Calculer l'epaisseur optique et l'emmissivite des nuages
[1712]	172	c IM inversion des DO
[524]	173	c
[1146]	174	xflwp = 0.d0
	175	xfiwp = 0.d0
	176	xflwc = 0.d0
	177	xfiwc = 0.d0
[1712]	178	c
[1334]	179	reliq=0.
	180	reice=0.
[1989]	181	reliq_pi=0.
	182	reice_pi=0.
[1712]	183	c
[524]	184	DO k = 1, klev
[1712]	185	DO i = 1, klon
	186	c-layer calculation
	187	rhodz(i,k) = (paprs(i,k)-paprs(i,k+1))/RG ! kg/m2
	188	zrho(i,k)=pplay(i,k)/t(i,k)/RD ! kg/m3
	189	dh(i,k)=rhodz(i,k)/zrho(i,k) ! m
	190	c-Fraction of ice in cloud using a linear transition
	191	zfice(i,k) = 1.0 - (t(i,k)-t_glace_min) /
	192	& (t_glace_max-t_glace_min)
	193	zfice(i,k) = MIN(MAX(zfice(i,k),0.0),1.0)
	194	c-IM Total Liquid/Ice water content
	195	xflwc(i,k) = (1.-zfice(i,k))*pqlwp(i,k)
	196	xfiwc(i,k) = zfice(i,k)*pqlwp(i,k)
[1146]	197	ENDDO
	198	ENDDO
[524]	199
[1712]	200	IF (ok_cdnc) THEN
	201	c
	202	c--we compute cloud properties as a function of the aerosol load
	203	c
	204	DO k = 1, klev
[1146]	205	DO i = 1, klon
[1712]	206	c
	207	c Formula "D" of Boucher and Lohmann, Tellus, 1995
	208	c Cloud droplet number concentration (CDNC) is restricted
	209	c to be within [20, 1000 cm^3]
	210	c
	211	c--present-day case
	212	cdnc(i,k) = 10.*(bl95_b0+bl95_b1
[1279]	213	& log(MAX(mass_solu_aero(i,k),1.e-4))/log(10.))*1.e6 !-m-3
[1712]	214	cdnc(i,k)=MIN(1000.e6,MAX(20.e6,cdnc(i,k)))
	215	c
	216	c--pre-industrial case
	217	cdnc_pi(i,k) = 10.*(bl95_b0+bl95_b1
[1305]	218	& log(MAX(mass_solu_aero_pi(i,k),1.e-4))/log(10.))
	219	& *1.e6 !-m-3
[1712]	220	cdnc_pi(i,k)=MIN(1000.e6,MAX(20.e6,cdnc_pi(i,k)))
	221	c
	222	c--present-day case
	223	rad_chaud(i,k) =
	224	& 1.1((pqlwp(i,k)pplay(i,k)/(RD * T(i,k)))
	225	& /(4./3RPI1000.cdnc(i,k)) )*(1./3.)
	226	rad_chaud(i,k) = MAX(rad_chaud(i,k) * 1.e6, 5.)
	227	c
	228	c--pre-industrial case
[1989]	229	rad_chaud_pi(i,k) =
[1712]	230	& 1.1((pqlwp(i,k)pplay(i,k)/(RD * T(i,k)))
	231	& /(4./3.RPI1000.cdnc_pi(i,k)))*(1./3.)
[1989]	232	rad_chaud_pi(i,k) = MAX(rad_chaud_pi(i,k)*1.e6, 5.)
[1712]	233	c
	234	c--pre-industrial case
	235	c--liquid/ice cloud water paths:
	236	IF (pclc(i,k) .LE. seuil_neb) THEN
	237	c
	238	pcldtaupi(i,k) = 0.0
	239	c
	240	ELSE
	241	c
	242	zflwp_var= 1000.(1.-zfice(i,k))pqlwp(i,k)/pclc(i,k)
	243	& *rhodz(i,k)
	244	zfiwp_var= 1000.zfice(i,k)pqlwp(i,k)/pclc(i,k)
	245	& *rhodz(i,k)
	246	tc = t(i,k)-273.15
	247	rei = d_rei_dt*tc + rei_max
	248	if (tc.le.-81.4) rei = rei_min
	249	c
	250	c-- cloud optical thickness :
	251	c [for liquid clouds, traditional formula,
	252	c for ice clouds, Ebert & Curry (1992)]
	253	c
	254	if (zfiwp_var.eq.0. .or. rei.le.0.) rei = 1.
[1989]	255	pcldtaupi(i,k) = 3.0/2.0 * zflwp_var / rad_chaud_pi(i,k)
[1712]	256	& + zfiwp_var * (3.448e-03 + 2.431/rei)
	257	c
	258	ENDIF
	259	c
	260	ENDDO
	261	ENDDO
	262	c
	263	ELSE !--not ok_cdnc
	264	c
	265	c-prescribed cloud droplet radius
	266	c
	267	DO k = 1, MIN(3,klev)
	268	DO i = 1, klon
	269	rad_chaud(i,k) = rad_chau2
[1989]	270	rad_chaud_pi(i,k) = rad_chau2
[1712]	271	ENDDO
	272	ENDDO
	273	DO k = MIN(3,klev)+1, klev
	274	DO i = 1, klon
	275	rad_chaud(i,k) = rad_chau1
[1989]	276	rad_chaud_pi(i,k) = rad_chau1
[1712]	277	ENDDO
	278	ENDDO
[524]	279
[1712]	280	ENDIF !--ok_cdnc
	281	c
	282	c--computation of cloud optical depth and emissivity
	283	c--in the general case
	284	c
	285	DO k = 1, klev
	286	DO i = 1, klon
	287	c
	288	IF (pclc(i,k) .LE. seuil_neb) THEN
	289	c
	290	c effective cloud droplet radius (microns) for liquid water clouds:
	291	c For output diagnostics cloud droplet effective radius [um]
	292	c we multiply here with f * xl (fraction of liquid water
	293	c clouds in the grid cell) to avoid problems in the averaging of the output.
	294	c In the output of IOIPSL, derive the REAL cloud droplet
	295	c effective radius as re/fl
	296	c
	297	fl(i,k) = seuil_neb*(1.-zfice(i,k))
	298	re(i,k) = rad_chaud(i,k)*fl(i,k)
[1723]	299	rel = 0.
	300	rei = 0.
[1712]	301	pclc(i,k) = 0.0
	302	pcltau(i,k) = 0.0
	303	pclemi(i,k) = 0.0
	304	c
	305	ELSE
	306	c
[1146]	307	c -- liquid/ice cloud water paths:
	308
[1712]	309	zflwp_var= 1000.(1.-zfice(i,k))pqlwp(i,k)/pclc(i,k)
	310	& *rhodz(i,k)
	311	zfiwp_var= 1000.zfice(i,k)pqlwp(i,k)/pclc(i,k)
	312	& *rhodz(i,k)
	313	c
	314	c effective cloud droplet radius (microns) for liquid water clouds:
	315	c For output diagnostics cloud droplet effective radius [um]
	316	c we multiply here with f * xl (fraction of liquid water
	317	c clouds in the grid cell) to avoid problems in the averaging of the output.
	318	c In the output of IOIPSL, derive the REAL cloud droplet
	319	c effective radius as re/fl
	320	c
	321	fl(i,k) = pclc(i,k)*(1.-zfice(i,k))
	322	re(i,k) = rad_chaud(i,k)*fl(i,k)
	323	c
	324	rel = rad_chaud(i,k)
	325	c
	326	c for ice clouds: as a function of the ambiant temperature
	327	c [formula used by Iacobellis and Somerville (2000), with an
	328	c asymptotical value of 3.5 microns at T<-81.4 C added to be
	329	c consistent with observations of Heymsfield et al. 1986]:
	330	c 2011/05/24 : rei_min = 3.5 becomes a free PARAMETER as well as rei_max=61.29
	331	c
	332	tc = t(i,k)-273.15
	333	rei = d_rei_dt*tc + rei_max
	334	if (tc.le.-81.4) rei = rei_min
	335	c
	336	c-- cloud optical thickness :
	337	c [for liquid clouds, traditional formula,
	338	c for ice clouds, Ebert & Curry (1992)]
	339	c
[1279]	340	if (zflwp_var.eq.0.) rel = 1.
	341	if (zfiwp_var.eq.0. .or. rei.le.0.) rei = 1.
	342	pcltau(i,k) = 3.0/2.0 * ( zflwp_var/rel )
[1146]	343	& + zfiwp_var * (3.448e-03 + 2.431/rei)
[1712]	344	c
[1146]	345	c -- cloud infrared emissivity:
[1712]	346	c [the broadband infrared absorption coefficient is PARAMETERized
[1146]	347	c as a function of the effective cld droplet radius]
	348	c Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):
[1712]	349	c
[1146]	350	k_ice = k_ice0 + 1.0/rei
[1712]	351	c
[1146]	352	pclemi(i,k) = 1.0
	353	& - EXP( -coef_chauzflwp_var - DFk_ice*zfiwp_var)
[1712]	354	c
	355	ENDIF
	356	c
	357	reice(i,k)=rei
	358	c
	359	xflwp(i) = xflwp(i)+ xflwc(i,k) * rhodz(i,k)
	360	xfiwp(i) = xfiwp(i)+ xfiwc(i,k) * rhodz(i,k)
	361	c
	362	ENDDO
	363	ENDDO
	364	c
	365	c--if cloud droplet radius is fixed, then pcldtaupi=pcltau
	366	c
	367	IF (.NOT.ok_cdnc) THEN
[1146]	368	DO k = 1, klev
	369	DO i = 1, klon
[1712]	370	pcldtaupi(i,k)=pcltau(i,k)
[1989]	371	reice_pi(i,k)=reice(i,k)
[1146]	372	ENDDO
	373	ENDDO
	374	ENDIF
[1989]	375	c
	376	DO k = 1, klev
	377	DO i = 1, klon
	378	reliq(i,k) =rad_chaud(i,k)
	379	reliq_pi(i,k)=rad_chaud_pi(i,k)
	380	reice_pi(i,k)=reice(i,k)
	381	ENDDO
	382	ENDDO
[1146]	383	C
	384	C COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
	385	c IM cf. CR:test: calcul prenant ou non en compte le recouvrement
	386	c initialisations
[1712]	387	c
[685]	388	DO i=1,klon
	389	zclear(i)=1.
	390	zcloud(i)=0.
[1523]	391	zcloudh(i)=0.
	392	zcloudm(i)=0.
	393	zcloudl(i)=0.
[524]	394	pch(i)=1.0
	395	pcm(i) = 1.0
	396	pcl(i) = 1.0
	397	pctlwp(i) = 0.0
	398	ENDDO
	399	C
[1712]	400	c--calculation of liquid water path
	401	c
[524]	402	DO k = klev, 1, -1
[1146]	403	DO i = 1, klon
[1712]	404	pctlwp(i) = pctlwp(i)+ pqlwp(i,k)*rhodz(i,k)
[1146]	405	ENDDO
	406	ENDDO
[1712]	407	c
	408	c--calculation of cloud properties with cloud overlap
	409	c
[1146]	410	IF (NOVLP.EQ.1) THEN
	411	DO k = klev, 1, -1
	412	DO i = 1, klon
[685]	413	zclear(i)=zclear(i)*(1.-MAX(pclc(i,k),zcloud(i)))
[1712]	414	& /(1.-MIN(REAL(zcloud(i), kind=8),1.-ZEPSEC))
[685]	415	pct(i)=1.-zclear(i)
[1523]	416	IF (paprs(i,k).LT.prmhc) THEN
	417	pch(i) = pch(i)*(1.-MAX(pclc(i,k),zcloudh(i)))
[1712]	418	& /(1.-MIN(REAL(zcloudh(i), kind=8),1.-ZEPSEC))
[1523]	419	zcloudh(i)=pclc(i,k)
	420	ELSE IF (paprs(i,k).GE.prmhc .AND.
	421	& paprs(i,k).LT.prlmc) THEN
	422	pcm(i) = pcm(i)*(1.-MAX(pclc(i,k),zcloudm(i)))
[1712]	423	& /(1.-MIN(REAL(zcloudm(i), kind=8),1.-ZEPSEC))
[1523]	424	zcloudm(i)=pclc(i,k)
	425	ELSE IF (paprs(i,k).GE.prlmc) THEN
	426	pcl(i) = pcl(i)*(1.-MAX(pclc(i,k),zcloudl(i)))
[1712]	427	& /(1.-MIN(REAL(zcloudl(i), kind=8),1.-ZEPSEC))
[1523]	428	zcloudl(i)=pclc(i,k)
[685]	429	endif
	430	zcloud(i)=pclc(i,k)
[1146]	431	ENDDO
	432	ENDDO
	433	ELSE IF (NOVLP.EQ.2) THEN
	434	DO k = klev, 1, -1
	435	DO i = 1, klon
[685]	436	zcloud(i)=MAX(pclc(i,k),zcloud(i))
	437	pct(i)=zcloud(i)
[1523]	438	IF (paprs(i,k).LT.prmhc) THEN
[685]	439	pch(i) = MIN(pclc(i,k),pch(i))
[1523]	440	ELSE IF (paprs(i,k).GE.prmhc .AND.
	441	& paprs(i,k).LT.prlmc) THEN
[685]	442	pcm(i) = MIN(pclc(i,k),pcm(i))
[1523]	443	ELSE IF (paprs(i,k).GE.prlmc) THEN
[685]	444	pcl(i) = MIN(pclc(i,k),pcl(i))
	445	endif
[1146]	446	ENDDO
	447	ENDDO
	448	ELSE IF (NOVLP.EQ.3) THEN
	449	DO k = klev, 1, -1
	450	DO i = 1, klon
[685]	451	zclear(i)=zclear(i)*(1.-pclc(i,k))
	452	pct(i)=1-zclear(i)
[1523]	453	IF (paprs(i,k).LT.prmhc) THEN
[1146]	454	pch(i) = pch(i)*(1.0-pclc(i,k))
[1523]	455	ELSE IF (paprs(i,k).GE.prmhc .AND.
	456	& paprs(i,k).LT.prlmc) THEN
[1146]	457	pcm(i) = pcm(i)*(1.0-pclc(i,k))
[1523]	458	ELSE IF (paprs(i,k).GE.prlmc) THEN
[1146]	459	pcl(i) = pcl(i)*(1.0-pclc(i,k))
[685]	460	endif
[1146]	461	ENDDO
[685]	462	ENDDO
[1146]	463	ENDIF
	464	C
[524]	465	DO i = 1, klon
	466	pch(i)=1.-pch(i)
	467	pcm(i)=1.-pcm(i)
	468	pcl(i)=1.-pcl(i)
	469	ENDDO
[1712]	470	c
[1337]	471	c ========================================================
[1712]	472	c DIAGNOSTICS CALCULATION FOR CMIP5 PROTOCOL
[1337]	473	c ========================================================
[1712]	474	c change by Nicolas Yan (LSCE)
	475	c Cloud Droplet Number Concentration (CDNC) : 3D variable
	476	c Fractionnal cover by liquid water cloud (LCC3D) : 3D variable
	477	c Cloud Droplet Number Concentration at top of cloud (CLDNCL) : 2D variable
	478	c Droplet effective radius at top of cloud (REFFCLWTOP) : 2D variable
	479	c Fractionnal cover by liquid water at top of clouds (LCC) : 2D variable
	480	c
	481	IF (ok_cdnc) THEN
	482	c
[1337]	483	DO k = 1, klev
	484	DO i = 1, klon
[1712]	485	phase3d(i,k)=1-zfice(i,k)
[1337]	486	IF (pclc(i,k) .LE. seuil_neb) THEN
	487	lcc3d(i,k)=seuil_neb*phase3d(i,k)
	488	ELSE
	489	lcc3d(i,k)=pclc(i,k)*phase3d(i,k)
	490	ENDIF
	491	scdnc(i,k)=lcc3d(i,k)*cdnc(i,k) ! m-3
	492	ENDDO
	493	ENDDO
[1712]	494	c
[1337]	495	DO i=1,klon
	496	lcc(i)=0.
	497	reffclwtop(i)=0.
	498	cldncl(i)=0.
	499	IF(RANDOM .OR. MAXIMUM_RANDOM) tcc(i) = 1.
	500	IF(MAXIMUM) tcc(i) = 0.
	501	ENDDO
[1712]	502	c
[1337]	503	DO i=1,klon
	504	DO k=klev-1,1,-1 !From TOA down
[1712]	505	c
[1337]	506	! Test, if the cloud optical depth exceeds the necessary
	507	! threshold:
	508
[1712]	509	IF (pcltau(i,k).GT.thres_tau
	510	. .AND. pclc(i,k).GT.thres_neb) THEN
[1337]	511
[1712]	512	IF (MAXIMUM) THEN
	513	IF (FIRST) THEN
[1337]	514	write(,)'Hypothese de recouvrement: MAXIMUM'
	515	FIRST=.FALSE.
	516	ENDIF
	517	flag_max= -1.
	518	ftmp(i) = MAX(tcc(i),pclc(i,k))
	519	ENDIF
	520
[1712]	521	IF (RANDOM) THEN
	522	IF (FIRST) THEN
[1337]	523	write(,)'Hypothese de recouvrement: RANDOM'
	524	FIRST=.FALSE.
	525	ENDIF
	526	flag_max= 1.
	527	ftmp(i) = tcc(i) * (1-pclc(i,k))
	528	ENDIF
	529
[1712]	530	IF (MAXIMUM_RANDOM) THEN
	531	IF (FIRST) THEN
[1337]	532	write(,)'Hypothese de recouvrement: MAXIMUM_
	533	. RANDOM'
	534	FIRST=.FALSE.
	535	ENDIF
	536	flag_max= 1.
	537	ftmp(i) = tcc(i) *
	538	. (1. - MAX(pclc(i,k),pclc(i,k+1))) /
	539	. (1. - MIN(pclc(i,k+1),1.-thres_neb))
	540	ENDIF
	541	c Effective radius of cloud droplet at top of cloud (m)
[1712]	542	reffclwtop(i) = reffclwtop(i) + rad_chaud(i,k) *
[1337]	543	. 1.0E-06 * phase3d(i,k) * ( tcc(i) - ftmp(i))*flag_max
	544	c CDNC at top of cloud (m-3)
	545	cldncl(i) = cldncl(i) + cdnc(i,k) * phase3d(i,k) *
	546	. (tcc(i) - ftmp(i))*flag_max
	547	c Liquid Cloud Content at top of cloud
	548	lcc(i) = lcc(i) + phase3d(i,k) * (tcc(i)-ftmp(i))*
	549	. flag_max
	550	c Total Cloud Content at top of cloud
	551	tcc(i)=ftmp(i)
	552
	553	ENDIF ! is there a visible, not-too-small cloud?
	554	ENDDO ! loop over k
[1712]	555	c
	556	IF (RANDOM .OR. MAXIMUM_RANDOM) tcc(i)=1.-tcc(i)
	557	c
[1337]	558	ENDDO ! loop over i
	559
	560	!! Convective and Stratiform Cloud Droplet Effective Radius (REFFCLWC REFFCLWS)
	561	DO i = 1, klon
	562	DO k = 1, klev
[1712]	563	! Weight to be used for outputs: eau_liquide*couverture nuageuse
	564	lcc3dcon(i,k) =rnebcon(i,k)phase3d(i,k)clwcon(i,k) ! eau liquide convective
	565	lcc3dstra(i,k)=pclc(i,k)pqlwp(i,k)phase3d(i,k)
	566	lcc3dstra(i,k)=lcc3dstra(i,k)-lcc3dcon(i,k) ! eau liquide stratiforme
	567	lcc3dstra(i,k)=MAX(lcc3dstra(i,k),0.0)
	568	! Compute cloud droplet radius as above in meter
	569	radius=1.1((pqlwp(i,k)pplay(i,k)/(RD * T(i,k)))
	570	& /(4./3RPI1000.cdnc(i,k)) )*(1./3.)
	571	radius=MAX(radius, 5.e-6)
[1337]	572	! Convective Cloud Droplet Effective Radius (REFFCLWC) : variable 3D
[1712]	573	reffclwc(i,k)=radius
	574	reffclwc(i,k)=reffclwc(i,k)*lcc3dcon(i,k)
[1337]	575	! Stratiform Cloud Droplet Effective Radius (REFFCLWS) : variable 3D
[1712]	576	reffclws(i,k)=radius
	577	reffclws(i,k)=reffclws(i,k)*lcc3dstra(i,k)
[1337]	578	ENDDO !klev
	579	ENDDO !klon
	580	c
[1712]	581	c Column Integrated Cloud Droplet Number (CLDNVI) : variable 2D
	582	c
[1337]	583	DO i = 1, klon
	584	cldnvi(i)=0.
	585	lcc_integrat(i)=0.
	586	height(i)=0.
	587	DO k = 1, klev
	588	cldnvi(i)=cldnvi(i)+cdnc(i,k)lcc3d(i,k)dh(i,k)
	589	lcc_integrat(i)=lcc_integrat(i)+lcc3d(i,k)*dh(i,k)
	590	height(i)=height(i)+dh(i,k)
	591	ENDDO ! klev
	592	lcc_integrat(i)=lcc_integrat(i)/height(i)
	593	IF (lcc_integrat(i) .LE. 1.0E-03) THEN
	594	cldnvi(i)=cldnvi(i)*lcc(i)/seuil_neb
	595	ELSE
	596	cldnvi(i)=cldnvi(i)*lcc(i)/lcc_integrat(i)
	597	ENDIF
	598	ENDDO ! klon
	599
	600	DO i = 1, klon
	601	DO k = 1, klev
[1712]	602	IF (scdnc(i,k) .LE. 0.0) scdnc(i,k)=0.0
	603	IF (reffclws(i,k) .LE. 0.0) reffclws(i,k)=0.0
	604	IF (reffclwc(i,k) .LE. 0.0) reffclwc(i,k)=0.0
	605	IF (lcc3d(i,k) .LE. 0.0) lcc3d(i,k)=0.0
	606	IF (lcc3dcon(i,k) .LE. 0.0) lcc3dcon(i,k)=0.0
[1337]	607	IF (lcc3dstra(i,k) .LE. 0.0) lcc3dstra(i,k)=0.0
	608	ENDDO
[1712]	609	IF (reffclwtop(i) .LE. 0.0) reffclwtop(i)=0.0
	610	IF (cldncl(i) .LE. 0.0) cldncl(i)=0.0
	611	IF (cldnvi(i) .LE. 0.0) cldnvi(i)=0.0
	612	IF (lcc(i) .LE. 0.0) lcc(i)=0.0
[1337]	613	ENDDO
	614	c
[1712]	615	ENDIF !ok_cdnc
	616	c
[524]	617	RETURN
[1712]	618	c
[524]	619	END

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

Download in other formats:

Original Format