Context Navigation

concvl.F90 @ 5449

Last change on this file since 5449 was 5304, checked in by abarral, 8 weeks ago
Turn YOMCST2.h.h into module
Property svn:keywords set to `Id`
File size: 28.6 KB

Rev	Line
[3927]	1	SUBROUTINE concvl(iflag_clos, &
	2	dtime, paprs, pplay, k_upper_cv, &
	3	t, q, t_wake, q_wake, s_wake, u, v, tra, ntra, &
	4	Ale, Alp, sig1, w01, &
[4613]	5	d_t, d_q, d_qcomp, d_u, d_v, d_tra, &
[3927]	6	rain, snow, kbas, ktop, sigd, &
	7	cbmf, plcl, plfc, wbeff, convoccur, &
	8	upwd, dnwd, dnwdbis, &
	9	Ma, mip, Vprecip, &
	10	cape, cin, tvp, Tconv, iflag, &
	11	pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, &
	12	qcondc, wd, pmflxr, pmflxs, &
	13	!RomP >>>
	14	!! . da,phi,mp,dd_t,dd_q,lalim_conv,wght_th)
	15	da, phi, mp, phii, d1a, dam, sij, qta, clw, elij, &! RomP
	16	dd_t, dd_q, lalim_conv, wght_th, & ! RomP
	17	evap, ep, epmlmMm, eplaMm, & ! RomP
[4613]	18	wdtrainA, wdtrainS, wdtrainM, wght, qtc, sigt, detrain, &
[3927]	19	tau_cld_cv, coefw_cld_cv, & ! RomP+RL, AJ
	20	!RomP <<<
	21	epmax_diag & ! epmax_cape
	22	#ifdef ISO
	23	& ,xt,xt_wake,d_xt,xtrain,xtsnow &
	24	& ,xtVprecip,xtVprecipi &
	25	& ,xtclw,dd_xt,xtevap,xtwdtrainA &
	26	#ifdef DIAGISO
	27	& , qlp,xtlp,qvp,xtvp & ! juste diagnostique
	28	& , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
	29	& , fxt_detrainement,fxt_ddft,fxt_fluxmasse,fxt_evapprecip &
	30	& , f_detrainement,q_detrainement,xt_detrainement &
	31	#endif
	32	#endif
	33	& ) ! **************************************************************
	34	! *
	35	! CONCVL *
	36	! *
	37	! *
	38	! written by : Sandrine Bony-Lena, 17/05/2003, 11.16.04 *
	39	! modified by : *
	40	! **************************************************************
	41
	42
	43	USE dimphy
	44	USE infotrac_phy, ONLY: nbtr
	45	#ifdef ISO
[4143]	46	USE infotrac_phy, ONLY: ntraciso=>ntiso
[3927]	47	USE isotopes_mod, ONLY: iso_eau, bidouille_anti_divergence, ridicule, &
	48	iso_eau,iso_HDO
	49	#endif
	50	#ifdef ISOVERIF
	51	USE isotopes_verif_mod, ONLY: errmax,errmaxrel, &
	52	iso_verif_egalite_choix,iso_verif_aberrant,iso_verif_egalite, &
	53	iso_verif_noNaN,iso_verif_aberrant_encadre
	54	#endif
	55	#ifdef ISOTRAC
	56	USE isotrac_routines_mod, only: iso_verif_traceur_jbid_vect
	57	#ifdef ISOVERIF
	58	USE isotopes_verif_mod, ONLY: iso_verif_traceur_vect, &
	59	& iso_verif_trac_masse_vect, iso_verif_traceur, &
	60	& iso_verif_traceur_justmass
	61	#endif
	62	#endif
[5282]	63	USE clesphys_mod_h
[3927]	64	USE phys_local_var_mod, ONLY: omega
	65	USE print_control_mod, ONLY: prt_level, lunout
