Context Navigation

cv3p1_closure.F90 @ 2160

Last change on this file since 2160 was 1999, checked in by Laurent Fairhead, 11 years ago
Merged trunk changes r1920:1997 into testing branch
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: 17.2 KB

Rev	Line
[1992]	1
[1403]	2	! $Id: cv3p1_closure.F90 1999 2014-03-20 09:57:19Z fairhead $
[879]	3
[1992]	4	SUBROUTINE cv3p1_closure(nloc, ncum, nd, icb, inb, pbase, plcl, p, ph, tv, &
	5	tvp, buoy, supmax, ok_inhib, ale, alp, sig, w0, ptop2, cape, cin, m, &
	6	iflag, coef, plim1, plim2, asupmax, supmax0, asupmaxmin, cbmf, plfc, &
	7	wbeff)
[879]	8
	9
[1992]	10	! **************************************************************
	11	! *
	12	! CV3P1_CLOSURE *
	13	! Ale & Alp Closure of Convect3 *
	14	! *
	15	! written by : Kerry Emanuel *
	16	! vectorization: S. Bony *
	17	! modified by : Jean-Yves Grandpeix, 18/06/2003, 19.32.10 *
	18	! Julie Frohwirth, 14/10/2005 17.44.22 *
	19	! **************************************************************
[879]	20
[1992]	21	IMPLICIT NONE
[879]	22
[1992]	23	include "cvthermo.h"
	24	include "cv3param.h"
	25	include "YOMCST2.h"
	26	include "YOMCST.h"
	27	include "conema3.h"
	28	include "iniprint.h"
[1403]	29
[1992]	30	! input:
	31	INTEGER ncum, nd, nloc
	32	INTEGER icb(nloc), inb(nloc)
	33	REAL pbase(nloc), plcl(nloc)
	34	REAL p(nloc, nd), ph(nloc, nd+1)
	35	REAL tv(nloc, nd), tvp(nloc, nd), buoy(nloc, nd)
	36	REAL supmax(nloc, nd)
	37	LOGICAL ok_inhib ! enable convection inhibition by dryness
	38	REAL ale(nloc), alp(nloc)
[879]	39
[1992]	40	! input/output:
	41	REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc)
[879]	42
[1992]	43	! output:
	44	REAL cape(nloc), cin(nloc)
	45	REAL m(nloc, nd)
	46	REAL plim1(nloc), plim2(nloc)
	47	REAL asupmax(nloc, nd), supmax0(nloc)
	48	REAL asupmaxmin(nloc)
	49	REAL cbmf(nloc), plfc(nloc)
	50	REAL wbeff(nloc)
	51	INTEGER iflag(nloc)
[879]	52
[1992]	53	! local variables:
	54	INTEGER il, i, j, k, icbmax, i0(nloc)
	55	REAL deltap, fac, w, amu
	56	REAL rhodp
	57	REAL pbmxup
	58	REAL dtmin(nloc, nd), sigold(nloc, nd)
	59	REAL coefmix(nloc, nd)
	60	REAL pzero(nloc), ptop2old(nloc)
	61	REAL cina(nloc), cinb(nloc)
	62	INTEGER ibeg(nloc)
	63	INTEGER nsupmax(nloc)
	64	REAL supcrit, temp(nloc, nd)
	65	REAL p1(nloc), pmin(nloc)
	66	REAL asupmax0(nloc)
	67	LOGICAL ok(nloc)
	68	REAL siglim(nloc, nd), wlim(nloc, nd), mlim(nloc, nd)
	69	REAL wb2(nloc)
	70	REAL cbmflim(nloc), cbmf1(nloc), cbmfmax(nloc)
	71	REAL cbmflast(nloc)
	72	REAL coef(nloc)
	73	REAL xp(nloc), xq(nloc), xr(nloc), discr(nloc), b3(nloc), b4(nloc)
	74	REAL theta(nloc), bb(nloc)
	75	REAL term1, term2, term3
	76	REAL alp2(nloc) ! Alp with offset
[879]	77
[1992]	78	REAL sigmax
	79	PARAMETER (sigmax=0.1)
