Context Navigation

cva_driver.F @ 1

Last change on this file since 1 was 1, checked in by emillour, 14 years ago
Import initial LMDZ5
File size: 34.5 KB

Rev	Line
[1]	1	!
	2	! $Id: cva_driver.F 1403 2010-07-01 09:02:53Z fairhead $
	3	!
	4	SUBROUTINE cva_driver(len,nd,ndp1,ntra,nloc,
	5	& iflag_con,iflag_mix,
	6	& iflag_clos,delt,
	7	& t1,q1,qs1,t1_wake,q1_wake,qs1_wake,s1_wake,
	8	& u1,v1,tra1,
	9	& p1,ph1,
	10	& ALE1,ALP1,
	11	& sig1feed1,sig2feed1,wght1,
	12	o iflag1,ft1,fq1,fu1,fv1,ftra1,
	13	& precip1,kbas1,ktop1,cbmf1,
	14	& sig1,w01, !input/output
	15	& ptop21,sigd,
	16	& Ma1,mip1,Vprecip1,upwd1,dnwd1,dnwd01,
	17	& qcondc1,wd1,
	18	& cape1,cin1,tvp1,
	19	& ftd1,fqd1,
	20	& Plim11,Plim21,asupmax1,supmax01,asupmaxmin1
	21	& ,lalim_conv)
	22	***************************************************************
	23	* *
	24	* CV_DRIVER *
	25	* *
	26	* *
	27	* written by : Sandrine Bony-Lena , 17/05/2003, 11.19.41 *
	28	* modified by : *
	29	***************************************************************
	30	***************************************************************
	31	C
	32	USE dimphy
	33	implicit none
	34	C
	35	C.............................START PROLOGUE............................
	36	C
	37	C PARAMETERS:
	38	C Name Type Usage Description
	39	C ---------- ---------- ------- ----------------------------
	40	C
	41	C len Integer Input first (i) dimension
	42	C nd Integer Input vertical (k) dimension
	43	C ndp1 Integer Input nd + 1
	44	C ntra Integer Input number of tracors
	45	C iflag_con Integer Input version of convect (3/4)
	46	C iflag_mix Integer Input version of mixing (0/1/2)
	47	C iflag_clos Integer Input version of closure (0/1)
	48	C delt Real Input time step
	49	C t1 Real Input temperature (sat draught envt)
	50	C q1 Real Input specific hum (sat draught envt)
	51	C qs1 Real Input sat specific hum (sat draught envt)
	52	C t1_wake Real Input temperature (unsat draught envt)
	53	C q1_wake Real Input specific hum(unsat draught envt)
	54	C qs1_wake Real Input sat specific hum(unsat draughts envt)
	55	C s1_wake Real Input fractionnal area covered by wakes
	56	C u1 Real Input u-wind
	57	C v1 Real Input v-wind
	58	C tra1 Real Input tracors
	59	C p1 Real Input full level pressure
	60	C ph1 Real Input half level pressure
	61	C ALE1 Real Input Available lifting Energy
	62	C ALP1 Real Input Available lifting Power
	63	C sig1feed1 Real Input sigma coord at lower bound of feeding layer
	64	C sig2feed1 Real Input sigma coord at upper bound of feeding layer
	65	C wght1 Real Input weight density determining the feeding mixture
	66	C iflag1 Integer Output flag for Emanuel conditions
	67	C ft1 Real Output temp tend
	68	C fq1 Real Output spec hum tend
	69	C fu1 Real Output u-wind tend
	70	C fv1 Real Output v-wind tend
	71	C ftra1 Real Output tracor tend
	72	C precip1 Real Output precipitation
	73	C kbas1 Integer Output cloud base level
	74	C ktop1 Integer Output cloud top level
	75	C cbmf1 Real Output cloud base mass flux
	76	C sig1 Real In/Out section adiabatic updraft
	77	C w01 Real In/Out vertical velocity within adiab updraft
	78	C ptop21 Real In/Out top of entraining zone
	79	C Ma1 Real Output mass flux adiabatic updraft
	80	C mip1 Real Output mass flux shed by the adiabatic updraft
	81	C Vprecip1 Real Output vertical profile of precipitations
	82	C upwd1 Real Output total upward mass flux (adiab+mixed)
	83	C dnwd1 Real Output saturated downward mass flux (mixed)
	84	C dnwd01 Real Output unsaturated downward mass flux
	85	C qcondc1 Real Output in-cld mixing ratio of condensed water
	86	C wd1 Real Output downdraft velocity scale for sfc fluxes
	87	C cape1 Real Output CAPE
	88	C cin1 Real Output CIN
	89	C tvp1 Real Output adiab lifted parcell virt temp
	90	C ftd1 Real Output precip temp tend
	91	C fqt1 Real Output precip spec hum tend
	92	C Plim11 Real Output
	93	C Plim21 Real Output
	94	C asupmax1 Real Output
	95	C supmax01 Real Output
	96	C asupmaxmin1 Real Output
	97	C S. Bony, Mar 2002:
	98	C * Several modules corresponding to different physical processes
	99	C * Several versions of convect may be used:
	100	C - iflag_con=3: version lmd (previously named convect3)
	101	C - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
	102	C + tard: - iflag_con=5: version lmd with ice (previously named convectg)
	103	C S. Bony, Oct 2002:
	104	C * Vectorization of convect3 (ie version lmd)
	105	C
	106	C..............................END PROLOGUE.............................
	107	c
	108	c
	109	#include "dimensions.h"
	110	ccccc#include "dimphy.h"
	111	include 'iniprint.h'
	112
	113	c
	114	c Input
	115	integer len
	116	integer nd
	117	integer ndp1
	118	integer ntra
	119	integer iflag_con
	120	integer iflag_mix
	121	integer iflag_clos
	122	real delt
	123	real t1(len,nd)
	124	real q1(len,nd)
	125	real qs1(len,nd)
	126	real t1_wake(len,nd)
	127	real q1_wake(len,nd)
	128	real qs1_wake(len,nd)
	129	real s1_wake(len)
	130	real u1(len,nd)
	131	real v1(len,nd)
	132	real tra1(len,nd,ntra)
	133	real p1(len,nd)
	134	real ph1(len,ndp1)
	135	real ALE1(len)
	136	real ALP1(len)
	137	real sig1feed1 ! pressure at lower bound of feeding layer
	138	real sig2feed1 ! pressure at upper bound of feeding layer
	139	real wght1(nd) ! weight density determining the feeding mixture
	140	c
	141	c Output
	142	integer iflag1(len)
	143	real ft1(len,nd)
	144	real fq1(len,nd)
	145	real fu1(len,nd)
	146	real fv1(len,nd)
	147	real ftra1(len,nd,ntra)
	148	real precip1(len)
	149	integer kbas1(len)
	150	integer ktop1(len)
	151	real cbmf1(len)
	152	! real cbmflast(len)
	153	real sig1(len,klev) !input/output
	154	real w01(len,klev) !input/output
	155	real ptop21(len)
	156	real Ma1(len,nd)
	157	real mip1(len,nd)
	158	! real Vprecip1(len,nd)
	159	real Vprecip1(len,nd+1)
	160	real upwd1(len,nd)
	161	real dnwd1(len,nd)
	162	real dnwd01(len,nd)
	163	real qcondc1(len,nd) ! cld
	164	real wd1(len) ! gust
	165	real cape1(len)
	166	real cin1(len)
	167	real tvp1(len,nd)
	168	c
	169	real ftd1(len,nd)
	170	real fqd1(len,nd)
	171	real Plim11(len)
	172	real Plim21(len)
	173	real asupmax1(len,nd)
	174	real supmax01(len)
	175	real asupmaxmin1(len)
	176	integer lalim_conv(len)
	177	!-------------------------------------------------------------------
	178	! --- ARGUMENTS
	179	!-------------------------------------------------------------------
	180	! --- On input:
	181	!
	182	! t: Array of absolute temperature (K) of dimension ND, with first
	183	! index corresponding to lowest model level. Note that this array
	184	! will be altered by the subroutine if dry convective adjustment
	185	! occurs and if IPBL is not equal to 0.
	186	!
	187	! q: Array of specific humidity (gm/gm) of dimension ND, with first
	188	! index corresponding to lowest model level. Must be defined
	189	! at same grid levels as T. Note that this array will be altered
	190	! if dry convective adjustment occurs and if IPBL is not equal to 0.
	191	!
	192	! qs: Array of saturation specific humidity of dimension ND, with first
	193	! index corresponding to lowest model level. Must be defined
	194	! at same grid levels as T. Note that this array will be altered
	195	! if dry convective adjustment occurs and if IPBL is not equal to 0.
	196	!
	197	! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
	198	! of dimension ND, with first index corresponding to lowest model level.
	199	!
	200	! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
	201	! of dimension ND, with first index corresponding to lowest model level.
	202	! Must be defined at same grid levels as T.
	203	!
	204	!qs_wake: Array of saturation specific humidity, seen by unsaturated draughts,
	205	! of dimension ND, with first index corresponding to lowest model level.
	206	! Must be defined at same grid levels as T.
	207	!
	208	!s_wake: Array of fractionnal area occupied by the wakes.
	209	!
	210	! u: Array of zonal wind velocity (m/s) of dimension ND, witth first
	211	! index corresponding with the lowest model level. Defined at
	212	! same levels as T. Note that this array will be altered if
	213	! dry convective adjustment occurs and if IPBL is not equal to 0.
	214	!
	215	! v: Same as u but for meridional velocity.
	216	!
	217	! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
	218	! where NTRA is the number of different tracers. If no
	219	! convective tracer transport is needed, define a dummy
	220	! input array of dimension (ND,1). Tracers are defined at
	221	! same vertical levels as T. Note that this array will be altered
	222	! if dry convective adjustment occurs and if IPBL is not equal to 0.
	223	!
	224	! p: Array of pressure (mb) of dimension ND, with first
	225	! index corresponding to lowest model level. Must be defined
	226	! at same grid levels as T.
	227	!
	228	! ph: Array of pressure (mb) of dimension ND+1, with first index
	229	! corresponding to lowest level. These pressures are defined at
	230	! levels intermediate between those of P, T, Q and QS. The first
	231	! value of PH should be greater than (i.e. at a lower level than)
	232	! the first value of the array P.
	233	!
	234	! ALE: Available lifting Energy
	235	!
	236	! ALP: Available lifting Power
	237	!
	238	! nl: The maximum number of levels to which convection can penetrate, plus 1.
	239	! NL MUST be less than or equal to ND-1.
	240	!
	241	! delt: The model time step (sec) between calls to CONVECT
	242	!
	243	!----------------------------------------------------------------------------
	244	! --- On Output:
	245	!
	246	! iflag: An output integer whose value denotes the following:
	247	! VALUE INTERPRETATION
	248	! ----- --------------
	249	! 0 Moist convection occurs.
	250	! 1 Moist convection occurs, but a CFL condition
	251	! on the subsidence warming is violated. This
	252	! does not cause the scheme to terminate.
	253	! 2 Moist convection, but no precip because ep(inb) lt 0.0001
	254	! 3 No moist convection because new cbmf is 0 and old cbmf is 0.
	255	! 4 No moist convection; atmosphere is not
	256	! unstable
	257	! 6 No moist convection because ihmin le minorig.
	258	! 7 No moist convection because unreasonable
	259	! parcel level temperature or specific humidity.
	260	! 8 No moist convection: lifted condensation
	261	! level is above the 200 mb level.
	262	! 9 No moist convection: cloud base is higher
	263	! then the level NL-1.
	264	!
	265	! ft: Array of temperature tendency (K/s) of dimension ND, defined at same
	266	! grid levels as T, Q, QS and P.
	267	!
	268	! fq: Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
	269	! defined at same grid levels as T, Q, QS and P.
	270	!
	271	! fu: Array of forcing of zonal velocity (m/s^2) of dimension ND,
	272	! defined at same grid levels as T.
	273	!
	274	! fv: Same as FU, but for forcing of meridional velocity.
	275	!
	276	! ftra: Array of forcing of tracer content, in tracer mixing ratio per
	277	! second, defined at same levels as T. Dimensioned (ND,NTRA).
	278	!
	279	! precip: Scalar convective precipitation rate (mm/day).
	280	!
	281	! wd: A convective downdraft velocity scale. For use in surface
	282	! flux parameterizations. See convect.ps file for details.
	283	!
	284	! tprime: A convective downdraft temperature perturbation scale (K).
	285	! For use in surface flux parameterizations. See convect.ps
	286	! file for details.
	287	!
	288	! qprime: A convective downdraft specific humidity
	289	! perturbation scale (gm/gm).
	290	! For use in surface flux parameterizations. See convect.ps
	291	! file for details.
	292	!
	293	! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
	294	! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
	295	! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
	296	! by the calling program between calls to CONVECT.
	297	!
	298	! det: Array of detrainment mass flux of dimension ND.
	299	!
	300	! ftd: Array of temperature tendency due to precipitations (K/s) of dimension ND,
	301	! defined at same grid levels as T, Q, QS and P.
	302	!
	303	! fqd: Array of specific humidity tendencies due to precipitations ((gm/gm)/s)
	304	! of dimension ND, defined at same grid levels as T, Q, QS and P.
	305	!
	306	!-------------------------------------------------------------------
	307	c
	308	c Local arrays
	309	c
	310
	311	integer i,k,n,il,j
	312	integer nword1,nword2,nword3,nword4
	313	integer icbmax
	314	integer nk1(klon)
	315	integer icb1(klon)
	316	integer icbs1(klon)
	317
	318	logical ok_inhib ! True => possible inhibition of convection by dryness
	319	logical, save :: debut=.true.
	320	c$OMP THREADPRIVATE(debut)
	321
	322	real plcl1(klon)
	323	real tnk1(klon)
	324	real thnk1(klon)
	325	real qnk1(klon)
	326	real gznk1(klon)
	327	real pnk1(klon)
	328	real qsnk1(klon)
	329	real unk1(klon)
	330	real vnk1(klon)
	331	real cpnk1(klon)
	332	real hnk1(klon)
	333	real pbase1(klon)
	334	real buoybase1(klon)
	335
	336	real lv1(klon,klev) ,lv1_wake(klon,klev)
	337	real cpn1(klon,klev),cpn1_wake(klon,klev)
	338	real tv1(klon,klev) ,tv1_wake(klon,klev)
	339	real gz1(klon,klev) ,gz1_wake(klon,klev)
	340	real hm1(klon,klev) ,hm1_wake(klon,klev)
	341	real h1(klon,klev) ,h1_wake(klon,klev)
	342	real tp1(klon,klev)
	343	real clw1(klon,klev)
	344	real th1(klon,klev) ,th1_wake(klon,klev)
	345	c
	346	real bid(klon,klev) ! dummy array
	347	c
	348	integer ncum
	349	c
	350	integer j1feed(klon)
	351	integer j2feed(klon)
	352	real p1feed1(len) ! pressure at lower bound of feeding layer
	353	real p2feed1(len) ! pressure at upper bound of feeding layer
	354	real wghti1(len,nd) ! weights of the feeding layers
	355	c
	356	c (local) compressed fields:
	357	c
	358	integer nloc
	359	c parameter (nloc=klon) ! pour l'instant
	360
	361	integer idcum(nloc)
	362	integer iflag(nloc),nk(nloc),icb(nloc)
	363	integer nent(nloc,klev)
	364	integer icbs(nloc)
	365	integer inb(nloc), inbis(nloc)
	366
	367	real cbmf(nloc),plcl(nloc)
	368	real t(nloc,klev),q(nloc,klev),qs(nloc,klev)
	369	real t_wake(nloc,klev),q_wake(nloc,klev),qs_wake(nloc,klev)
	370	real s_wake(nloc)
	371	real u(nloc,klev),v(nloc,klev)
	372	real gz(nloc,klev),h(nloc,klev) ,hm(nloc,klev)
	373	real h_wake(nloc,klev),hm_wake(nloc,klev)
	374	real lv(nloc,klev) ,cpn(nloc,klev)
	375	real lv_wake(nloc,klev),cpn_wake(nloc,klev)
	376	real p(nloc,klev),ph(nloc,klev+1),tv(nloc,klev) ,tp(nloc,klev)
	377	real tv_wake(nloc,klev)
	378	real clw(nloc,klev)
	379	real dph(nloc,klev)
	380	real pbase(nloc), buoybase(nloc), th(nloc,klev)
	381	real th_wake(nloc,klev)
	382	real tvp(nloc,klev)
	383	real sig(nloc,klev), w0(nloc,klev), ptop2(nloc)
	384	real hp(nloc,klev), ep(nloc,klev), sigp(nloc,klev)
	385	real frac(nloc), buoy(nloc,klev)
	386	real cape(nloc)
	387	real cin(nloc)
	388	real m(nloc,klev)
	389	real ment(nloc,klev,klev), sij(nloc,klev,klev)
	390	real qent(nloc,klev,klev)
	391	real hent(nloc,klev,klev)
	392	real uent(nloc,klev,klev), vent(nloc,klev,klev)
	393	real ments(nloc,klev,klev), qents(nloc,klev,klev)
	394	real elij(nloc,klev,klev)
	395	real supmax(nloc,klev)
	396	real ale(nloc),alp(nloc),coef_clos(nloc)
	397	real sigd(nloc)
	398	! real mp(nloc,klev), qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
	399	! real wt(nloc,klev), water(nloc,klev), evap(nloc,klev)
	400	! real b(nloc,klev), sigd(nloc)
	401	! save mp,qp,up,vp,wt,water,evap,b
	402	real, save, allocatable :: mp(:,:),qp(:,:),up(:,:),vp(:,:)
	403	real, save, allocatable :: wt(:,:),water(:,:),evap(:,:), b(:,:)
	404	c$OMP THREADPRIVATE(mp,qp,up,vp,wt,water,evap,b)
	405	real ft(nloc,klev), fq(nloc,klev)
	406	real ftd(nloc,klev), fqd(nloc,klev)
	407	real fu(nloc,klev), fv(nloc,klev)
	408	real upwd(nloc,klev), dnwd(nloc,klev), dnwd0(nloc,klev)
	409	real Ma(nloc,klev), mip(nloc,klev), tls(nloc,klev)
	410	real tps(nloc,klev), qprime(nloc), tprime(nloc)
	411	real precip(nloc)
	412	! real Vprecip(nloc,klev)
	413	real Vprecip(nloc,klev+1)
	414	real tra(nloc,klev,ntra), trap(nloc,klev,ntra)
	415	real ftra(nloc,klev,ntra), traent(nloc,klev,klev,ntra)
	416	real qcondc(nloc,klev) ! cld
	417	real wd(nloc) ! gust
	418	real Plim1(nloc),Plim2(nloc)
	419	real asupmax(nloc,klev)
	420	real supmax0(nloc)
	421	real asupmaxmin(nloc)
	422	c
	423	real tnk(nloc),qnk(nloc),gznk(nloc)
	424	real wghti(nloc,nd)
	425	real hnk(nloc),unk(nloc),vnk(nloc)
	426	logical, save :: first=.true.
	427	c$OMP THREADPRIVATE(first)
	428	CHARACTER (LEN=20) :: modname='cva_driver'
	429	CHARACTER (LEN=80) :: abort_message
	430
	431	c
	432	! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,klev)
	433	! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,klev)
	434
	435	!-------------------------------------------------------------------
	436	! --- SET CONSTANTS AND PARAMETERS
	437	!-------------------------------------------------------------------
	438
	439	if (first) then
	440	allocate(mp(nloc,klev), qp(nloc,klev), up(nloc,klev))
	441	allocate(vp(nloc,klev), wt(nloc,klev), water(nloc,klev))
	442	allocate(evap(nloc,klev), b(nloc,klev))
	443	first=.false.
	444	endif
	445	c -- set simulation flags:
	446	c (common cvflag)
	447
	448	CALL cv_flag
	449
	450	c -- set thermodynamical constants:
	451	c (common cvthermo)
	452
	453	CALL cv_thermo(iflag_con)
	454
	455	c -- set convect parameters
	456	c
	457	c includes microphysical parameters and parameters that
	458	c control the rate of approach to quasi-equilibrium)
	459	c (common cvparam)
	460
	461	if (iflag_con.eq.3) then
	462	CALL cv3_param(nd,delt)
	463
	464	endif
	465
	466	if (iflag_con.eq.4) then
	467	CALL cv_param(nd)
	468	endif
	469
	470	!---------------------------------------------------------------------
	471	! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
	472	!---------------------------------------------------------------------
	473	nword1=len
	474	nword2=len*nd
	475	nword3=lenndntra
	476	nword4=lenndnd
	477
	478	! call izilch(iflag1 ,nword1)
	479	! call zilch(iflag1 ,nword1)
	480	do i=1,len
	481	iflag1(i)=0
	482	ktop1(i)=0
	483	kbas1(i)=0
	484	enddo
	485	call zilch(ft1 ,nword2)
	486	call zilch(fq1 ,nword2)
	487	call zilch(fu1 ,nword2)
	488	call zilch(fv1 ,nword2)
	489	call zilch(ftra1 ,nword3)
	490	call zilch(precip1 ,nword1)
	491	! call izilch(kbas1 ,nword1)
	492	! call zilch(kbas1 ,nword1)
	493	! call izilch(ktop1 ,nword1)
	494	! call zilch(ktop1 ,nword1)
	495	call zilch(cbmf1 ,nword1)
	496	call zilch(ptop21 ,nword1)
	497	call zilch(Ma1 ,nword2)
	498	call zilch(mip1 ,nword2)
	499	! call zilch(Vprecip1,nword2)
	500	Vprecip1=0.
	501	call zilch(upwd1 ,nword2)
	502	call zilch(dnwd1 ,nword2)
	503	call zilch(dnwd01 ,nword2)
	504	call zilch(qcondc1 ,nword2)
	505	!test
	506	! call zilch(qcondc ,nword2)
	507	call zilch(wd1 ,nword1)
	508	call zilch(cape1 ,nword1)
	509	call zilch(cin1 ,nword1)
	510	call zilch(tvp1 ,nword2)
	511	call zilch(ftd1 ,nword2)
	512	call zilch(fqd1 ,nword2)
	513	call zilch(Plim11 ,nword1)
	514	call zilch(Plim21 ,nword1)
	515	call zilch(asupmax1,nword2)
	516	call zilch(supmax01,nword1)
	517	call zilch(asupmaxmin1,nword1)
	518	c
	519	DO il = 1,len
	520	cin1(il) = -100000.
	521	cape1(il) = -1.
	522	ENDDO
	523	c
	524	if (iflag_con.eq.3) then
	525	do il=1,len
	526	sig1(il,nd)=sig1(il,nd)+1.
	527	sig1(il,nd)=amin1(sig1(il,nd),12.1)
	528	enddo
	529	endif
	530
	531	!---------------------------------------------------------------------
	532	! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
	533	!---------------------------------------------------------------------
	534	!
	535	do il = 1,nloc
	536	coef_clos(il)=1.
	537	enddo
	538
	539	!--------------------------------------------------------------------
	540	! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
	541	!--------------------------------------------------------------------
	542
	543	if (iflag_con.eq.3) then
	544
	545	if (debut) THEN
	546	print*,'Emanuel version 3 nouvelle'
	547	endif
	548	! print*,'t1, q1 ',t1,q1
	549	CALL cv3_prelim(len,nd,ndp1,t1,q1,p1,ph1 ! nd->na
	550	o ,lv1,cpn1,tv1,gz1,h1,hm1,th1)
	551
	552	c
	553	CALL cv3_prelim(len,nd,ndp1,t1_wake,q1_wake,p1,ph1 ! nd->na
	554	o ,lv1_wake,cpn1_wake,tv1_wake,gz1_wake
	555	o ,h1_wake,bid,th1_wake)
	556
	557	endif
	558	c
	559	if (iflag_con.eq.4) then
	560	print*,'Emanuel version 4 '
	561	CALL cv_prelim(len,nd,ndp1,t1,q1,p1,ph1
	562	o ,lv1,cpn1,tv1,gz1,h1,hm1)
	563	endif
	564
	565	!--------------------------------------------------------------------
	566	! --- CONVECTIVE FEED
	567	!--------------------------------------------------------------------
	568	!
	569	! compute feeding layer potential temperature and mixing ratio :
	570	!
	571	! get bounds of feeding layer
	572	!
	573	c test niveaux couche alimentation KE
	574	if(sig1feed1.eq.sig2feed1) then
	575	write(lunout,*)'impossible de choisir sig1feed=sig2feed'
	576	write(lunout,*)'changer la valeur de sig2feed dans physiq.def'
	577	abort_message = ''
	578	CALL abort_gcm (modname,abort_message,1)
	579	endif
	580	c
	581	do i=1,len
	582	p1feed1(i)=sig1feed1*ph1(i,1)
	583	p2feed1(i)=sig2feed1*ph1(i,1)
	584	ctest maf
	585	c p1feed1(i)=ph1(i,1)
	586	c p2feed1(i)=ph1(i,2)
	587	c p2feed1(i)=ph1(i,3)
	588	ctestCR: on prend la couche alim des thermiques
	589	c p2feed1(i)=ph1(i,lalim_conv(i)+1)
	590	c print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
	591	end do
	592	!
	593	if (iflag_con.eq.3) then
	594	endif
	595	do i=1,len
	596	! print*,'avant cv3_feed plim',p1feed1(i),p2feed1(i)
	597	enddo
	598	if (iflag_con.eq.3) then
	599
	600	c print*, 'IFLAG1 avant cv3_feed'
	601	c print*,'len,nd',len,nd
	602	c write(*,'(64i1)') iflag1(2:klon-1)
	603
	604	CALL cv3_feed(len,nd,t1,q1,u1,v1,p1,ph1,hm1,gz1 ! nd->na
	605	i ,p1feed1,p2feed1,wght1
	606	o ,wghti1,tnk1,thnk1,qnk1,qsnk1,unk1,vnk1
	607	o ,cpnk1,hnk1,nk1,icb1,icbmax,iflag1,gznk1,plcl1)
	608	endif
	609
	610	c print*, 'IFLAG1 apres cv3_feed'
	611	c print*,'len,nd',len,nd
	612	c write(*,'(64i1)') iflag1(2:klon-1)
	613
	614	if (iflag_con.eq.4) then
	615	CALL cv_feed(len,nd,t1,q1,qs1,p1,hm1,gz1
	616	o ,nk1,icb1,icbmax,iflag1,tnk1,qnk1,gznk1,plcl1)
	617	endif
	618	c
	619	! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
	620	c
	621	!--------------------------------------------------------------------
	622	! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
	623	! (up through ICB for convect4, up through ICB+1 for convect3)
	624	! Calculates the lifted parcel virtual temperature at nk, the
	625	! actual temperature, and the adiabatic liquid water content.
	626	!--------------------------------------------------------------------
	627
	628	if (iflag_con.eq.3) then
	629
	630	CALL cv3_undilute1(len,nd,t1,qs1,gz1,plcl1,p1,icb1,tnk1,qnk1 ! nd->na
	631	o ,gznk1,tp1,tvp1,clw1,icbs1)
	632	endif
	633
	634
	635	if (iflag_con.eq.4) then
	636	CALL cv_undilute1(len,nd,t1,q1,qs1,gz1,p1,nk1,icb1,icbmax
	637	: ,tp1,tvp1,clw1)
	638	endif
	639	c
	640	!-------------------------------------------------------------------
	641	! --- TRIGGERING
	642	!-------------------------------------------------------------------
	643	c
	644	! print *,' avant triggering, iflag_con ',iflag_con
	645	c
	646	if (iflag_con.eq.3) then
	647
	648	CALL cv3_trigger(len,nd,icb1,plcl1,p1,th1,tv1,tvp1,thnk1 ! nd->na
	649	o ,pbase1,buoybase1,iflag1,sig1,w01)
	650
	651
	652	c print*, 'IFLAG1 apres cv3_triger'
	653	c print*,'len,nd',len,nd
	654	c write(*,'(64i1)') iflag1(2:klon-1)
	655
	656	c call dump2d(iim,jjm-1,sig1(2)
	657	endif
	658
	659	if (iflag_con.eq.4) then
	660	CALL cv_trigger(len,nd,icb1,cbmf1,tv1,tvp1,iflag1)
	661	endif
	662	c
	663	c
	664	!=====================================================================
	665	! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
	666	!=====================================================================
	667
	668	ncum=0
	669	do 400 i=1,len
	670	if(iflag1(i).eq.0)then
	671	ncum=ncum+1
	672	idcum(ncum)=i
	673	endif
	674	400 continue
	675	c
	676	! print*,'klon, ncum = ',len,ncum
	677	c
	678	IF (ncum.gt.0) THEN
	679
	680	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	681	! --- COMPRESS THE FIELDS
	682	! (-> vectorization over convective gridpoints)
	683	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	684
	685	if (iflag_con.eq.3) then
	686	! print*,'ncum tv1 ',ncum,tv1
	687	! print*,'tvp1 ',tvp1
	688	CALL cv3a_compress( len,nloc,ncum,nd,ntra
	689	: ,iflag1,nk1,icb1,icbs1
	690	: ,plcl1,tnk1,qnk1,gznk1,hnk1,unk1,vnk1
	691	: ,wghti1,pbase1,buoybase1
	692	: ,t1,q1,qs1,t1_wake,q1_wake,qs1_wake,s1_wake
	693	: ,u1,v1,gz1,th1,th1_wake
	694	: ,tra1
	695	: ,h1 ,lv1 ,cpn1 ,p1,ph1,tv1 ,tp1,tvp1,clw1
	696	: ,h1_wake,lv1_wake,cpn1_wake ,tv1_wake
	697	: ,sig1,w01,ptop21
	698	: ,Ale1,Alp1
	699	o ,iflag,nk,icb,icbs
	700	o ,plcl,tnk,qnk,gznk,hnk,unk,vnk
	701	o ,wghti,pbase,buoybase
	702	o ,t,q,qs,t_wake,q_wake,qs_wake,s_wake
	703	o ,u,v,gz,th,th_wake
	704	o ,tra
	705	o ,h ,lv ,cpn ,p,ph,tv ,tp,tvp,clw
	706	o ,h_wake,lv_wake,cpn_wake ,tv_wake
	707	o ,sig,w0,ptop2
	708	o ,Ale,Alp )
	709
	710	! print*,'tv ',tv
	711	! print*,'tvp ',tvp
	712
	713	endif
	714
	715	if (iflag_con.eq.4) then
	716	CALL cv_compress( len,nloc,ncum,nd
	717	: ,iflag1,nk1,icb1
	718	: ,cbmf1,plcl1,tnk1,qnk1,gznk1
	719	: ,t1,q1,qs1,u1,v1,gz1
	720	: ,h1,lv1,cpn1,p1,ph1,tv1,tp1,tvp1,clw1
	721	o ,iflag,nk,icb
	722	o ,cbmf,plcl,tnk,qnk,gznk
	723	o ,t,q,qs,u,v,gz,h,lv,cpn,p,ph,tv,tp,tvp,clw
	724	o ,dph )
	725	endif
	726
	727	!-------------------------------------------------------------------
	728	! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
	729	! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
	730	! --- &
	731	! --- COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
	732	! --- FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
	733	! --- &
	734	! --- FIND THE LEVEL OF NEUTRAL BUOYANCY
	735	!-------------------------------------------------------------------
	736
	737	if (iflag_con.eq.3) then
	738	CALL cv3_undilute2(nloc,ncum,nd,icb,icbs,nk !na->nd
	739	: ,tnk,qnk,gznk,hnk,t,q,qs,gz
	740	: ,p,h,tv,lv,pbase,buoybase,plcl
	741	o ,inb,tp,tvp,clw,hp,ep,sigp,buoy)
	742
	743	endif
	744
	745	if (iflag_con.eq.4) then
	746	CALL cv_undilute2(nloc,ncum,nd,icb,nk
	747	: ,tnk,qnk,gznk,t,q,qs,gz
	748	: ,p,dph,h,tv,lv
	749	o ,inb,inbis,tp,tvp,clw,hp,ep,sigp,frac)
	750	endif
	751	c
	752	!-------------------------------------------------------------------
	753	! --- MIXING(1) (if iflag_mix .ge. 1)
	754	!-------------------------------------------------------------------
	755	IF (iflag_con .eq. 3) THEN
	756	IF (iflag_mix .ge. 1 ) THEN
	757	CALL zilch(supmax,nloc*klev)
	758	CALL cv3p_mixing(nloc,ncum,nd,nd,ntra,icb,nk,inb ! na->nd
	759	: ,ph,t,q,qs,u,v,tra,h,lv,qnk
	760	: ,unk,vnk,hp,tv,tvp,ep,clw,sig
	761	: ,ment,qent,hent,uent,vent,nent
	762	: ,sij,elij,supmax,ments,qents,traent)
	763	! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
	764
	765	ELSE
	766	CALL zilch(supmax,nloc*klev)
	767	ENDIF
	768	ENDIF
	769	!-------------------------------------------------------------------
	770	! --- CLOSURE
	771	!-------------------------------------------------------------------
	772
	773	c
	774	if (iflag_con.eq.3) then
	775	IF (iflag_clos .eq. 0) THEN
	776	CALL cv3_closure(nloc,ncum,nd,icb,inb ! na->nd
	777	: ,pbase,p,ph,tv,buoy
	778	o ,sig,w0,cape,m,iflag)
	779	ENDIF
	780	c
	781	ok_inhib = iflag_mix .EQ. 2
	782	c
	783	IF (iflag_clos .eq. 1) THEN
	784	print *,' pas d appel cv3p_closure'
	785	cc CALL cv3p_closure(nloc,ncum,nd,icb,inb ! na->nd
	786	cc : ,pbase,plcl,p,ph,tv,tvp,buoy
	787	cc : ,supmax
	788	cc o ,sig,w0,ptop2,cape,cin,m)
	789	ENDIF
	790	IF (iflag_clos .eq. 2) THEN
	791	CALL cv3p1_closure(nloc,ncum,nd,icb,inb ! na->nd
	792	: ,pbase,plcl,p,ph,tv,tvp,buoy
	793	: ,supmax,ok_inhib,Ale,Alp
	794	o ,sig,w0,ptop2,cape,cin,m,iflag,coef_clos
	795	: ,Plim1,Plim2,asupmax,supmax0
	796	: ,asupmaxmin,cbmf)
	797	ENDIF
	798	endif ! iflag_con.eq.3
	799
	800	if (iflag_con.eq.4) then
	801	CALL cv_closure(nloc,ncum,nd,nk,icb
	802	: ,tv,tvp,p,ph,dph,plcl,cpn
	803	o ,iflag,cbmf)
	804	endif
	805	c
	806	! print *,'cv_closure-> cape ',cape(1)
	807	c
	808	!-------------------------------------------------------------------
	809	! --- MIXING(2)
	810	!-------------------------------------------------------------------
	811
	812	if (iflag_con.eq.3) then
	813	IF (iflag_mix.eq.0) THEN
	814	CALL cv3_mixing(nloc,ncum,nd,nd,ntra,icb,nk,inb ! na->nd
	815	: ,ph,t,q,qs,u,v,tra,h,lv,qnk
	816	: ,unk,vnk,hp,tv,tvp,ep,clw,m,sig
	817	o ,ment,qent,uent,vent,nent,sij,elij,ments,qents,traent)
	818	CALL zilch(hent,nlocklevklev)
	819	ELSE
	820	CALL cv3_mixscale(nloc,ncum,nd,ment,m)
	821	if (debut) THEN
	822	print *,' cv3_mixscale-> '
	823	endif !(debut) THEN
	824	ENDIF
	825	endif
	826
	827	if (iflag_con.eq.4) then
	828	CALL cv_mixing(nloc,ncum,nd,icb,nk,inb,inbis
	829	: ,ph,t,q,qs,u,v,h,lv,qnk
	830	: ,hp,tv,tvp,ep,clw,cbmf
	831	o ,m,ment,qent,uent,vent,nent,sij,elij)
	832	endif
	833	c
	834	if (debut) THEN
	835	print *,' cv_mixing ->'
	836	endif !(debut) THEN
	837	c do i = 1,klev
	838	c print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,klev)
	839	c enddo
	840	c
	841	!-------------------------------------------------------------------
	842	! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
	843	!-------------------------------------------------------------------
	844	if (iflag_con.eq.3) then
	845	if (debut) THEN
	846	print *,' cva_driver -> cv3_unsat '
	847	endif !(debut) THEN
	848
	849	CALL cv3_unsat(nloc,ncum,nd,nd,ntra,icb,inb,iflag ! na->nd
	850	: ,t_wake,q_wake,qs_wake,gz,u,v,tra,p,ph
	851	: ,th_wake,tv_wake,lv_wake,cpn_wake
	852	: ,ep,sigp,clw
	853	: ,m,ment,elij,delt,plcl,coef_clos
	854	o ,mp,qp,up,vp,trap,wt,water,evap,b,sigd)
	855	endif
	856
	857	if (iflag_con.eq.4) then
	858	CALL cv_unsat(nloc,ncum,nd,inb,t,q,qs,gz,u,v,p,ph
	859	: ,h,lv,ep,sigp,clw,m,ment,elij
	860	o ,iflag,mp,qp,up,vp,wt,water,evap)
	861	endif
	862	c
	863	if (debut) THEN
	864	print *,'cv_unsat-> '
	865	debut=.FALSE.
	866	endif !(debut) THEN
	867	!
	868	c print *,'cv_unsat-> mp ',mp
	869	c print *,'cv_unsat-> water ',water
	870	!-------------------------------------------------------------------
	871	! --- YIELD
	872	! (tendencies, precipitation, variables of interface with other
	873	! processes, etc)
	874	!-------------------------------------------------------------------
	875
	876	if (iflag_con.eq.3) then
	877
	878	CALL cv3_yield(nloc,ncum,nd,nd,ntra ! na->nd
	879	: ,icb,inb,delt
	880	: ,t,q,t_wake,q_wake,s_wake,u,v,tra
	881	: ,gz,p,ph,h,hp,lv,cpn,th,th_wake
	882	: ,ep,clw,m,tp,mp,qp,up,vp,trap
	883	: ,wt,water,evap,b,sigd
	884	: ,ment,qent,hent,iflag_mix,uent,vent
	885	: ,nent,elij,traent,sig
	886	: ,tv,tvp,wghti
	887	: ,iflag,precip,Vprecip,ft,fq,fu,fv,ftra
	888	: ,cbmf,upwd,dnwd,dnwd0,ma,mip
	889	: ,tls,tps,qcondc,wd
	890	: ,ftd,fqd)
	891	! print *,' cv3_yield -> fqd(1) = ',fqd(1,1)
	892	endif
	893
	894	if (iflag_con.eq.4) then
	895	CALL cv_yield(nloc,ncum,nd,nk,icb,inb,delt
	896	: ,t,q,t_wake,q_wake,u,v,tra
	897	: ,gz,p,ph,h,hp,lv,cpn,th
	898	: ,ep,clw,frac,m,mp,qp,up,vp
	899	: ,wt,water,evap
	900	: ,ment,qent,uent,vent,nent,elij
	901	: ,tv,tvp
	902	o ,iflag,wd,qprime,tprime
	903	o ,precip,cbmf,ft,fq,fu,fv,Ma,qcondc)
	904	endif
	905
	906	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	907	! --- UNCOMPRESS THE FIELDS
	908	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	909
	910
	911	if (iflag_con.eq.3) then
	912	CALL cv3a_uncompress(nloc,len,ncum,nd,ntra,idcum
	913	: ,iflag,icb,inb
	914	: ,precip,cbmf,sig,w0,ptop2
	915	: ,ft,fq,fu,fv,ftra
	916	: ,Ma,mip,Vprecip,upwd,dnwd,dnwd0
	917	; ,qcondc,wd,cape,cin
	918	: ,tvp
	919	: ,ftd,fqd
	920	: ,Plim1,Plim2,asupmax,supmax0
	921	: ,asupmaxmin
	922	o ,iflag1,kbas1,ktop1
	923	o ,precip1,cbmf1,sig1,w01,ptop21
	924	o ,ft1,fq1,fu1,fv1,ftra1
	925	o ,Ma1,mip1,Vprecip1,upwd1,dnwd1,dnwd01
	926	o ,qcondc1,wd1,cape1,cin1
	927	o ,tvp1
	928	o ,ftd1,fqd1
	929	o ,Plim11,Plim21,asupmax1,supmax01
	930	o ,asupmaxmin1)
	931	endif
	932
	933	if (iflag_con.eq.4) then
	934	CALL cv_uncompress(nloc,len,ncum,nd,idcum
	935	: ,iflag
	936	: ,precip,cbmf
	937	: ,ft,fq,fu,fv
	938	: ,Ma,qcondc
	939	o ,iflag1
	940	o ,precip1,cbmf1
	941	o ,ft1,fq1,fu1,fv1
	942	o ,Ma1,qcondc1 )
	943	endif
	944
	945	ENDIF ! ncum>0
	946
	947	9999 continue
	948	return
	949	end
	950

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

Download in other formats:

Original Format