[5285]	66	USE yomcst_mod_h
[5283]	67	USE conema3_mod_h
[5284]	68	USE yoethf_mod_h
[5304]	69	USE yomcst2_mod_h
[3927]	70	IMPLICIT NONE
	71	! ======================================================================
	72	! Auteur(s): S. Bony-Lena (LMD/CNRS) date: ???
	73	! Objet: schema de convection de Emanuel (1991) interface
	74	! ======================================================================
	75	! Arguments:
	76	! dtime--input-R-pas d'integration (s)
	77	! s-------input-R-la vAleur "s" pour chaque couche
	78	! sigs----input-R-la vAleur "sigma" de chaque couche
	79	! sig-----input-R-la vAleur de "sigma" pour chaque niveau
	80	! psolpa--input-R-la pression au sol (en Pa)
	81	! pskapa--input-R-exponentiel kappa de psolpa
	82	! h-------input-R-enthAlpie potentielle (CpT/P*kappa)
	83	! q-------input-R-vapeur d'eau (en kg/kg)
	84
	85	! work*: input et output: deux variables de travail,
	86	! on peut les mettre a 0 au debut
	87	! ALE--------input-R-energie disponible pour soulevement
	88	! ALP--------input-R-puissance disponible pour soulevement
	89
	90	! d_h--------output-R-increment de l'enthAlpie potentielle (h)
	91	! d_q--------output-R-increment de la vapeur d'eau
	92	! rain-------output-R-la pluie (mm/s)
	93	! snow-------output-R-la neige (mm/s)
	94	! upwd-------output-R-saturated updraft mass flux (kg/m**2/s)
	95	! dnwd-------output-R-saturated downdraft mass flux (kg/m**2/s)
	96	! dnwd0------output-R-unsaturated downdraft mass flux (kg/m**2/s)
	97	! Ma---------output-R-adiabatic ascent mass flux (kg/m2/s)
	98	! mip--------output-R-mass flux shed by adiabatic ascent (kg/m2/s)
	99	! Vprecip----output-R-vertical profile of total precipitation (kg/m2/s)
	100	! Tconv------output-R-environment temperature seen by convective scheme (K)
	101	! Cape-------output-R-CAPE (J/kg)
	102	! Cin -------output-R-CIN (J/kg)
	103	! Tvp--------output-R-Temperature virtuelle d'une parcelle soulevee
	104	! adiabatiquement a partir du niveau 1 (K)
	105	! deltapb----output-R-distance entre LCL et base de la colonne (<0 ; Pa)
	106	! Ice_flag---input-L-TRUE->prise en compte de la thermodynamique de la glace
	107	! dd_t-------output-R-increment de la temperature du aux descentes precipitantes
	108	! dd_q-------output-R-increment de la vapeur d'eau du aux desc precip
	109	! lalim_conv-
	110	! wght_th----
	111	! evap-------output-R
	112	! ep---------output-R
	113	! epmlmMm----output-R
	114	! eplaMm-----output-R
	115	! wdtrainA---output-R
	116	! wdtrainS---output-R
	117	! wdtrainM---output-R
	118	! wght-------output-R
	119	! ======================================================================
	120
	121
	122
	123	INTEGER, INTENT(IN) :: iflag_clos
	124	REAL, INTENT(IN) :: dtime
	125	REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay
	126	REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
	127	INTEGER, INTENT(IN) :: k_upper_cv
	128	REAL, DIMENSION(klon,klev), INTENT(IN) :: t, q, u, v
	129	REAL, DIMENSION(klon,klev), INTENT(IN) :: t_wake, q_wake
	130	REAL, DIMENSION(klon), INTENT(IN) :: s_wake
	131	REAL, DIMENSION(klon,klev, nbtr),INTENT(IN) :: tra
	132	INTEGER, INTENT(IN) :: ntra
	133	REAL, DIMENSION(klon), INTENT(IN) :: Ale, Alp
	134	!CR:test: on passe lentr et alim_star des thermiques
	135	INTEGER, DIMENSION(klon), INTENT(IN) :: lalim_conv
	136	REAL, DIMENSION(klon,klev), INTENT(IN) :: wght_th
	137	#ifdef ISO
	138	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xt
	139	REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xt_wake
	140	#endif
	141
	142	REAL, DIMENSION(klon,klev), INTENT(INOUT) :: sig1, w01
	143