[879]	80
[1992]	81	CHARACTER (LEN=20) :: modname = 'cv3p1_closure'
	82	CHARACTER (LEN=80) :: abort_message
[879]	83
[1992]	84	! print *,' -> cv3p1_closure, Ale ',ale(1)
[879]	85
	86
[1992]	87	! -------------------------------------------------------
	88	! -- Initialization
	89	! -------------------------------------------------------
[879]	90
	91
	92
[1992]	93	DO il = 1, ncum
	94	alp2(il) = max(alp(il), 1.E-5)
	95	! IM
	96	alp2(il) = max(alp(il), 1.E-12)
	97	END DO
[879]	98
[1992]	99	pbmxup = 50. ! PBMXUP+PBCRIT = cloud depth above which mixed updraughts
	100	! exist (if any)
[879]	101
[1992]	102	IF (prt_level>=20) PRINT *, 'cv3p1_param nloc ncum nd icb inb nl', nloc, &
	103	ncum, nd, icb(nloc), inb(nloc), nl
	104	DO k = 1, nl
	105	DO il = 1, ncum
	106	m(il, k) = 0.0
	107	END DO
	108	END DO
[879]	109
[1992]	110	! -------------------------------------------------------
	111	! -- Reset sig(i) and w0(i) for i>inb and i<icb
	112	! -------------------------------------------------------
[879]	113
[1992]	114	! update sig and w0 above LNB:
[879]	115
[1992]	116	DO k = 1, nl - 1
	117	DO il = 1, ncum
	118	IF ((inb(il)<(nl-1)) .AND. (k>=(inb(il)+1))) THEN
	119	sig(il, k) = betasig(il, k) + 2.alphabuoy(il, inb(il))abs(buoy(il &
	120	,inb(il)))
	121	sig(il, k) = amax1(sig(il,k), 0.0)
	122	w0(il, k) = beta*w0(il, k)
	123	END IF
	124	END DO
	125	END DO
[879]	126
[1992]	127	! if(prt.level.GE.20) print*,'cv3p1_param apres 100'
	128	! compute icbmax:
[879]	129
[1992]	130	icbmax = 2
	131	DO il = 1, ncum
	132	icbmax = max(icbmax, icb(il))
	133	END DO
	134	! if(prt.level.GE.20) print*,'cv3p1_param apres 200'
[879]	135
[1992]	136	! update sig and w0 below cloud base:
[973]	137
[1992]	138	DO k = 1, icbmax
	139	DO il = 1, ncum
	140	IF (k<=icb(il)) THEN
	141	sig(il, k) = betasig(il, k) - 2.alphabuoy(il, icb(il))buoy(il, &
	142	icb(il))
	143	sig(il, k) = amax1(sig(il,k), 0.0)
	144	w0(il, k) = beta*w0(il, k)
	145	END IF
	146	END DO
	147	END DO
	148	IF (prt_level>=20) PRINT *, 'cv3p1_param apres 300'
	149	! -------------------------------------------------------------
	150	! -- Reset fractional areas of updrafts and w0 at initial time
	151	! -- and after 10 time steps of no convection
	152	! -------------------------------------------------------------
[879]	153
[1992]	154	DO k = 1, nl - 1
	155	DO il = 1, ncum
	156	IF (sig(il,nd)<1.5 .OR. sig(il,nd)>12.0) THEN
	157	sig(il, k) = 0.0
	158	w0(il, k) = 0.0
	159	END IF
	160	END DO
	161	END DO
	162	IF (prt_level>=20) PRINT *, 'cv3p1_param apres 400'
[879]	163
[1992]	164	! -------------------------------------------------------------
	165	! jyg1
	166	! -- Calculate adiabatic ascent top pressure (ptop)
	167	! -------------------------------------------------------------
[879]	168
	169
[1992]	170	! c 1. Start at first level where precipitations form
	171	DO il = 1, ncum
	172	pzero(il) = plcl(il) - pbcrit
	173	END DO
[879]	174
[1992]	175	! c 2. Add offset
	176	DO il = 1, ncum
	177	pzero(il) = pzero(il) - pbmxup
	178	END DO
	179	DO il = 1, ncum
	180	ptop2old(il) = ptop2(il)
	181	END DO
