Context Navigation

cv3a_driver.f90 @ 5472

Last change on this file since 5472 was 3765, checked in by adurocher, 4 years ago

Use cvl_comp_threshold to control whether to use compression or not

cvl_comp_threshold now defaults to 0 (never compress)

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: 46.1 KB

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

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

Download in other formats:

Original Format