[4613]	144	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t, d_q, d_qcomp, d_u, d_v
[3927]	145	REAL, DIMENSION(klon,klev, nbtr),INTENT(OUT) :: d_tra
	146	REAL, DIMENSION(klon), INTENT(OUT) :: rain, snow
	147
	148	INTEGER, DIMENSION(klon), INTENT(OUT) :: kbas, ktop
	149	REAL, DIMENSION(klon), INTENT(OUT) :: sigd
	150	REAL, DIMENSION(klon), INTENT(OUT) :: cbmf, plcl, plfc, wbeff
	151	REAL, DIMENSION(klon), INTENT(OUT) :: convoccur
	152	REAL, DIMENSION(klon,klev), INTENT(OUT) :: upwd, dnwd, dnwdbis
	153
	154	!! REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev) !jyg
	155	REAL, DIMENSION(klon,klev), INTENT(OUT) :: Ma, mip
	156	REAL, DIMENSION(klon,klev+1), INTENT(OUT) :: Vprecip !jyg
	157	REAL, DIMENSION(klon), INTENT(OUT) :: cape, cin
	158	REAL, DIMENSION(klon,klev), INTENT(OUT) :: tvp
	159	REAL, DIMENSION(klon,klev), INTENT(OUT) :: Tconv
	160	INTEGER, DIMENSION(klon), INTENT(OUT) :: iflag
	161	REAL, DIMENSION(klon), INTENT(OUT) :: pbase, bbase
	162	REAL, DIMENSION(klon,klev), INTENT(OUT) :: dtvpdt1, dtvpdq1
	163	REAL, DIMENSION(klon), INTENT(OUT) :: dplcldt, dplcldr
	164	REAL, DIMENSION(klon,klev), INTENT(OUT) :: qcondc
	165	REAL, DIMENSION(klon), INTENT(OUT) :: wd
	166	REAL, DIMENSION(klon,klev+1), INTENT(OUT) :: pmflxr, pmflxs
	167
	168	#ifdef ISO
	169	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt
	170	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: xtrain
	171	REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: xtsnow
	172	REAL, DIMENSION(ntraciso,klon,klev+1), INTENT(OUT) :: xtVprecip
	173	#endif
	174
	175
	176	REAL, DIMENSION(klon,klev), INTENT(OUT) :: da, mp
	177	REAL, DIMENSION(klon,klev,klev),INTENT(OUT) :: phi
	178	! RomP >>>
	179	REAL, DIMENSION(klon,klev,klev),INTENT(OUT) :: phii
	180	REAL, DIMENSION(klon,klev), INTENT(OUT) :: d1a, dam
	181	REAL, DIMENSION(klon,klev,klev),INTENT(OUT) :: sij, elij
	182	REAL, DIMENSION(klon,klev), INTENT(OUT) :: qta
	183	REAL, DIMENSION(klon,klev), INTENT(OUT) :: clw
	184	REAL, DIMENSION(klon,klev), INTENT(OUT) :: dd_t, dd_q
	185	REAL, DIMENSION(klon,klev), INTENT(OUT) :: evap, ep
	186	REAL, DIMENSION(klon,klev), INTENT(OUT) :: eplaMm
	187	REAL, DIMENSION(klon,klev,klev), INTENT(OUT) :: epmlmMm
	188	REAL, DIMENSION(klon,klev), INTENT(OUT) :: wdtrainA, wdtrainS, wdtrainM
	189	! RomP <<<
	190	REAL, DIMENSION(klon,klev), INTENT(OUT) :: wght !RL
	191	REAL, DIMENSION(klon,klev), INTENT(OUT) :: qtc