[879]	182
[1992]	183	DO il = 1, ncum
	184	! CR:c est quoi ce 300??
	185	p1(il) = pzero(il) - 300.
	186	END DO
[879]	187
[1992]	188	! compute asupmax=abs(supmax) up to lnm+1
[879]	189
[1992]	190	DO il = 1, ncum
	191	ok(il) = .TRUE.
	192	nsupmax(il) = inb(il)
	193	END DO
[879]	194
[1992]	195	DO i = 1, nl
	196	DO il = 1, ncum
	197	IF (i>icb(il) .AND. i<=inb(il)) THEN
	198	IF (p(il,i)<=pzero(il) .AND. supmax(il,i)<0 .AND. ok(il)) THEN
	199	nsupmax(il) = i
	200	ok(il) = .FALSE.
	201	END IF ! end IF (P(i) ... )
	202	END IF ! end IF (icb+1 le i le inb)
	203	END DO
	204	END DO
[879]	205
[1992]	206	IF (prt_level>=20) PRINT *, 'cv3p1_param apres 2.'
	207	DO i = 1, nl
	208	DO il = 1, ncum
	209	asupmax(il, i) = abs(supmax(il,i))
	210	END DO
	211	END DO
[879]	212
	213
[1992]	214	DO il = 1, ncum
	215	asupmaxmin(il) = 10.
	216	pmin(il) = 100.
	217	! IM ??
	218	asupmax0(il) = 0.
	219	END DO
[879]	220
[1992]	221	! c 3. Compute in which level is Pzero
[879]	222
[1992]	223	! IM bug i0 = 18
	224	DO il = 1, ncum
	225	i0(il) = nl
	226	END DO
[879]	227
[1992]	228	DO i = 1, nl
	229	DO il = 1, ncum
	230	IF (i>icb(il) .AND. i<=inb(il)) THEN
	231	IF (p(il,i)<=pzero(il) .AND. p(il,i)>=p1(il)) THEN
	232	IF (pzero(il)>p(il,i) .AND. pzero(il)<p(il,i-1)) THEN
	233	i0(il) = i
	234	END IF
	235	END IF
	236	END IF
	237	END DO
	238	END DO
	239	IF (prt_level>=20) PRINT *, 'cv3p1_param apres 3.'
[879]	240
[1992]	241	! c 4. Compute asupmax at Pzero
[879]	242
[1992]	243	DO i = 1, nl
	244	DO il = 1, ncum
	245	IF (i>icb(il) .AND. i<=inb(il)) THEN
	246	IF (p(il,i)<=pzero(il) .AND. p(il,i)>=p1(il)) THEN
	247	asupmax0(il) = ((pzero(il)-p(il,i0(il)-1))*asupmax(il,i0(il))-( &
	248	pzero(il)-p(il,i0(il)))*asupmax(il,i0(il)-1))/(p(il,i0(il))-p(il, &
	249	i0(il)-1))
	250	END IF
	251	END IF
	252	END DO
	253	END DO
[879]	254
	255
[1992]	256	DO i = 1, nl
	257	DO il = 1, ncum
	258	IF (p(il,i)==pzero(il)) THEN
	259	asupmax(i, il) = asupmax0(il)
	260	END IF
	261	END DO
	262	END DO
	263	IF (prt_level>=20) PRINT *, 'cv3p1_param apres 4.'
[879]	264
[1992]	265	! c 5. Compute asupmaxmin, minimum of asupmax
[879]	266
[1992]	267	DO i = 1, nl
	268	DO il = 1, ncum
	269	IF (i>icb(il) .AND. i<=inb(il)) THEN
	270	IF (p(il,i)<=pzero(il) .AND. p(il,i)>=p1(il)) THEN
	271	IF (asupmax(il,i)<asupmaxmin(il)) THEN
	272	asupmaxmin(il) = asupmax(il, i)
	273	pmin(il) = p(il, i)
	274	END IF
	275	END IF
	276	END IF
	277	END DO
	278	END DO
