SUBROUTINE concvl(iflag_clos, & dtime, paprs, pplay, k_upper_cv, & t, q, t_wake, q_wake, s_wake, u, v, tra, ntra, & Ale, Alp, sig1, w01, & d_t, d_q, d_u, d_v, d_tra, & rain, snow, kbas, ktop, sigd, & cbmf, plcl, plfc, wbeff, upwd, dnwd, dnwdbis, & Ma, mip, Vprecip, & cape, cin, tvp, Tconv, iflag, & pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, & qcondc, wd, pmflxr, pmflxs, & !RomP >>> !! . da,phi,mp,dd_t,dd_q,lalim_conv,wght_th) da, phi, mp, phi2, d1a, dam, sij, clw, elij, & ! RomP dd_t, dd_q, lalim_conv, wght_th, & ! RomP evap, ep, epmlmMm, eplaMm, & ! RomP wdtrainA, wdtrainM, wght, qtc, sigt, & tau_cld_cv, coefw_cld_cv, & ! RomP+RL, AJ !RomP <<< epmax_diag & ! epmax_cape #ifdef ISO & ,xt,xt_wake,d_xt,xtrain,xtsnow,dd_xt & & ,xtVprecip,xtVprecipi & #ifdef DIAGISO & , qlp,xtlp,qvp,xtvp,xtevap,xtclw & ! juste diagnostique & , wdtrain,xtwdtrain,tadiab & & , taux_cond_conv & & , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip & & , fxt_detrainement,fxt_ddft,fxt_fluxmasse & & , fxt_evapprecip,Mi,Amp_diag,tcond & & , f_detrainement,q_detrainement,xt_detrainement & #endif #endif & ) ! ************************************************************** ! * ! CONCVL * ! * ! * ! written by : Sandrine Bony-Lena, 17/05/2003, 11.16.04 * ! modified by : * ! ************************************************************** USE dimphy #ifdef ISO USE infotrac_phy, ONLY: nbtr,ntraciso USE isotopes_mod, ONLY: iso_eau, bidouille_anti_divergence, ridicule, & iso_eau,iso_HDO #else USE infotrac_phy, ONLY: nbtr #endif #ifdef ISOVERIF USE isotopes_verif_mod, ONLY: errmax,errmaxrel, & iso_verif_egalite_choix,iso_verif_aberrant,iso_verif_egalite, & iso_verif_noNaN #endif #ifdef ISOTRAC USE isotrac_routines_mod, only: iso_verif_traceur_jbid_vect #ifdef ISOVERIF USE isotopes_verif_mod, ONLY: iso_verif_traceur_vect, & & iso_verif_trac_masse_vect, iso_verif_traceur, & & iso_verif_traceur_justmass #endif #endif USE phys_local_var_mod, ONLY: omega USE print_control_mod, ONLY: prt_level, lunout IMPLICIT NONE ! ====================================================================== ! Auteur(s): S. Bony-Lena (LMD/CNRS) date: ??? ! Objet: schema de convection de Emanuel (1991) interface ! ====================================================================== ! Arguments: ! dtime--input-R-pas d'integration (s) ! s-------input-R-la vAleur "s" pour chaque couche ! sigs----input-R-la vAleur "sigma" de chaque couche ! sig-----input-R-la vAleur de "sigma" pour chaque niveau ! psolpa--input-R-la pression au sol (en Pa) ! pskapa--input-R-exponentiel kappa de psolpa ! h-------input-R-enthAlpie potentielle (Cp*T/P**kappa) ! q-------input-R-vapeur d'eau (en kg/kg) ! work*: input et output: deux variables de travail, ! on peut les mettre a 0 au debut ! ALE--------input-R-energie disponible pour soulevement ! ALP--------input-R-puissance disponible pour soulevement ! d_h--------output-R-increment de l'enthAlpie potentielle (h) ! d_q--------output-R-increment de la vapeur d'eau ! rain-------output-R-la pluie (mm/s) ! snow-------output-R-la neige (mm/s) ! upwd-------output-R-saturated updraft mass flux (kg/m**2/s) ! dnwd-------output-R-saturated downdraft mass flux (kg/m**2/s) ! dnwd0------output-R-unsaturated downdraft mass flux (kg/m**2/s) ! Ma---------output-R-adiabatic ascent mass flux (kg/m2/s) ! mip--------output-R-mass flux shed by adiabatic ascent (kg/m2/s) ! Vprecip----output-R-vertical profile of total precipitation (kg/m2/s) ! Tconv------output-R-environment temperature seen by convective scheme (K) ! Cape-------output-R-CAPE (J/kg) ! Cin -------output-R-CIN (J/kg) ! Tvp--------output-R-Temperature virtuelle d'une parcelle soulevee ! adiabatiquement a partir du niveau 1 (K) ! deltapb----output-R-distance entre LCL et base de la colonne (<0 ; Pa) ! Ice_flag---input-L-TRUE->prise en compte de la thermodynamique de la glace ! dd_t-------output-R-increment de la temperature du aux descentes precipitantes ! dd_q-------output-R-increment de la vapeur d'eau du aux desc precip ! lalim_conv- ! wght_th---- ! evap-------output-R ! ep---------output-R ! epmlmMm----output-R ! eplaMm-----output-R ! wdtrainA---output-R ! wdtrainM---output-R ! wght-------output-R ! ====================================================================== include "clesphys.h" INTEGER iflag_clos REAL dtime, paprs(klon, klev+1), pplay(klon, klev) INTEGER k_upper_cv REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev) REAL t_wake(klon, klev), q_wake(klon, klev) REAL s_wake(klon) REAL tra(klon, klev, nbtr) INTEGER ntra REAL sig1(klon, klev), w01(klon, klev), ptop2(klon) REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1) REAL Ale(klon), Alp(klon) REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, klev) REAL dd_t(klon, klev), dd_q(klon, klev) REAL d_tra(klon, klev, nbtr) REAL rain(klon), snow(klon) INTEGER kbas(klon), ktop(klon) REAL em_ph(klon, klev+1), em_p(klon, klev) REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev) #ifdef ISO REAL xt(ntraciso,klon,klev) REAL xtl(ntraciso,klon,klev) REAL xt_undi(ntraciso,klon,klev) REAL d_xt(ntraciso,klon,klev) real dd_xt(ntraciso,klon,klev) REAL xtrain(ntraciso,klon) real xtsnow(ntraciso,klon) real fxtd(ntraciso,klon) REAL xt1(ntraciso,klon,klev) integer ixt ! juste diagnostique #ifdef DIAGISO real qlp(klon,klev),xtlp(niso,klon,klev), & & qvp(klon,klev),xtvp(ntraciso,klon,klev), & & xtevap(niso,klon,klev), & & xtclw(ntraciso,klon,klev), & & wdtrain(klon,klev),xtwdtrain(niso,klon,klev), & & tadiab(klon,klev), taux_cond_conv(klon,klev), & & fq_detrainement(klon,klev),fq_ddft(klon,klev), & & fq_fluxmasse(klon,klev),fq_evapprecip(klon,klev), & & fxt_detrainement(niso,klon,klev),fxt_ddft(niso,klon,klev), & & fxt_fluxmasse(niso,klon,klev), & & fxt_evapprecip(niso,klon,klev), Mi(klon,klev), & & Amp_diag(klon,klev),tcond(klon,klev) & ! : ,mentbas(klon,klev), qentbas(klon,klev), ! : xtentbas(niso,klon,klev) real f_detrainement(klon,klev),q_detrainement(klon,klev), & & xt_detrainement(niso,klon,klev) #endif REAL xt_wake(ntraciso,klon,klev) #endif !! REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev) !jyg REAL Ma(klon, klev), mip(klon, klev), Vprecip(klon, klev+1) !jyg REAL Vprecipi(klon, klev+1) !jyg REAL wght(klon, klev) !RL #ifdef ISO REAL xtVprecip(ntraciso,klon, klev+1),xtVprecipi(ntraciso,klon, klev+1) #endif REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev) ! RomP >>> REAL phi2(klon, klev, klev) REAL d1a(klon, klev), dam(klon, klev) REAL sij(klon, klev, klev), clw(klon, klev), elij(klon, klev, klev) REAL wdtrainA(klon, klev), wdtrainM(klon, klev) REAL evap(klon, klev), ep(klon, klev) REAL epmlmMm(klon, klev, klev), eplaMm(klon, klev) ! RomP <<< REAL cape(klon), cin(klon), tvp(klon, klev) REAL Tconv(klon, klev) !CR:test: on passe lentr et alim_star des thermiques INTEGER lalim_conv(klon) REAL wght_th(klon, klev) REAL em_sig1feed ! sigma at lower bound of feeding layer REAL em_sig2feed ! sigma at upper bound of feeding layer REAL em_wght(klev) ! weight density determining the feeding mixture !on enleve le save ! SAVE em_sig1feed,em_sig2feed,em_wght INTEGER iflag(klon) REAL rflag(klon) REAL pbase(klon), bbase(klon) REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev) REAL dplcldt(klon), dplcldr(klon) REAL qcondc(klon, klev) REAL qtc(klon, klev) REAL sigt(klon, klev) REAL wd(klon) REAL plim1(klon), plim2(klon), asupmax(klon, klev) REAL supmax0(klon), asupmaxmin(klon) REAL sigd(klon) REAL zx_t, zdelta, zx_qs, zcor REAL tau_cld_cv, coefw_cld_cv REAL epmax_diag(klon) ! epmax_cape ! INTEGER iflag_mix ! SAVE iflag_mix INTEGER noff, minorig INTEGER i, k, itra REAL qs(klon, klev), qs_wake(klon, klev) REAL cbmf(klon), plcl(klon), plfc(klon), wbeff(klon) !LF SAVE cbmf !IM/JYG REAL, SAVE, ALLOCATABLE :: cbmf(:) !!!$OMP THREADPRIVATE(cbmf)! REAL cbmflast(klon) INTEGER ifrst SAVE ifrst DATA ifrst/0/ !$OMP THREADPRIVATE(ifrst) ! Variables supplementaires liees au bilan d'energie ! Real paire(klon) !LF Real ql(klon,klev) ! Save paire !LF Save ql !LF Real t1(klon,klev),q1(klon,klev) !LF Save t1,q1 ! Data paire /1./ REAL, SAVE, ALLOCATABLE :: ql(:, :), q1(:, :), t1(:, :) !$OMP THREADPRIVATE(ql, q1, t1) ! Variables liees au bilan d'energie et d'enthAlpi REAL ztsol(klon) REAL h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, & h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot SAVE h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, & h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot !$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot) !$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot) REAL d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec REAL d_h_vcol_phy REAL fs_bound, fq_bound SAVE d_h_vcol_phy !$OMP THREADPRIVATE(d_h_vcol_phy) REAL zero_v(klon) CHARACTER *15 ztit INTEGER ip_ebil ! PRINT level for energy conserv. diag. SAVE ip_ebil DATA ip_ebil/2/ !$OMP THREADPRIVATE(ip_ebil) INTEGER if_ebil ! level for energy conserv. dignostics SAVE if_ebil DATA if_ebil/2/ !$OMP THREADPRIVATE(if_ebil) !+jld ec_conser REAL d_t_ec(klon, klev) ! tendance du a la conersion Ec -> E thermique REAL zrcpd !-jld ec_conser !LF INTEGER nloc LOGICAL, SAVE :: first = .TRUE. !$OMP THREADPRIVATE(first) INTEGER, SAVE :: itap, igout !$OMP THREADPRIVATE(itap, igout) include "YOMCST.h" include "YOMCST2.h" include "YOETHF.h" include "FCTTRE.h" !jyg< include "conema3.h" !>jyg IF (first) THEN ! Allocate some variables LF 04/2008 !IM/JYG allocate(cbmf(klon)) ALLOCATE (ql(klon,klev)) ALLOCATE (t1(klon,klev)) ALLOCATE (q1(klon,klev)) itap = 0 igout = klon/2 + 1/klon END IF ! Incrementer le compteur de la physique itap = itap + 1 ! Copy T into Tconv DO k = 1, klev DO i = 1, klon Tconv(i, k) = t(i, k) END DO END DO IF (if_ebil>=1) THEN DO i = 1, klon ztsol(i) = t(i, 1) zero_v(i) = 0. DO k = 1, klev ql(i, k) = 0. #ifdef ISO do ixt=1,ntraciso xtl(ixt,i,k) = 0. enddo #endif END DO END DO END IF ! ym snow(:) = 0 #ifdef ISO xtsnow(:,:)=0 #endif ! IF (ifrst .EQ. 0) THEN ! ifrst = 1 IF (first) THEN first = .FALSE. ! =========================================================================== ! READ IN PARAMETERS FOR THE CLOSURE AND THE MIXING DISTRIBUTION ! =========================================================================== IF (iflag_con==3) THEN ! CALL cv3_inicp() CALL cv3_inip() END IF ! =========================================================================== ! READ IN PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS ! =========================================================================== ! c$$$ open (56,file='supcrit.data') ! c$$$ read (56,*) Supcrit1, Supcrit2 ! c$$$ close (56) IF (prt_level>=10) WRITE (lunout, *) 'supcrit1, supcrit2', supcrit1, supcrit2 ! =========================================================================== ! Initialisation pour les bilans d'eau et d'energie ! =========================================================================== IF (if_ebil>=1) d_h_vcol_phy = 0. DO i = 1, klon cbmf(i) = 0. !! plcl(i) = 0. sigd(i) = 0. END DO END IF !(ifrst .EQ. 0) ! Initialisation a chaque pas de temps plfc(:) = 0. wbeff(:) = 100. plcl(:) = 0. DO k = 1, klev + 1 DO i = 1, klon em_ph(i, k) = paprs(i, k)/100.0 pmflxr(i, k) = 0. pmflxs(i, k) = 0. END DO END DO DO k = 1, klev DO i = 1, klon em_p(i, k) = pplay(i, k)/100.0 END DO END DO ! Feeding layer em_sig1feed = 1. !jyg< ! em_sig2feed = 0.97 em_sig2feed = cvl_sig2feed !>jyg ! em_sig2feed = 0.8 ! Relative Weight densities DO k = 1, klev em_wght(k) = 1. END DO !CRtest: couche alim des tehrmiques ponderee par a* ! DO i = 1, klon ! do k=1,lalim_conv(i) ! em_wght(k)=wght_th(i,k) ! print*,'em_wght=',em_wght(k),wght_th(i,k) ! end do ! END DO IF (iflag_con==4) THEN DO k = 1, klev DO i = 1, klon zx_t = t(i, k) zdelta = max(0., sign(1.,rtt-zx_t)) zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0) zcor = 1./(1.-retv*zx_qs) qs(i, k) = zx_qs*zcor END DO DO i = 1, klon zx_t = t_wake(i, k) zdelta = max(0., sign(1.,rtt-zx_t)) zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0) zcor = 1./(1.-retv*zx_qs) qs_wake(i, k) = zx_qs*zcor END DO END DO ELSE ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique) DO k = 1, klev DO i = 1, klon zx_t = t(i, k) zdelta = max(0., sign(1.,rtt-zx_t)) zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0 zx_qs = min(0.5, zx_qs) zcor = 1./(1.-retv*zx_qs) zx_qs = zx_qs*zcor qs(i, k) = zx_qs END DO DO i = 1, klon zx_t = t_wake(i, k) zdelta = max(0., sign(1.,rtt-zx_t)) zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0 zx_qs = min(0.5, zx_qs) zcor = 1./(1.-retv*zx_qs) zx_qs = zx_qs*zcor qs_wake(i, k) = zx_qs END DO END DO END IF ! iflag_con ! ------------------------------------------------------------------ ! Main driver for convection: ! iflag_con=3 -> nvlle version de KE (JYG) ! iflag_con = 30 -> equivAlent to convect3 ! iflag_con = 4 -> equivAlent to convect1/2 IF (iflag_con==30) THEN #ifdef ISO #ifdef ISOVERIF do k = 1, klev do i = 1, klon do ixt=1,ntraciso call iso_verif_noNaN(xt(ixt,i,k),'concvl 394') enddo enddo !do i = 1, klon enddo !do k = 1, klev if (iso_eau.gt.0) then do k = 1, klev do i = 1, klon call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), & & 'concvl 174',errmax,errmaxrel) enddo !do i = 1, klon enddo !do k = 1, klev endif !if (iso_eau.gt.0) then if (iso_HDO.gt.0) then do k = 1, klev do i = 1, klon if (q(i,k).gt.ridicule) then call iso_verif_aberrant(xt(iso_hdo,i,k)/q(i,k),'concvl 174') endif ! if (q(i,k).gt.ridicule) then enddo enddo endif !if (iso_eau.gt.0) then #ifdef ISOTRAC do k = 1, klev do i = 1, klon call iso_verif_traceur(xt(1,i,k),'concvl 218') enddo enddo #endif write(*,*) 'concvl 170: avant appel cv_driver' #endif ! ISOVERIF ! end verif #endif ! print *, '-> cv_driver' !jyg CALL cv_driver(klon, klev, klevp1, ntra, iflag_con, & t, q, qs, u, v, tra, & em_p, em_ph, iflag, & d_t, d_q, d_u, d_v, d_tra, rain, & Vprecip, cbmf, sig1, w01, & !jyg kbas, ktop, & dtime, Ma, upwd, dnwd, dnwdbis, qcondc, wd, cape, & da, phi, mp, phi2, d1a, dam, sij, clw, elij, & !RomP evap, ep, epmlmMm, eplaMm, & !RomP wdtrainA, wdtrainM, & !RomP epmax_diag & ! epmax_cape #ifdef ISO & ,xt,d_xt,xtrain,xtVprecip & #ifdef DIAGISO & , qlp,xtlp,qvp,xtvp,xtevap,xtclw & ! juste diagnostique & , wdtrain, xtwdtrain,tadiab & & , taux_cond_conv & & , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip & & , fxt_detrainement,fxt_ddft,fxt_fluxmasse & & , fxt_evapprecip,Mi,Amp_diag,tcond & & , f_detrainement,q_detrainement,xt_detrainement & #endif #endif & ) ! print *, 'cv_driver ->' !jyg #ifdef ISO ! verif #ifdef ISOVERIF write(*,*) 'concvl 463: après appel cv_driver' do k = 1, klev do i = 1, klon if (iso_eau.gt.0) then call iso_verif_egalite(xt(iso_eau,i,k),q(i,k),'concvl 203') call iso_verif_egalite(d_xt(iso_eau,i,k),d_q(i,k), & & 'concvl 452') endif !if (iso_eau.gt.0) then #ifdef DIAGISO do ixt=1,niso call iso_verif_noNaN(xt(ixt,i,k),'concvl 460') call iso_verif_noNaN(xtlp(ixt,i,k),'concvl 295') call iso_verif_noNaN(xtvp(ixt,i,k),'concvl 260') enddo call iso_verif_positif(tcond(i,k)-50.0,'concvl 277') call iso_verif_noNaN(tcond(i,k),'concvl 278') #endif enddo enddo #ifdef ISOTRAC call iso_verif_traceur_vect(xt,klon,klev,'concvl 218') call iso_verif_trac_masse_vect(d_xt,klon,klev, & & 'concvl 464',errmax,errmaxrel) #endif #endif ! end verif #endif DO i = 1, klon cbmf(i) = Ma(i, kbas(i)) END DO !RL wght(:, :) = 0. DO i = 1, klon wght(i, 1) = 1. END DO !RL ELSE !LF necessary for gathered fields nloc = klon CALL cva_driver(klon, klev, klev+1, ntra, nloc, k_upper_cv, & iflag_con, iflag_mix, iflag_ice_thermo, & iflag_clos, ok_conserv_q, dtime, cvl_comp_threshold, & t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, tra, & em_p, em_ph, & Ale, Alp, omega, & em_sig1feed, em_sig2feed, em_wght, & iflag, d_t, d_q, d_u, d_v, d_tra, rain, kbas, ktop, & cbmf, plcl, plfc, wbeff, sig1, w01, ptop2, sigd, & Ma, mip, Vprecip, Vprecipi, upwd, dnwd, dnwdbis, qcondc, wd, & cape, cin, tvp, & dd_t, dd_q, plim1, plim2, asupmax, supmax0, & asupmaxmin, lalim_conv, & !AC!+!RomP+jyg !! da,phi,mp,phi2,d1a,dam,sij,clw,elij, & ! RomP !! evap,ep,epmlmMm,eplaMm, ! RomP da, phi, mp, phi2, d1a, dam, sij, wght, & ! RomP+RL clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP+RL wdtrainA, wdtrainM, qtc, sigt, & tau_cld_cv, coefw_cld_cv, & ! RomP,AJ !AC!+!RomP+jyg epmax_diag & ! epmax_cape #ifdef ISO & ,xt,xt_wake,d_xt, xtrain,dd_xt & & ,xtVprecip,xtVprecipi & #ifdef DIAGISO & , qlp,xtlp,qvp,xtvp,xtevap & & , xtclw & ! juste diagnostique & , wdtrain, xtwdtrain,tadiab & & , taux_cond_conv & & , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip & & , fxt_detrainement,fxt_ddft,fxt_fluxmasse & & , fxt_evapprecip,Mi,Amp_diag,tcond,mp & & , f_detrainement,q_detrainement,xt_detrainement & #endif #endif & ) END IF ! ------------------------------------------------------------------ IF (prt_level>=10) WRITE (lunout, *) ' cva_driver -> cbmf,plcl,plfc,wbeff ', & cbmf(1), plcl(1), plfc(1), wbeff(1) DO i = 1, klon rain(i) = rain(i)/86400. rflag(i) = iflag(i) #ifdef ISO do ixt = 1, ntraciso xtrain(ixt,i) = xtrain(ixt,i)/86400. enddo #endif END DO DO k = 1, klev DO i = 1, klon d_t(i, k) = dtime*d_t(i, k) d_q(i, k) = dtime*d_q(i, k) d_u(i, k) = dtime*d_u(i, k) d_v(i, k) = dtime*d_v(i, k) #ifdef ISO do ixt = 1, ntraciso d_xt(ixt,i,k) = dtime*d_xt(ixt,i,k) enddo #ifdef ISOVERIF if (iso_HDO.gt.0) then if (q(i,k).gt.ridicule) then call iso_verif_aberrant((xt(iso_HDO,i,k) & & +d_xt(iso_HDO,i,k))/(q(i,k)+d_q(i,k)),'concvl 250') endif !if (q_seri(i,k).gt.ridicule) then endif !if (iso_HDO.gt.0) then if (iso_eau.gt.0) then call iso_verif_egalite_choix(d_xt(iso_eau,i,k), & & d_q(i,k),'concvl 530',errmax*dtime,errmaxrel) endif !if (iso_HDO.gt.0) then #ifdef ISOTRAC call iso_verif_traceur_justmass(d_xt(1,i,k),'concvl 316') #endif #endif #endif END DO END DO #ifdef ISO if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then do k=1,klev do i=1,klon d_xt(iso_eau,i,k)=d_q(i,k) enddo !do i=1,klon enddo !do k=1,klev #ifdef ISOTRAC call iso_verif_traceur_jbid_vect(d_xt, & & klon,klev) #endif endif !if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then #endif IF (iflag_con==30) THEN DO itra = 1, ntra DO k = 1, klev DO i = 1, klon !RL! d_tra(i,k,itra) =dtime*d_tra(i,k,itra) d_tra(i, k, itra) = 0. END DO END DO END DO END IF !!AC! IF (iflag_con==3) THEN DO itra = 1, ntra DO k = 1, klev DO i = 1, klon !RL! d_tra(i,k,itra) =dtime*d_tra(i,k,itra) d_tra(i, k, itra) = 0. END DO END DO END DO END IF !!AC! DO k = 1, klev DO i = 1, klon t1(i, k) = t(i, k) + d_t(i, k) q1(i, k) = q(i, k) + d_q(i, k) #ifdef ISO do ixt=1,ntraciso xt1(ixt,i,k) = xt(ixt,i,k)+ d_xt(ixt,i,k) enddo #ifdef ISOVERIF do ixt=1,ntraciso call iso_verif_noNaN(xt1(ixt,i,k),'concvl 584') enddo !do ixt=1,ntraciso #endif #endif END DO END DO #ifdef ISO #ifdef ISOVERIF #ifdef ISOTRAC call iso_verif_traceur_vect(xt1,klon,klev,'concvl 583') #endif write(*,*) 'concvl 588: sortie de concvl' #endif #endif ! !jyg IF (iflag_con == 30 .OR. iflag_ice_thermo ==0) THEN ! --Separation neige/pluie (pour diagnostics) !jyg DO k = 1, klev !jyg DO i = 1, klon !jyg IF (t1(i,k): dd_t,dd_q ',dd_t(1,1),dd_q(1,1) DO k = 1, klev DO i = 1, klon dtvpdt1(i, k) = 0. dtvpdq1(i, k) = 0. END DO END DO DO i = 1, klon dplcldt(i) = 0. dplcldr(i) = 0. END DO IF (prt_level>=20) THEN DO k = 1, klev ! print*,'physiq apres_add_con i k it d_u d_v d_t d_q qdl0',igout, & ! k,itap,d_u_con(igout,k) ,d_v_con(igout,k), d_t_con(igout,k), & ! d_q_con(igout,k),dql0(igout,k) ! print*,'phys apres_add_con itap Ma cin ALE ALP wak t q undi t q', & ! itap,Ma(igout,k),cin(igout),ALE(igout), ALP(igout), & ! t_wake(igout,k),q_wake(igout,k),t_undi(igout,k),q_undi(igout,k) ! print*,'phy apres_add_con itap CON rain snow EMA wk1 wk2 Vpp mip', & ! itap,rain_con(igout),snow_con(igout),ema_work1(igout,k), & ! ema_work2(igout,k),Vprecip(igout,k), mip(igout,k) ! print*,'phy apres_add_con itap upwd dnwd dnwd0 cape tvp Tconv ', & ! itap,upwd(igout,k),dnwd(igout,k),dnwd0(igout,k),cape(igout), & ! tvp(igout,k),Tconv(igout,k) ! print*,'phy apres_add_con itap dtvpdt dtvdq dplcl dplcldr qcondc', & ! itap,dtvpdt1(igout,k),dtvpdq1(igout,k),dplcldt(igout), & ! dplcldr(igout),qcondc(igout,k) ! print*,'phy apres_add_con itap wd pmflxr Kpmflxr Kp1 Kpmflxs Kp1', & ! itap,wd(igout),pmflxr(igout,k),pmflxr(igout,k+1),pmflxs(igout,k), & ! pmflxs(igout,k+1) ! print*,'phy apres_add_con itap da phi mp ftd fqd lalim wgth', & ! itap,da(igout,k),phi(igout,k,k),mp(igout,k),ftd(igout,k), & ! fqd(igout,k),lalim_conv(igout),wght_th(igout,k) END DO END IF !(prt_level.EQ.20) THEN RETURN END SUBROUTINE concvl