[4613]	192	REAL, DIMENSION(klon,klev), INTENT(OUT) :: sigt, detrain
[3927]	193	REAL, INTENT(OUT) :: tau_cld_cv, coefw_cld_cv
	194	REAL, DIMENSION(klon), INTENT(OUT) :: epmax_diag ! epmax_cape
	195
	196	#ifdef ISO
	197	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: xtevap
	198	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: xtwdtrainA
	199	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: xtclw
	200	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: dd_xt
	201	! juste diagnostique
	202	#ifdef DIAGISO
	203	REAL, DIMENSION(klon,klev), INTENT(OUT) :: qlp
	204	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: xtlp
	205	REAL, DIMENSION(klon,klev), INTENT(OUT) :: qvp
	206	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: xtvp
	207	REAL, DIMENSION(klon,klev), INTENT(OUT) :: fq_detrainement
	208	REAL, DIMENSION(klon,klev), INTENT(OUT) :: fq_fluxmasse
	209	REAL, DIMENSION(klon,klev), INTENT(OUT) :: fq_ddft
	210	REAL, DIMENSION(klon,klev), INTENT(OUT) :: fq_evapprecip
	211	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: fxt_detrainement
	212	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: fxt_fluxmasse
	213	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: fxt_ddft
	214	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: fxt_evapprecip
	215	REAL, DIMENSION(klon,klev), INTENT(OUT) :: f_detrainement
	216	REAL, DIMENSION(klon,klev), INTENT(OUT) :: q_detrainement
	217	REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: xt_detrainement
	218	#endif
	219	#endif
	220
	221
	222	!
	223	! Local
	224	! ----
	225	REAL, DIMENSION(klon,klev) :: em_p
	226	REAL, DIMENSION(klon,klev+1) :: em_ph
	227	REAL :: em_sig1feed ! sigma at lower bound of feeding layer
	228	REAL :: em_sig2feed ! sigma at upper bound of feeding layer
	229	REAL, DIMENSION(klev) :: em_wght ! weight density determining the feeding mixture
	230	REAL, DIMENSION(klon,klev+1) :: Vprecipi !jyg
	231	!on enleve le save
	232	! SAVE em_sig1feed,em_sig2feed,em_wght
	233
	234	REAL, DIMENSION(klon) :: rflag
	235	REAL, DIMENSION(klon) :: plim1, plim2
	236	REAL, DIMENSION(klon) :: ptop2
	237	REAL, DIMENSION(klon,klev) :: asupmax
	238	REAL, DIMENSION(klon) :: supmax0, asupmaxmin
	239	REAL :: zx_t, zdelta, zx_qs, zcor
	240	!
	241	! INTEGER iflag_mix
	242	! SAVE iflag_mix
	243	INTEGER :: noff, minorig
	244	INTEGER :: i,j, k, itra
	245	REAL, DIMENSION(klon,klev) :: qs, qs_wake
	246	!LF SAVE cbmf
	247	!IM/JYG REAL, SAVE, ALLOCATABLE :: cbmf(:)
	248	!!!$OMP THREADPRIVATE(cbmf)!
	249	REAL, DIMENSION(klon) :: cbmflast
	250	#ifdef ISO
	251	REAL, DIMENSION(ntraciso,klon,klev+1) :: xtVprecipi
	252	INTEGER :: ixt
	253	#endif
	254
	255
	256	! Variables supplementaires liees au bilan d'energie
	257	! Real paire(klon)
	258	!LF Real ql(klon,klev)
	259	! Save paire
	260	!LF Save ql
	261	!LF Real t1(klon,klev),q1(klon,klev)
	262	!LF Save t1,q1
	263	! Data paire /1./
	264	REAL, SAVE, ALLOCATABLE :: ql(:, :), q1(:, :), t1(:, :)
	265	!$OMP THREADPRIVATE(ql, q1, t1)
	266	! pas besoin d'isos ici
	267
	268	! Variables liees au bilan d'energie et d'enthAlpi
	269	REAL ztsol(klon)
	270	REAL h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
	271	h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
	272	SAVE h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
	273	h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
	274	!$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot)
	275	!$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot)
	276	REAL d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
	277	REAL d_h_vcol_phy
	278	REAL fs_bound, fq_bound
	279	SAVE d_h_vcol_phy
	280	!$OMP THREADPRIVATE(d_h_vcol_phy)
	281	REAL zero_v(klon)
	282	CHARACTER *15 ztit
	283	INTEGER ip_ebil ! PRINT level for energy conserv. diag.
	284	SAVE ip_ebil
	285	DATA ip_ebil/2/
	286	!$OMP THREADPRIVATE(ip_ebil)
	287	INTEGER if_ebil ! level for energy conserv. dignostics
	288	SAVE if_ebil
	289	DATA if_ebil/2/
	290	!$OMP THREADPRIVATE(if_ebil)
	291	!+jld ec_conser
	292	REAL d_t_ec(klon, klev) ! tendance du a la conersion Ec -> E thermique
	293	REAL zrcpd
	294	!-jld ec_conser
	295	!LF
	296	INTEGER nloc
	297	LOGICAL, SAVE :: first = .TRUE.
	298	!$OMP THREADPRIVATE(first)
	299	INTEGER, SAVE :: itap, igout
	300	!$OMP THREADPRIVATE(itap, igout)
	301	include "FCTTRE.h"
	302
	303	IF (first) THEN
	304	! Allocate some variables LF 04/2008
	305
	306	!IM/JYG allocate(cbmf(klon))
	307	ALLOCATE (ql(klon,klev))
	308	ALLOCATE (t1(klon,klev))
	309	ALLOCATE (q1(klon,klev))
	310	!
	311	convoccur(:) = 0.
	312	!
	313	itap = 0
	314	igout = klon/2 + 1/klon
	315	END IF
	316	! Incrementer le compteur de la physique
	317	itap = itap + 1
	318
	319	! Copy T into Tconv
	320	DO k = 1, klev
	321	DO i = 1, klon
	322	Tconv(i, k) = t(i, k)
	323	END DO
	324	END DO
	325
	326	IF (if_ebil>=1) THEN
	327	DO i = 1, klon
	328	ztsol(i) = t(i, 1)
	329	zero_v(i) = 0.
	330	DO k = 1, klev
	331	ql(i, k) = 0.
	332	END DO
	333	END DO
	334	END IF
	335
	336	! ym
	337	snow(:) = 0
	338	#ifdef ISO
	339	xtsnow(:,:)=0
	340	#endif
	341
	342	IF (first) THEN
	343	first = .FALSE.
	344
	345	! ===========================================================================
	346	! READ IN PARAMETERS FOR THE CLOSURE AND THE MIXING DISTRIBUTION
	347	! ===========================================================================
	348
	349	IF (iflag_con==3) THEN
	350	! CALL cv3_inicp()
	351	CALL cv3_inip()
	352	END IF
	353
	354	! ===========================================================================
	355	! READ IN PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS
	356	! ===========================================================================
	357
	358	! c$$$ open (56,file='supcrit.data')
	359	! c$$$ read (56,*) Supcrit1, Supcrit2
	360	! c$$$ close (56)
	361
	362	IF (prt_level>=10) WRITE (lunout, *) 'supcrit1, supcrit2', supcrit1, supcrit2
	363
	364	! ===========================================================================
	365	! Initialisation pour les bilans d'eau et d'energie
	366	! ===========================================================================
	367	IF (if_ebil>=1) d_h_vcol_phy = 0.
	368
	369	DO i = 1, klon
	370	cbmf(i) = 0.
	371	!! plcl(i) = 0.
	372	sigd(i) = 0.
	373	END DO
	374	END IF !(first)
	375
	376	! Initialisation a chaque pas de temps
	377	plfc(:) = 0.
	378	wbeff(:) = 100.
	379	plcl(:) = 0.
	380
	381	DO k = 1, klev + 1
	382	DO i = 1, klon
	383	em_ph(i, k) = paprs(i, k)/100.0
	384	pmflxr(i, k) = 0.
	385	pmflxs(i, k) = 0.
	386	END DO
	387	END DO
	388
	389	DO k = 1, klev
	390	DO i = 1, klon
	391	em_p(i, k) = pplay(i, k)/100.0
	392	END DO
	393	END DO
	394
	395
	396	! Feeding layer
	397
	398	em_sig1feed = 1.
	399	!jyg<
	400	! em_sig2feed = 0.97
	401	em_sig2feed = cvl_sig2feed
	402	!>jyg
	403	! em_sig2feed = 0.8
	404	! Relative Weight densities
	405	DO k = 1, klev
	406	em_wght(k) = 1.
	407	END DO
	408	!CRtest: couche alim des tehrmiques ponderee par a*
	409	! DO i = 1, klon
	410	! do k=1,lalim_conv(i)
	411	! em_wght(k)=wght_th(i,k)
	412	! print*,'em_wght=',em_wght(k),wght_th(i,k)
	413	! end do
	414	! END DO
	415
	416	IF (iflag_con==4) THEN
	417	DO k = 1, klev
	418	DO i = 1, klon
	419	zx_t = t(i, k)
	420	zdelta = max(0., sign(1.,rtt-zx_t))
	421	zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
	422	zcor = 1./(1.-retv*zx_qs)
	423	qs(i, k) = zx_qs*zcor
	424	END DO
	425	DO i = 1, klon
	426	zx_t = t_wake(i, k)
	427	zdelta = max(0., sign(1.,rtt-zx_t))
	428	zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
	429	zcor = 1./(1.-retv*zx_qs)
	430	qs_wake(i, k) = zx_qs*zcor
	431	END DO
	432	END DO
	433	ELSE ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique)
	434	DO k = 1, klev
	435	DO i = 1, klon
	436	zx_t = t(i, k)
	437	zdelta = max(0., sign(1.,rtt-zx_t))
	438	zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
	439	zx_qs = min(0.5, zx_qs)
	440	zcor = 1./(1.-retv*zx_qs)
	441	zx_qs = zx_qs*zcor
	442	qs(i, k) = zx_qs
	443	END DO
	444	DO i = 1, klon
	445	zx_t = t_wake(i, k)
	446	zdelta = max(0., sign(1.,rtt-zx_t))
	447	zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
	448	zx_qs = min(0.5, zx_qs)
	449	zcor = 1./(1.-retv*zx_qs)
	450	zx_qs = zx_qs*zcor
	451	qs_wake(i, k) = zx_qs
	452	END DO
	453	END DO
	454	END IF ! iflag_con
	455
	456	! ------------------------------------------------------------------
	457
	458	! Main driver for convection:
	459	! iflag_con=3 -> nvlle version de KE (JYG)
	460	! iflag_con = 30 -> equivAlent to convect3
	461	! iflag_con = 4 -> equivAlent to convect1/2
	462
	463
	464	IF (iflag_con==30) THEN
	465
	466
	467	#ifdef ISO
	468	#ifdef ISOVERIF
	469	do k = 1, klev
	470	do i = 1, klon
	471	do ixt=1,ntraciso
	472	call iso_verif_noNaN(xt(ixt,i,k),'concvl 394')
	473	enddo
	474	enddo !do i = 1, klon
	475	enddo !do k = 1, klev
	476	if (iso_eau.gt.0) then
	477	do k = 1, klev
	478	do i = 1, klon
	479	call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
	480	& 'concvl 174',errmax,errmaxrel)
	481	enddo !do i = 1, klon
	482	enddo !do k = 1, klev
	483	endif !if (iso_eau.gt.0) then
	484	if (iso_HDO.gt.0) then
	485	do k = 1, klev
	486	do i = 1, klon
	487	if (q(i,k).gt.ridicule) then
	488	call iso_verif_aberrant(xt(iso_hdo,i,k)/q(i,k),'concvl 175')
	489	endif ! if (q(i,k).gt.ridicule) then
	490	enddo
	491	enddo
	492	endif !if (iso_eau.gt.0) then
	493	#ifdef ISOTRAC
	494	do k = 1, klev
	495	do i = 1, klon
	496	call iso_verif_traceur(xt(1,i,k),'concvl 218')
	497	enddo
	498	enddo
	499	#endif
	500	write(,) 'concvl 170: avant appel cv_driver'
	501	#endif
	502	! ISOVERIF ! end verif
	503	#endif
	504
	505	! print *, '-> cv_driver' !jyg
	506	CALL cv_driver(klon, klev, klevp1, ntra, iflag_con, &
	507	t, q, qs, u, v, tra, &
	508	em_p, em_ph, iflag, &
	509	d_t, d_q, d_u, d_v, d_tra, rain, &
	510	Vprecip, cbmf, sig1, w01, & !jyg
	511	kbas, ktop, &
	512	dtime, Ma, upwd, dnwd, dnwdbis, qcondc, wd, cape, &
	513	da, phi, mp, phii, d1a, dam, sij, clw, elij, & !RomP
	514	evap, ep, epmlmMm, eplaMm, & !RomP
	515	wdtrainA, wdtrainM, & !RomP
	516	epmax_diag & ! epmax_cape
	517	#ifdef ISO
	518	& , xt,d_xt &
	519	& , xtrain,xtVprecip &
	520	& , xtevap,xtclw,xtwdtrainA &
	521	#ifdef DIAGISO
	522	& , qlp,xtlp,qvp,xtvp & ! juste diagnostique
	523	& , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
	524	& , fxt_detrainement,fxt_ddft,fxt_fluxmasse,fxt_evapprecip &
	525	& , f_detrainement,q_detrainement,xt_detrainement &
	526	#endif
	527	#endif
	528	& )
	529	! print *, 'cv_driver ->' !jyg
	530
	531	#ifdef ISO
	532	! verif
	533	#ifdef ISOVERIF
	534	write(,) 'concvl 463: après appel cv_driver'
	535	do k = 1, klev
	536	do i = 1, klon
	537	if (iso_eau.gt.0) then
	538	call iso_verif_egalite(xt(iso_eau,i,k),q(i,k),'concvl 203')
	539	call iso_verif_egalite(xt_wake(iso_eau,i,k),q_wake(i,k),'concvl 204')
	540	call iso_verif_egalite(d_xt(iso_eau,i,k),d_q(i,k), &
	541	& 'concvl 452')
	542	endif !if (iso_eau.gt.0) then
	543	#ifdef DIAGISO
	544	do ixt=1,ntraciso
	545	call iso_verif_noNaN(xt(ixt,i,k),'concvl 460')
	546	call iso_verif_noNaN(xtlp(ixt,i,k),'concvl 295')
	547	call iso_verif_noNaN(xtvp(ixt,i,k),'concvl 260')
	548	enddo
	549	#endif
	550	enddo
	551	enddo
	552	#ifdef ISOTRAC
	553	call iso_verif_traceur_vect(xt,klon,klev,'concvl 218')
	554	call iso_verif_trac_masse_vect(d_xt,klon,klev, &
	555	& 'concvl 464',errmax,errmaxrel)
	556	#endif
	557	#endif
	558	! end verif
	559	#endif
	560
	561	DO i = 1, klon
	562	cbmf(i) = Ma(i, kbas(i))
	563	END DO
	564
	565	!RL
	566	wght(:, :) = 0.
	567	DO i = 1, klon
	568	wght(i, 1) = 1.
	569	END DO
	570	!RL
	571
	572	ELSE
	573
	574	!LF necessary for gathered fields
	575	nloc = klon
	576	#ifdef ISOVERIF
	577	write(,) 'concvl 581: juste avant appel de cva_driver'
	578	#endif
	579	CALL cva_driver(klon, klev, klev+1, ntra, nloc, k_upper_cv, &
	580	iflag_con, iflag_mix, iflag_ice_thermo, &
	581	iflag_clos, ok_conserv_q, dtime, cvl_comp_threshold, &
	582	t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, tra, &
	583	em_p, em_ph, &
	584	Ale, Alp, omega, &
	585	em_sig1feed, em_sig2feed, em_wght, &
[4613]	586	iflag, d_t, d_q, d_qcomp, d_u, d_v, d_tra, rain, kbas, ktop, &
[3927]	587	cbmf, plcl, plfc, wbeff, sig1, w01, ptop2, sigd, &
	588	Ma, mip, Vprecip, Vprecipi, upwd, dnwd, dnwdbis, qcondc, wd, &
	589	cape, cin, tvp, &
	590	dd_t, dd_q, plim1, plim2, asupmax, supmax0, &
	591	asupmaxmin, lalim_conv, &
	592	!AC!+!RomP+jyg
	593	!! da,phi,mp,phii,d1a,dam,sij,clw,elij, & ! RomP
	594	!! evap,ep,epmlmMm,eplaMm, ! RomP
	595	da, phi, mp, phii, d1a, dam, sij, wght, & ! RomP+RL
	596	qta, clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP+RL
[4613]	597	wdtrainA, wdtrainS, wdtrainM, qtc, sigt, detrain, &
[3927]	598	tau_cld_cv, coefw_cld_cv, & ! RomP,AJ
	599	!AC!+!RomP+jyg
	600	epmax_diag & ! epmax_cape
	601	#ifdef ISO
	602	& ,xt,xt_wake,d_xt, xtrain &
	603	& ,xtvprecip,xtvprecipi &
	604	& ,xtclw,dd_xt,xtevap,xtwdtrainA &
	605	#ifdef DIAGISO
	606	& , qlp,xtlp,qvp,xtvp &
	607	& , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
	608	& , fxt_detrainement,fxt_ddft,fxt_fluxmasse,fxt_evapprecip &
	609	& , f_detrainement,q_detrainement,xt_detrainement &
	610	#endif
	611	#endif
	612	& )
	613	END IF
	614	! ------------------------------------------------------------------
	615	IF (prt_level>=10) WRITE (lunout, *) ' cva_driver -> cbmf,plcl,plfc,wbeff, d_t, d_q ', &
	616	cbmf(1), plcl(1), plfc(1), wbeff(1), d_t(1,1), d_q(1,1)
	617
	618	DO i = 1, klon
	619	rain(i) = rain(i)/86400.
	620	rflag(i) = iflag(i)
	621	#ifdef ISO
	622	do ixt = 1, ntraciso
	623	xtrain(ixt,i) = xtrain(ixt,i)/86400.
	624	enddo
	625	#endif
	626	END DO
	627
	628	DO k = 1, klev
	629	DO i = 1, klon
	630	d_t(i, k) = dtime*d_t(i, k)
	631	d_q(i, k) = dtime*d_q(i, k)
	632	d_u(i, k) = dtime*d_u(i, k)
	633	d_v(i, k) = dtime*d_v(i, k)
	634	#ifdef ISO
	635	do ixt = 1, ntraciso
	636	d_xt(ixt,i,k) = dtime*d_xt(ixt,i,k)
	637	enddo
	638	#endif
	639	END DO
	640	END DO
	641
	642
	643	#ifdef ISO
	644	#ifdef ISOVERIF
	645	! k=1
	646	! i= 538
	647	write(,) 'concvl 640'
	648	! write(,) 'q(i,k),d_q(i,k)=', q(i,k),d_q(i,k)
	649	! write(,) 'xt(iso_HDO,i,k),d_xt(iso_HDO,i,k)=', &
	650	! & xt(iso_HDO,i,k),d_xt(iso_HDO,i,k)
	651	DO k = 1, klev
	652	DO i = 1, klon
	653	if (iso_HDO.gt.0) then
	654	if (q(i,k).gt.ridicule) then
	655	call iso_verif_aberrant_encadre((xt(iso_HDO,i,k) &
	656	& +d_xt(iso_HDO,i,k))/(q(i,k)+d_q(i,k)),'concvl 250')
	657	endif !if (q_seri(i,k).gt.ridicule) then
	658	endif !if (iso_HDO.gt.0) then
	659	if (iso_eau.gt.0) then
	660	call iso_verif_egalite_choix(d_xt(iso_eau,i,k), &
	661	& d_q(i,k),'concvl 530',errmax*dtime,errmaxrel)
	662	endif !if (iso_HDO.gt.0) then
	663	#ifdef ISOTRAC
	664	call iso_verif_traceur_justmass(d_xt(1,i,k),'concvl 316')
	665	#endif
	666	END DO
	667	END DO
	668	#endif
	669	#endif
	670
	671	#ifdef ISO
	672	if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then
	673	do k=1,klev
	674	do i=1,klon
	675	d_xt(iso_eau,i,k)=d_q(i,k)
	676	enddo !do i=1,klon
	677	enddo !do k=1,klev
	678	#ifdef ISOTRAC
	679	call iso_verif_traceur_jbid_vect(d_xt, &
	680	& klon,klev)
	681	#endif
	682	endif !if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then
	683	#endif
	684
	685	IF (iflag_con==3) THEN
	686	DO i = 1,klon
	687	IF (wbeff(i) > 100. .OR. wbeff(i) == 0 .OR. iflag(i) > 3) THEN
	688	wbeff(i) = 0.
	689	convoccur(i) = 0.
	690	ELSE
	691	convoccur(i) = 1.
	692	ENDIF
	693	ENDDO
	694	ENDIF
	695
	696	IF (iflag_con==30) THEN
	697	DO itra = 1, ntra
	698	DO k = 1, klev
	699	DO i = 1, klon
	700	!RL! d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
	701	d_tra(i, k, itra) = 0.
	702	END DO
	703	END DO
	704	END DO
	705	END IF
	706
	707	!!AC!
	708	IF (iflag_con==3) THEN
	709	DO itra = 1, ntra
	710	DO k = 1, klev
	711	DO i = 1, klon
	712	!RL! d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
	713	d_tra(i, k, itra) = 0.
	714	END DO
	715	END DO
	716	END DO
	717	END IF
	718	!!AC!
	719
	720	DO k = 1, klev
	721	DO i = 1, klon
	722	t1(i, k) = t(i, k) + d_t(i, k)
	723	q1(i, k) = q(i, k) + d_q(i, k)
	724	! juste diag: pas besoin d'isos ici
	725	END DO
	726	END DO
	727
	728	! !jyg
	729	IF (iflag_con == 30 .OR. iflag_ice_thermo ==0) THEN
	730	! --Separation neige/pluie (pour diagnostics) !jyg
	731	DO k = 1, klev !jyg
	732	DO i = 1, klon !jyg
	733	IF (t1(i,k)<rtt) THEN !jyg
	734	pmflxs(i, k) = Vprecip(i, k) !jyg
	735	ELSE !jyg
	736	pmflxr(i, k) = Vprecip(i, k) !jyg
	737	END IF !jyg
	738	END DO !jyg
	739	END DO !jyg
	740	ELSE
	741	DO k = 1, klev !jyg
	742	DO i = 1, klon !jyg
	743	pmflxs(i, k) = Vprecipi(i, k) !jyg
	744	pmflxr(i, k) = Vprecip(i, k)-Vprecipi(i, k) !jyg
	745	END DO !jyg
	746	END DO !jyg
	747	ENDIF
	748
	749	! c IF (if_ebil.ge.2) THEN
	750	! c ztit='after convect'
	751	! c CALL diagetpq(paire,ztit,ip_ebil,2,2,dtime
	752	! c e , t1,q1,ql,qs,u,v,paprs,pplay
	753	! c s , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
	754	! c call diagphy(paire,ztit,ip_ebil
	755	! c e , zero_v, zero_v, zero_v, zero_v, zero_v
	756	! c e , zero_v, rain, zero_v, ztsol
	757	! c e , d_h_vcol, d_qt, d_ec
	758	! c s , fs_bound, fq_bound )
	759	! c END IF
	760
	761
	762	! les traceurs ne sont pas mis dans cette version de convect4:
	763	IF (iflag_con==4) THEN
	764	DO itra = 1, ntra
	765	DO k = 1, klev
	766	DO i = 1, klon
	767	d_tra(i, k, itra) = 0.
	768	END DO
	769	END DO
	770	END DO
	771	END IF
	772	! print*, 'concvl->: dd_t,dd_q ',dd_t(1,1),dd_q(1,1)
	773
	774	DO k = 1, klev
	775	DO i = 1, klon
	776	dtvpdt1(i, k) = 0.
	777	dtvpdq1(i, k) = 0.
	778	END DO
	779	END DO
	780	DO i = 1, klon
	781	dplcldt(i) = 0.
	782	dplcldr(i) = 0.
	783	END DO
	784
	785	IF (prt_level>=20) THEN
	786	DO k = 1, klev
	787	! print*,'physiq apres_add_con i k it d_u d_v d_t d_q qdl0',igout, &
	788	! k,itap,d_u_con(igout,k) ,d_v_con(igout,k), d_t_con(igout,k), &
	789	! d_q_con(igout,k),dql0(igout,k)
	790	! print*,'phys apres_add_con itap Ma cin ALE ALP wak t q undi t q', &
	791	! itap,Ma(igout,k),cin(igout),ALE(igout), ALP(igout), &
	792	! t_wake(igout,k),q_wake(igout,k),t_undi(igout,k),q_undi(igout,k)
	793	! print*,'phy apres_add_con itap CON rain snow EMA wk1 wk2 Vpp mip', &
	794	! itap,rain_con(igout),snow_con(igout),ema_work1(igout,k), &
	795	! ema_work2(igout,k),Vprecip(igout,k), mip(igout,k)
	796	! print*,'phy apres_add_con itap upwd dnwd dnwd0 cape tvp Tconv ', &
	797	! itap,upwd(igout,k),dnwd(igout,k),dnwd0(igout,k),cape(igout), &
	798	! tvp(igout,k),Tconv(igout,k)
	799	! print*,'phy apres_add_con itap dtvpdt dtvdq dplcl dplcldr qcondc', &
	800	! itap,dtvpdt1(igout,k),dtvpdq1(igout,k),dplcldt(igout), &
	801	! dplcldr(igout),qcondc(igout,k)
	802	! print*,'phy apres_add_con itap wd pmflxr Kpmflxr Kp1 Kpmflxs Kp1', &
	803	! itap,wd(igout),pmflxr(igout,k),pmflxr(igout,k+1),pmflxs(igout,k), &
	804	! pmflxs(igout,k+1)
	805	! print*,'phy apres_add_con itap da phi mp ftd fqd lalim wgth', &
	806	! itap,da(igout,k),phi(igout,k,k),mp(igout,k),ftd(igout,k), &
	807	! fqd(igout,k),lalim_conv(igout),wght_th(igout,k)
	808	END DO
	809	END IF !(prt_level.EQ.20) THEN
	810
	811	RETURN
	812	END SUBROUTINE concvl
	813

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

Download in other formats:

Original Format