[879]	279
[1992]	280	DO il = 1, ncum
	281	! IM
	282	IF (prt_level>=20) THEN
	283	PRINT *, 'cv3p1_closure il asupmax0 asupmaxmin', il, asupmax0(il), &
	284	asupmaxmin(il), pzero(il), pmin(il)
	285	END IF
	286	IF (asupmax0(il)<asupmaxmin(il)) THEN
	287	asupmaxmin(il) = asupmax0(il)
	288	pmin(il) = pzero(il)
	289	END IF
	290	END DO
	291	IF (prt_level>=20) PRINT *, 'cv3p1_param apres 5.'
[879]	292
	293
[1992]	294	! Compute Supmax at Pzero
[879]	295
[1992]	296	DO i = 1, nl
	297	DO il = 1, ncum
	298	IF (i>icb(il) .AND. i<=inb(il)) THEN
	299	IF (p(il,i)<=pzero(il)) THEN
	300	supmax0(il) = ((p(il,i)-pzero(il))*asupmax(il,i-1)-(p(il, &
	301	i-1)-pzero(il))*asupmax(il,i))/(p(il,i)-p(il,i-1))
	302	GO TO 425
	303	END IF ! end IF (P(i) ... )
	304	END IF ! end IF (icb+1 le i le inb)
	305	END DO
	306	END DO
[879]	307
[1992]	308	425 CONTINUE
	309	IF (prt_level>=20) PRINT *, 'cv3p1_param apres 425.'
[879]	310
[1992]	311	! c 6. Calculate ptop2
[879]	312
[1992]	313	DO il = 1, ncum
	314	IF (asupmaxmin(il)<supcrit1) THEN
	315	ptop2(il) = pmin(il)
	316	END IF
[973]	317
[1992]	318	IF (asupmaxmin(il)>supcrit1 .AND. asupmaxmin(il)<supcrit2) THEN
	319	ptop2(il) = ptop2old(il)
	320	END IF
[879]	321
[1992]	322	IF (asupmaxmin(il)>supcrit2) THEN
	323	ptop2(il) = ph(il, inb(il))
	324	END IF
	325	END DO
[973]	326
[1992]	327	IF (prt_level>=20) PRINT *, 'cv3p1_param apres 6.'
[1574]	328
[1992]	329	! c 7. Compute multiplying factor for adiabatic updraught mass flux
	330
	331
	332	IF (ok_inhib) THEN
	333
	334	DO i = 1, nl
[1574]	335	DO il = 1, ncum
[1992]	336	IF (i<=nl) THEN
	337	coefmix(il, i) = (min(ptop2(il),ph(il,i))-ph(il,i))/(ph(il,i+1)-ph( &
	338	il,i))
	339	coefmix(il, i) = min(coefmix(il,i), 1.)
	340	END IF
[1574]	341	END DO
[1992]	342	END DO
[1574]	343
	344
[1992]	345	ELSE ! when inhibition is not taken into account, coefmix=1
[879]	346
	347
[1992]	348
	349	DO i = 1, nl
	350	DO il = 1, ncum
	351	IF (i<=nl) THEN
	352	coefmix(il, i) = 1.
	353	END IF
	354	END DO
	355	END DO
	356
	357	END IF ! ok_inhib
	358	IF (prt_level>=20) PRINT *, 'cv3p1_param apres 7.'
	359	! -------------------------------------------------------------------
	360	! -------------------------------------------------------------------
	361
	362
	363	! jyg2
	364
	365	! ==========================================================================
	366
	367
	368	! -------------------------------------------------------------
	369	! -- Calculate convective inhibition (CIN)
	370	! -------------------------------------------------------------
	371
	372	! do i=1,nloc
	373	! print*,'avant cine p',pbase(i),plcl(i)
	374	! enddo
	375	! do j=1,nd
	376	! do i=1,nloc
	377	! print*,'avant cine t',tv(i),tvp(i)
	378	! enddo
	379	! enddo
	380	CALL cv3_cine(nloc, ncum, nd, icb, inb, pbase, plcl, p, ph, tv, tvp, cina, &
	381	cinb, plfc)
	382
	383	DO il = 1, ncum
	384	cin(il) = cina(il) + cinb(il)
	385	END DO
	386	IF (prt_level>=20) PRINT *, 'cv3p1_param apres cv3_cine'
	387	! -------------------------------------------------------------
	388	! --Update buoyancies to account for Ale
	389	! -------------------------------------------------------------
	390
	391	CALL cv3_buoy(nloc, ncum, nd, icb, inb, pbase, plcl, p, ph, ale, cin, tv, &
	392	tvp, buoy)
	393	IF (prt_level>=20) PRINT *, 'cv3p1_param apres cv3_buoy'
	394
	395	! -------------------------------------------------------------
	396	! -- Calculate convective available potential energy (cape),
	397	! -- vertical velocity (w), fractional area covered by
	398	! -- undilute updraft (sig), and updraft mass flux (m)
	399	! -------------------------------------------------------------
	400
	401	DO il = 1, ncum
	402	cape(il) = 0.0
	403	END DO
	404
	405	! compute dtmin (minimum buoyancy between ICB and given level k):
	406
	407	DO k = 1, nl
	408	DO il = 1, ncum
	409	dtmin(il, k) = 100.0
	410	END DO
	411	END DO
	412
	413	DO k = 1, nl
	414	DO j = minorig, nl
	415	DO il = 1, ncum
	416	IF ((k>=(icb(il)+1)) .AND. (k<=inb(il)) .AND. (j>=icb(il)) .AND. (j<= &
	417	(k-1))) THEN
	418	dtmin(il, k) = amin1(dtmin(il,k), buoy(il,j))
	419	END IF
	420	END DO
	421	END DO
	422	END DO
	423
	424	! the interval on which cape is computed starts at pbase :
	425
	426	DO k = 1, nl
	427	DO il = 1, ncum
	428
	429	IF ((k>=(icb(il)+1)) .AND. (k<=inb(il))) THEN
	430
	431	deltap = min(pbase(il), ph(il,k-1)) - min(pbase(il), ph(il,k))
	432	cape(il) = cape(il) + rrdbuoy(il, k-1)deltap/p(il, k-1)
	433	cape(il) = amax1(0.0, cape(il))
	434	sigold(il, k) = sig(il, k)
	435
	436
	437	! jyg Coefficient coefmix limits convection to levels where a
	438	! sufficient
	439	! fraction of mixed draughts are ascending.
	440	siglim(il, k) = coefmix(il, k)alpha1dtmin(il, k)*abs(dtmin(il,k))
	441	siglim(il, k) = amax1(siglim(il,k), 0.0)
	442	siglim(il, k) = amin1(siglim(il,k), 0.01)
	443	! c fac=AMIN1(((dtcrit-dtmin(il,k))/dtcrit),1.0)
	444	fac = 1.
	445	wlim(il, k) = fac*sqrt(cape(il))
	446	amu = siglim(il, k)*wlim(il, k)
	447	rhodp = 0.007p(il, k)(ph(il,k)-ph(il,k+1))/tv(il, k)
	448	mlim(il, k) = amu*rhodp
	449	! print*, 'siglim ', k,siglim(1,k)
	450	END IF
	451
	452	END DO
	453	END DO
	454	IF (prt_level>=20) PRINT *, 'cv3p1_param apres 600'
	455
	456	DO il = 1, ncum
	457	! IM beg
	458	IF (prt_level>=20) THEN
	459	PRINT *, 'cv3p1_closure il icb mlim ph ph+1 ph+2', il, icb(il), &
	460	mlim(il, icb(il)+1), ph(il, icb(il)), ph(il, icb(il)+1), &
	461	ph(il, icb(il)+2)
	462	END IF
	463
	464	IF (icb(il)+1<=inb(il)) THEN
	465	! IM end
	466	mlim(il, icb(il)) = 0.5mlim(il, icb(il)+1)(ph(il,icb(il))-ph(il,icb( &
	467	il)+1))/(ph(il,icb(il)+1)-ph(il,icb(il)+2))
	468	! IM beg
	469	END IF !(icb(il.le.inb(il))) then
	470	! IM end
	471	END DO
	472	IF (prt_level>=20) PRINT *, 'cv3p1_param apres 700'
	473
	474	! jyg1
	475	! ------------------------------------------------------------------------
	476	! c Correct mass fluxes so that power used to overcome CIN does not
	477	! c exceed Power Available for Lifting (PAL).
	478	! ------------------------------------------------------------------------
	479
	480	DO il = 1, ncum
	481	cbmflim(il) = 0.
	482	cbmf(il) = 0.
	483	END DO
	484
	485	! c 1. Compute cloud base mass flux of elementary system (Cbmf0=Cbmflim)
	486
	487	DO k = 1, nl
	488	DO il = 1, ncum
	489	! old IF (k .ge. icb(il) .and. k .le. inb(il)) THEN
	490	! IM IF (k .ge. icb(il)+1 .and. k .le. inb(il)) THEN
	491	IF (k>=icb(il) .AND. k<=inb(il) & !cor jyg
	492	.AND. icb(il)+1<=inb(il)) THEN !cor jyg
	493	cbmflim(il) = cbmflim(il) + mlim(il, k)
	494	END IF
	495	END DO
	496	END DO
	497	IF (prt_level>=20) PRINT *, 'cv3p1_param apres cbmflim'
	498
	499	! c 1.5 Compute cloud base mass flux given by Alp closure (Cbmf1), maximum
	500	! c allowed mass flux (Cbmfmax) and final target mass flux (Cbmf)
	501	! c Cbmf is set to zero if Cbmflim (the mass flux of elementary cloud)
	502	! is
	503	! -- exceedingly small.
	504
	505	DO il = 1, ncum
	506	wb2(il) = sqrt(2.*max(ale(il)+cin(il),0.))
	507	END DO
	508
	509	DO il = 1, ncum
	510	IF (plfc(il)<100.) THEN
	511	! This is an irealistic value for plfc => no calculation of wbeff
	512	wbeff(il) = 100.1
	513	ELSE
	514	! Calculate wbeff
	515	IF (flag_wb==0) THEN
	516	wbeff(il) = wbmax
	517	ELSE IF (flag_wb==1) THEN
	518	wbeff(il) = wbmax/(1.+500./(ph(il,1)-plfc(il)))
	519	ELSE IF (flag_wb==2) THEN
	520	wbeff(il) = wbmax(0.01(ph(il,1)-plfc(il)))**2
	521	END IF
	522	END IF
	523	END DO
	524
	525
	526	DO il = 1, ncum
	527	! jyg Modification du coef de wb*wb pour conformite avec papier Wake
	528	! c cbmf1(il) = alp2(il)/(0.5wbwb-Cin(il))
	529	cbmf1(il) = alp2(il)/(2.wbeff(il)wbeff(il)-cin(il))
	530	IF (cbmf1(il)==0 .AND. alp2(il)/=0.) THEN
	531	WRITE (lunout, *) 'cv3p1_closure cbmf1=0 and alp NE 0 il alp2 alp cin ' &
	532	, il, alp2(il), alp(il), cin(il)
	533	abort_message = ''
	534	CALL abort_gcm(modname, abort_message, 1)
	535	END IF
	536	cbmfmax(il) = sigmaxwb2(il)100.p(il, icb(il))/(rrdtv(il,icb(il)))
	537	END DO
	538
	539	DO il = 1, ncum
	540	IF (cbmflim(il)>1.E-6) THEN
	541	! ATTENTION TEST CR
	542	! if (cbmfmax(il).lt.1.e-12) then
	543	cbmf(il) = min(cbmf1(il), cbmfmax(il))
	544	! else
	545	! cbmf(il) = cbmf1(il)
	546	! endif
	547	! print*,'cbmf',cbmf1(il),cbmfmax(il)
	548	END IF
	549	END DO
	550	IF (prt_level>=20) PRINT *, 'cv3p1_param apres cbmflim_testCR'
	551
	552	! c 2. Compute coefficient and apply correction
	553
	554	DO il = 1, ncum
	555	coef(il) = (cbmf(il)+1.E-10)/(cbmflim(il)+1.E-10)
	556	END DO
	557	IF (prt_level>=20) PRINT *, 'cv3p1_param apres coef_plantePLUS'
	558
	559	DO k = 1, nl
	560	DO il = 1, ncum
	561	IF (k>=icb(il)+1 .AND. k<=inb(il)) THEN
	562	amu = betasig(il, k)w0(il, k) + (1.-beta)coef(il)siglim(il, k)* &
	563	wlim(il, k)
	564	w0(il, k) = wlim(il, k)
	565	w0(il, k) = max(w0(il,k), 1.E-10)
	566	sig(il, k) = amu/w0(il, k)
	567	sig(il, k) = min(sig(il,k), 1.)
	568	! c amu = 0.5(SIG(il,k)+sigold(il,k))W0(il,k)
	569	m(il, k) = amu0.007p(il, k)*(ph(il,k)-ph(il,k+1))/tv(il, k)
	570	END IF
	571	END DO
	572	END DO
	573	! jyg2
	574	DO il = 1, ncum
	575	w0(il, icb(il)) = 0.5*w0(il, icb(il)+1)
	576	m(il, icb(il)) = 0.5m(il, icb(il)+1)(ph(il,icb(il))-ph(il,icb(il)+1))/ &
	577	(ph(il,icb(il)+1)-ph(il,icb(il)+2))
	578	sig(il, icb(il)) = sig(il, icb(il)+1)
	579	sig(il, icb(il)-1) = sig(il, icb(il))
	580	END DO
	581	IF (prt_level>=20) PRINT *, 'cv3p1_param apres w0_sig_M'
	582
	583	! c 3. Compute final cloud base mass flux and set iflag to 3 if
	584	! c cloud base mass flux is exceedingly small and is decreasing (i.e. if
	585	! c the final mass flux (cbmflast) is greater than the target mass flux
	586	! c (cbmf)).
	587
	588	DO il = 1, ncum
	589	cbmflast(il) = 0.
	590	END DO
	591
	592	DO k = 1, nl
	593	DO il = 1, ncum
	594	IF (k>=icb(il) .AND. k<=inb(il)) THEN
	595	!IMpropo?? IF ((k.ge.(icb(il)+1)).and.(k.le.inb(il))) THEN
	596	cbmflast(il) = cbmflast(il) + m(il, k)
	597	END IF
	598	END DO
	599	END DO
	600
	601	DO il = 1, ncum
	602	IF (cbmflast(il)<1.E-6 .AND. cbmflast(il)>=cbmf(il)) THEN
	603	iflag(il) = 3
	604	END IF
	605	END DO
	606
	607	DO k = 1, nl
	608	DO il = 1, ncum
	609	IF (iflag(il)>=3) THEN
	610	m(il, k) = 0.
	611	sig(il, k) = 0.
	612	w0(il, k) = 0.
	613	END IF
	614	END DO
	615	END DO
	616	IF (prt_level>=20) PRINT *, 'cv3p1_param apres iflag'
	617
	618	! c 4. Introduce a correcting factor for coef, in order to obtain an
	619	! effective
	620	! c sigdz larger in the present case (using cv3p1_closure) than in the
	621	! old
	622	! c closure (using cv3_closure).
	623	IF (1==0) THEN
	624	DO il = 1, ncum
	625	! c coef(il) = 2.*coef(il)
	626	coef(il) = 5.*coef(il)
	627	END DO
	628	! version CVS du ..2008
	629	ELSE
	630	IF (iflag_cvl_sigd==0) THEN
	631	! test pour verifier qu on fait la meme chose qu avant: sid constant
	632	coef(1:ncum) = 1.
	633	ELSE
	634	coef(1:ncum) = min(2.*coef(1:ncum), 5.)
	635	coef(1:ncum) = max(2.*coef(1:ncum), 0.2)
	636	END IF
	637	END IF
	638
	639	IF (prt_level>=20) PRINT *, 'cv3p1_param FIN'
	640	RETURN
	641	END SUBROUTINE cv3p1_closure
	642
	643

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

Download in other formats:

Original Format