Index: LMDZ5/trunk/libf/phylmd/concvl.F90 =================================================================== --- LMDZ5/trunk/libf/phylmd/concvl.F90 (revision 2252) +++ LMDZ5/trunk/libf/phylmd/concvl.F90 (revision 2253) @@ -214,4 +214,7 @@ include "FCTTRE.h" include "iniprint.h" +!jyg< + include "conema3.h" +!>jyg IF (first) THEN @@ -307,5 +310,8 @@ em_sig1feed = 1. - em_sig2feed = 0.97 +!jyg< +! em_sig2feed = 0.97 + em_sig2feed = cvl_sig2feed +!>jyg ! em_sig2feed = 0.8 ! Relative Weight densities @@ -401,5 +407,5 @@ CALL cva_driver(klon, klev, klev+1, ntra, nloc, & iflag_con, iflag_mix, iflag_ice_thermo, & - iflag_clos, ok_conserv_q, dtime, & + 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, & Index: LMDZ5/trunk/libf/phylmd/conema3.h =================================================================== --- LMDZ5/trunk/libf/phylmd/conema3.h (revision 2252) +++ LMDZ5/trunk/libf/phylmd/conema3.h (revision 2253) @@ -4,14 +4,21 @@ ! real epmax ! 0.993 +!jyg< + REAL cvl_comp_threshold ! 0. +!>jyg logical ok_adj_ema ! F integer iflag_clw ! 0 integer iflag_cvl_sigd - real sig1feed ! 1. - real sig2feed ! 0.95 + real cvl_sig2feed ! 0.97 - common/comconema1/epmax,ok_adj_ema,iflag_clw,sig1feed,sig2feed - common/comconema2/iflag_cvl_sigd +!jyg< +!! common/comconema1/epmax,ok_adj_ema,iflag_clw,sig1feed,sig2feed +!! common/comconema2/iflag_cvl_sigd + common/comconema1/epmax, cvl_comp_threshold, cvl_sig2feed + common/comconema2/iflag_cvl_sigd, iflag_clw, ok_adj_ema +!>jyg ! common/comconema/epmax,ok_adj_ema,iflag_clw !$OMP THREADPRIVATE(/comconema1/) !$OMP THREADPRIVATE(/comconema2/) + Index: LMDZ5/trunk/libf/phylmd/conf_phys_m.F90 =================================================================== --- LMDZ5/trunk/libf/phylmd/conf_phys_m.F90 (revision 2252) +++ LMDZ5/trunk/libf/phylmd/conf_phys_m.F90 (revision 2253) @@ -191,4 +191,6 @@ REAL,SAVE :: ecrit_LES_omp REAL,SAVE :: ecrit_tra_omp + REAL,SAVE :: cvl_comp_threshold_omp + REAL,SAVE :: cvl_sig2feed_omp REAL,SAVE :: cvl_corr_omp LOGICAL,SAVE :: ok_lic_melt_omp @@ -764,4 +766,20 @@ ! KE ! + + !Config key = cvl_comp_threshold + !Config Desc = maximum fraction of convective points enabling compression + !Config Def = 1.00 + !Config Help = fields are compressed when less than a fraction cvl_comp_threshold + !Config Help = of the points is convective. + cvl_comp_threshold_omp = 1.00 + CALL getin('cvl_comp_threshold', cvl_comp_threshold_omp) + + !Config key = cvl_sig2feed + !Config Desc = sigma coordinate at top of feeding layer + !Config Def = 0.97 + !Config Help = deep convection is fed by the layer extending from the surface (pressure ps) + !Config Help = and cvl_sig2feed*ps. + cvl_sig2feed_omp = 0.97 + CALL getin('cvl_sig2feed', cvl_sig2feed_omp) !Config key = cvl_corr @@ -2034,4 +2052,6 @@ ecrit_tra = ecrit_tra_omp ecrit_reg = ecrit_reg_omp + cvl_comp_threshold = cvl_comp_threshold_omp + cvl_sig2feed = cvl_sig2feed_omp cvl_corr = cvl_corr_omp ok_lic_melt = ok_lic_melt_omp @@ -2135,4 +2155,6 @@ write(lunout,*)' RN2O_per = ',RN2O_per,' RCFC11_per = ', RCFC11_per write(lunout,*)' RCFC12_per = ',RCFC12_per + write(lunout,*)' cvl_comp_threshold=', cvl_comp_threshold + write(lunout,*)' cvl_sig2feed=', cvl_sig2feed write(lunout,*)' cvl_corr=', cvl_corr write(lunout,*)'ok_lic_melt=', ok_lic_melt Index: LMDZ5/trunk/libf/phylmd/cv3_routines.F90 =================================================================== --- LMDZ5/trunk/libf/phylmd/cv3_routines.F90 (revision 2252) +++ LMDZ5/trunk/libf/phylmd/cv3_routines.F90 (revision 2253) @@ -264,23 +264,22 @@ !inputs: - INTEGER len, nd - LOGICAL ok_conserv_q - REAL t(len, nd), q(len, nd), p(len, nd) - REAL u(len, nd), v(len, nd) - REAL hm(len, nd), gz(len, nd) - REAL ph(len, nd+1) - REAL p1feed(len) -! , wght(len) - REAL wght(nd) + INTEGER, INTENT (IN) :: len, nd + LOGICAL, INTENT (IN) :: ok_conserv_q + REAL, DIMENSION (len, nd), INTENT (IN) :: t, q, p + REAL, DIMENSION (len, nd), INTENT (IN) :: u, v + REAL, DIMENSION (len, nd), INTENT (IN) :: hm, gz + REAL, DIMENSION (len, nd+1), INTENT (IN) :: ph + REAL, DIMENSION (len), INTENT (IN) :: p1feed + REAL, DIMENSION (nd), INTENT (IN) :: wght !input-output - REAL p2feed(len) + REAL, DIMENSION (len), INTENT (INOUT) :: p2feed !outputs: - INTEGER iflag(len), nk(len), icb(len), icbmax -! real wghti(len) - REAL wghti(len, nd) - REAL tnk(len), thnk(len), qnk(len), qsnk(len) - REAL unk(len), vnk(len) - REAL cpnk(len), hnk(len), gznk(len) - REAL plcl(len) + INTEGER, INTENT (OUT) :: icbmax + INTEGER, DIMENSION (len), INTENT (OUT) :: iflag, nk, icb + REAL, DIMENSION (len, nd), INTENT (OUT) :: wghti + REAL, DIMENSION (len), INTENT (OUT) :: tnk, thnk, qnk, qsnk + REAL, DIMENSION (len), INTENT (OUT) :: unk, vnk + REAL, DIMENSION (len), INTENT (OUT) :: cpnk, hnk, gznk + REAL, DIMENSION (len), INTENT (OUT) :: plcl !local variables: @@ -514,22 +513,23 @@ ! inputs: - INTEGER len, nd - INTEGER icb(len) - REAL t(len, nd), qs(len, nd), gz(len, nd) - REAL tnk(len), qnk(len), gznk(len) - REAL p(len, nd) - REAL plcl(len) ! convect3 + INTEGER, INTENT (IN) :: len, nd + INTEGER, DIMENSION (len), INTENT (IN) :: icb + REAL, DIMENSION (len, nd), INTENT (IN) :: t, qs, gz + REAL, DIMENSION (len), INTENT (IN) :: tnk, qnk, gznk + REAL, DIMENSION (len, nd), INTENT (IN) :: p + REAL, DIMENSION (len), INTENT (IN) :: plcl ! convect3 ! outputs: - REAL tp(len, nd), tvp(len, nd), clw(len, nd) + INTEGER, DIMENSION (len), INTENT (OUT) :: icbs + REAL, DIMENSION (len, nd), INTENT (OUT) :: tp, tvp, clw ! local variables: INTEGER i, k - INTEGER icb1(len), icbs(len), icbsmax2 ! convect3 + INTEGER icb1(len), icbsmax2 ! convect3 REAL tg, qg, alv, s, ahg, tc, denom, es, rg REAL ah0(len), cpp(len) REAL ticb(len), gzicb(len) - REAL qsicb(len) ! convect3 - REAL cpinv(len) ! convect3 + REAL qsicb(len) ! convect3 + REAL cpinv(len) ! convect3 ! ------------------------------------------------------------------- @@ -1051,21 +1051,24 @@ !inputs: - INTEGER ncum, nd, nloc, j - INTEGER icb(nloc), icbs(nloc), nk(nloc) - REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd), gz(nloc, nd) - REAL p(nloc, nd) - REAL tnk(nloc), qnk(nloc), gznk(nloc) - REAL hnk(nloc) - REAL lv(nloc, nd), lf(nloc, nd), tv(nloc, nd), h(nloc, nd) - REAL pbase(nloc), buoybase(nloc), plcl(nloc) + INTEGER, INTENT (IN) :: ncum, nd, nloc + INTEGER, DIMENSION (nloc), INTENT (IN) :: icb, icbs, nk + REAL, DIMENSION (nloc, nd), INTENT (IN) :: t, q, qs, gz + REAL, DIMENSION (nloc, nd), INTENT (IN) :: p + REAL, DIMENSION (nloc), INTENT (IN) :: tnk, qnk, gznk + REAL, DIMENSION (nloc), INTENT (IN) :: hnk + REAL, DIMENSION (nloc, nd), INTENT (IN) :: lv, lf, tv, h + REAL, DIMENSION (nloc), INTENT (IN) :: pbase, buoybase, plcl + +!input/outputs: + REAL, DIMENSION (nloc, nd), INTENT (INOUT) :: tp, tvp, clw ! Input for k = 1, icb+1 (computed in cv3_undilute1) + ! Output above !outputs: - INTEGER inb(nloc) - REAL tp(nloc, nd), tvp(nloc, nd), clw(nloc, nd) - REAL ep(nloc, nd), sigp(nloc, nd), hp(nloc, nd) - REAL buoy(nloc, nd) + INTEGER, DIMENSION (nloc), INTENT (OUT) :: inb + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: ep, sigp, hp + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: buoy !local variables: - INTEGER i, k + INTEGER i, j, k REAL tg, qg, ahg, alv, alf, s, tc, es, esi, denom, rg, tca, elacrit REAL als @@ -1084,6 +1087,4 @@ DO k = 1, nl DO i = 1, ncum - ep(i, k) = 0.0 - sigp(i, k) = spfac qi(i, k) = 0. END DO @@ -1187,5 +1188,7 @@ END IF END IF - END IF +!jyg< +!! END IF ! Endif moved to the end of the loop +!>jyg IF (cvflag_ice) THEN @@ -1258,5 +1261,7 @@ END IF END IF ! (cvflag_ice) - +!jyg< + END IF ! (k>=(icbs(i)+1)) +!>jyg END DO END DO @@ -1267,13 +1272,26 @@ ! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I) ! ===================================================================== - +! +!jyg< + DO k = 1, nl + DO i = 1, ncum + ep(i, k) = 0.0 + sigp(i, k) = spfac + END DO + END DO +!>jyg +! IF (flag_epkeorig/=1) THEN DO k = 1, nl ! convect3 DO i = 1, ncum - pden = ptcrit - pbcrit - ep(i, k) = (plcl(i)-p(i,k)-pbcrit)/pden*epmax - ep(i, k) = max(ep(i,k), 0.0) - ep(i, k) = min(ep(i,k), epmax) - sigp(i, k) = spfac +!jyg< + IF(k>=icb(i)) THEN +!>jyg + pden = ptcrit - pbcrit + ep(i, k) = (plcl(i)-p(i,k)-pbcrit)/pden*epmax + ep(i, k) = max(ep(i,k), 0.0) + ep(i, k) = min(ep(i,k), epmax) +!! sigp(i, k) = spfac ! jyg + ENDIF ! (k>=icb(i)) END DO END DO @@ -1281,5 +1299,7 @@ DO k = 1, nl DO i = 1, ncum - IF (k>=(nk(i)+1)) THEN + IF(k>=icb(i)) THEN +!! IF (k>=(nk(i)+1)) THEN +!>jyg tca = tp(i, k) - t0 IF (tca>=0.0) THEN @@ -1292,9 +1312,10 @@ ep(i, k) = max(ep(i,k), 0.0) ep(i, k) = min(ep(i,k), epmax) - sigp(i, k) = spfac - END IF +!! sigp(i, k) = spfac ! jyg + END IF ! (k>=icb(i)) END DO END DO END IF +! ! ===================================================================== ! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL @@ -1768,25 +1789,24 @@ !inputs: - INTEGER ncum, nd, na, ntra, nloc - INTEGER icb(nloc), inb(nloc), nk(nloc) - REAL sig(nloc, nd) - REAL qnk(nloc), unk(nloc), vnk(nloc) - REAL ph(nloc, nd+1) - REAL t(nloc, nd), rr(nloc, nd), rs(nloc, nd) - REAL u(nloc, nd), v(nloc, nd) - REAL tra(nloc, nd, ntra) ! input of convect3 - REAL lv(nloc, na), h(nloc, na), hp(nloc, na) - REAL lf(nloc, na), frac(nloc, na) - REAL tv(nloc, na), tvp(nloc, na), ep(nloc, na), clw(nloc, na) - REAL m(nloc, na) ! input of convect3 + INTEGER, INTENT (IN) :: ncum, nd, na, ntra, nloc + INTEGER, DIMENSION (nloc), INTENT (IN) :: icb, inb, nk + REAL, DIMENSION (nloc, nd), INTENT (IN) :: sig + REAL, DIMENSION (nloc), INTENT (IN) :: qnk, unk, vnk + REAL, DIMENSION (nloc, nd+1), INTENT (IN) :: ph + REAL, DIMENSION (nloc, nd), INTENT (IN) :: t, rr, rs + REAL, DIMENSION (nloc, nd), INTENT (IN) :: u, v + REAL, DIMENSION (nloc, nd, ntra), INTENT (IN) :: tra ! input of convect3 + REAL, DIMENSION (nloc, na), INTENT (IN) :: lv, h, hp + REAL, DIMENSION (nloc, na), INTENT (IN) :: lf, frac + REAL, DIMENSION (nloc, na), INTENT (IN) :: tv, tvp, ep, clw + REAL, DIMENSION (nloc, na), INTENT (IN) :: m ! input of convect3 !outputs: - REAL ment(nloc, na, na), qent(nloc, na, na) - REAL uent(nloc, na, na), vent(nloc, na, na) - REAL sij(nloc, na, na), elij(nloc, na, na) - REAL traent(nloc, nd, nd, ntra) - REAL ments(nloc, nd, nd), qents(nloc, nd, nd) - REAL sigij(nloc, nd, nd) - INTEGER nent(nloc, nd) + REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: ment, qent + REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: uent, vent + REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: sij, elij + REAL, DIMENSION (nloc, nd, nd, ntra), INTENT (OUT) :: traent + REAL, DIMENSION (nloc, nd, nd), INTENT (OUT) :: ments, qents + INTEGER, DIMENSION (nloc, nd), INTENT (OUT) :: nent !local variables: @@ -1797,4 +1817,5 @@ REAL asij(nloc), smax(nloc), scrit(nloc) REAL asum(nloc, nd), bsum(nloc, nd), csum(nloc, nd) + REAL sigij(nloc, nd, nd) REAL wgh REAL zm(nloc, na) @@ -3588,6 +3609,11 @@ ! *** reset counter and return *** +! Reset counter only for points actually convective (jyg) +! In order take into account the possibility of changing the compression, +! reset m, sig and w0 to zero for non-convecting points. DO il = 1, ncum - sig(il, nd) = 2.0 + IF (iflag(il) < 3) THEN + sig(il, nd) = 2.0 + ENDIF END DO Index: LMDZ5/trunk/libf/phylmd/cv3a_compress.F90 =================================================================== --- LMDZ5/trunk/libf/phylmd/cv3a_compress.F90 (revision 2252) +++ LMDZ5/trunk/libf/phylmd/cv3a_compress.F90 (revision 2253) @@ -1,11 +1,23 @@ -SUBROUTINE cv3a_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, & - plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, wghti1, pbase1, buoybase1, & - t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, u1, v1, gz1, th1, & - th1_wake, tra1, h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, & - h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, sig1, w01, ptop21, & - ale1, alp1, omega1, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, hnk, unk, vnk, & - wghti, pbase, buoybase, t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, & - gz, th, th_wake, tra, h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, h_wake, & - lv_wake, lf_wake, cpn_wake, tv_wake, sig, w0, ptop2, ale, alp, omega) +SUBROUTINE cv3a_compress(len, nloc, ncum, nd, ntra, compress, & + iflag1, nk1, icb1, icbs1, & + plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, & + wghti1, pbase1, buoybase1, & + t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, & + u1, v1, gz1, th1, th1_wake, & + tra1, & + h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, & + h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, & + sig1, w01, ptop21, & + Ale1, Alp1, omega1, & + iflag, nk, icb, icbs, & + plcl, tnk, qnk, gznk, hnk, unk, vnk, & + wghti, pbase, buoybase, & + t, q, qs, t_wake, q_wake, qs_wake, s_wake, & + u, v, gz, th, th_wake, & + tra, & + h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, & + h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, & + sig, w0, ptop2, & + Ale, Alp, omega) ! ************************************************************** ! * @@ -22,44 +34,58 @@ ! inputs: - INTEGER len, nloc, ncum, nd, ntra - INTEGER iflag1(len), nk1(len), icb1(len), icbs1(len) - REAL plcl1(len), tnk1(len), qnk1(len), gznk1(len) - REAL hnk1(len), unk1(len), vnk1(len) - REAL wghti1(len, nd), pbase1(len), buoybase1(len) - REAL t1(len, nd), q1(len, nd), qs1(len, nd) - REAL t1_wake(len, nd), q1_wake(len, nd), qs1_wake(len, nd) - REAL s1_wake(len) - REAL u1(len, nd), v1(len, nd) - REAL gz1(len, nd), th1(len, nd), th1_wake(len, nd) - REAL tra1(len, nd, ntra) - REAL h1(len, nd), lv1(len, nd), lf1(len, nd), cpn1(len, nd) - REAL p1(len, nd), ph1(len, nd+1), tv1(len, nd), tp1(len, nd) - REAL tvp1(len, nd), clw1(len, nd) - REAL h1_wake(len, nd), lv1_wake(len, nd), cpn1_wake(len, nd) - REAL tv1_wake(len, nd), lf1_wake(len, nd) - REAL sig1(len, nd), w01(len, nd), ptop21(len) - REAL ale1(len), alp1(len) - REAL omega1(len,nd) - + INTEGER, INTENT (IN) :: len, nloc, nd, ntra +!jyg< + LOGICAL, INTENT (IN) :: compress ! compression is performed if compress is true +!>jyg + INTEGER, DIMENSION (len), INTENT (IN) :: iflag1, nk1, icb1, icbs1 + REAL, DIMENSION (len), INTENT (IN) :: plcl1, tnk1, qnk1, gznk1 + REAL, DIMENSION (len), INTENT (IN) :: hnk1, unk1, vnk1 + REAL, DIMENSION (len, nd), INTENT (IN) :: wghti1(len, nd) + REAL, DIMENSION (len), INTENT (IN) :: pbase1, buoybase1 + REAL, DIMENSION (len, nd), INTENT (IN) :: t1, q1, qs1 + REAL, DIMENSION (len, nd), INTENT (IN) :: t1_wake, q1_wake, qs1_wake + REAL, DIMENSION (len), INTENT (IN) :: s1_wake + REAL, DIMENSION (len, nd), INTENT (IN) :: u1, v1 + REAL, DIMENSION (len, nd), INTENT (IN) :: gz1, th1, th1_wake + REAL, DIMENSION (len, nd,ntra), INTENT (IN) :: tra1 + REAL, DIMENSION (len, nd), INTENT (IN) :: h1, lv1, lf1, cpn1 + REAL, DIMENSION (len, nd), INTENT (IN) :: p1 + REAL, DIMENSION (len, nd+1), INTENT (IN) :: ph1(len, nd+1) + REAL, DIMENSION (len, nd), INTENT (IN) :: tv1, tp1 + REAL, DIMENSION (len, nd), INTENT (IN) :: tvp1, clw1 + REAL, DIMENSION (len, nd), INTENT (IN) :: h1_wake, lv1_wake, cpn1_wake + REAL, DIMENSION (len, nd), INTENT (IN) :: tv1_wake, lf1_wake + REAL, DIMENSION (len, nd), INTENT (IN) :: sig1, w01 + REAL, DIMENSION (len), INTENT (IN) :: ptop21 + REAL, DIMENSION (len), INTENT (IN) :: Ale1, Alp1 + REAL, DIMENSION (len, nd), INTENT (IN) :: omega1 +! + ! in/out + INTEGER, INTENT (INOUT) :: ncum +! ! outputs: ! en fait, on a nloc=len pour l'instant (cf cv_driver) - INTEGER iflag(len), nk(len), icb(len), icbs(len) - REAL plcl(len), tnk(len), qnk(len), gznk(len) - REAL hnk(len), unk(len), vnk(len) - REAL wghti(len, nd), pbase(len), buoybase(len) - REAL t(len, nd), q(len, nd), qs(len, nd) - REAL t_wake(len, nd), q_wake(len, nd), qs_wake(len, nd) - REAL s_wake(len) - REAL u(len, nd), v(len, nd) - REAL gz(len, nd), th(len, nd), th_wake(len, nd) - REAL tra(len, nd, ntra) - REAL h(len, nd), lv(len, nd), lf(len, nd), cpn(len, nd) - REAL p(len, nd), ph(len, nd+1), tv(len, nd), tp(len, nd) - REAL tvp(len, nd), clw(len, nd) - REAL h_wake(len, nd), lv_wake(len, nd), cpn_wake(len, nd) - REAL tv_wake(len, nd), lf_wake(len, nd) - REAL sig(len, nd), w0(len, nd), ptop2(len) - REAL ale(len), alp(len) - REAL omega(len,nd) + INTEGER, DIMENSION (nloc), INTENT (OUT) :: iflag, nk, icb, icbs + REAL, DIMENSION (nloc), INTENT (OUT) :: plcl, tnk, qnk, gznk + REAL, DIMENSION (nloc), INTENT (OUT) :: hnk, unk, vnk + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: wghti + REAL, DIMENSION (nloc), INTENT (OUT) :: pbase, buoybase + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: t, q, qs + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: t_wake, q_wake, qs_wake + REAL, DIMENSION (nloc), INTENT (OUT) :: s_wake + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: u, v + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: gz, th, th_wake + REAL, DIMENSION (nloc, nd,ntra), INTENT (OUT) :: tra + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: h, lv, lf, cpn + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: p + REAL, DIMENSION (nloc, nd+1), INTENT (OUT) :: ph + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tv, tp + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tvp, clw + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: h_wake, lv_wake, cpn_wake + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tv_wake, lf_wake + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: sig, w0 + REAL, DIMENSION (nloc), INTENT (OUT) :: ptop2 + REAL, DIMENSION (nloc), INTENT (OUT) :: Ale, Alp + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: omega ! local variables: @@ -69,4 +95,7 @@ CHARACTER (LEN=80) :: abort_message +!jyg< + IF (compress) THEN +!>jyg DO k = 1, nl + 1 @@ -108,5 +137,5 @@ END DO END DO - +! ! AC! do 121 j=1,ntra ! AC!ccccc do 111 k=1,nl+1 @@ -147,6 +176,6 @@ buoybase(nn) = buoybase1(i) ptop2(nn) = ptop2(i) - ale(nn) = ale1(i) - alp(nn) = alp1(i) + Ale(nn) = Ale1(i) + Alp(nn) = Alp1(i) END IF END DO @@ -157,4 +186,61 @@ CALL abort_gcm(modname, abort_message, 1) END IF +! +!jyg< + ELSE !(compress) +! + ncum = len +! + wghti(:,:) = wghti1(:,:) + t(:,:) = t1(:,:) + q(:,:) = q1(:,:) + qs(:,:) = qs1(:,:) + t_wake(:,:) = t1_wake(:,:) + q_wake(:,:) = q1_wake(:,:) + qs_wake(:,:) = qs1_wake(:,:) + u(:,:) = u1(:,:) + v(:,:) = v1(:,:) + gz(:,:) = gz1(:,:) + th(:,:) = th1(:,:) + th_wake(:,:) = th1_wake(:,:) + h(:,:) = h1(:,:) + lv(:,:) = lv1(:,:) + lf(:,:) = lf1(:,:) + cpn(:,:) = cpn1(:,:) + p(:,:) = p1(:,:) + ph(:,:) = ph1(:,:) + tv(:,:) = tv1(:,:) + tp(:,:) = tp1(:,:) + tvp(:,:) = tvp1(:,:) + clw(:,:) = clw1(:,:) + h_wake(:,:) = h1_wake(:,:) + lv_wake(:,:) = lv1_wake(:,:) + lf_wake(:,:) = lf1_wake(:,:) + cpn_wake(:,:) = cpn1_wake(:,:) + tv_wake(:,:) = tv1_wake(:,:) + sig(:,:) = sig1(:,:) + w0(:,:) = w01(:,:) + omega(:,:) = omega1(:,:) +! + s_wake(:) = s1_wake(:) + iflag(:) = iflag1(:) + nk(:) = nk1(:) + icb(:) = icb1(:) + icbs(:) = icbs1(:) + plcl(:) = plcl1(:) + tnk(:) = tnk1(:) + qnk(:) = qnk1(:) + gznk(:) = gznk1(:) + hnk(:) = hnk1(:) + unk(:) = unk1(:) + vnk(:) = vnk1(:) + pbase(:) = pbase1(:) + buoybase(:) = buoybase1(:) + ptop2(:) = ptop2(:) + Ale(:) = Ale1(:) + Alp(:) = Alp1(:) +! + ENDIF !(compress) +!>jyg RETURN Index: LMDZ5/trunk/libf/phylmd/cv3a_uncompress.F90 =================================================================== --- LMDZ5/trunk/libf/phylmd/cv3a_uncompress.F90 (revision 2252) +++ LMDZ5/trunk/libf/phylmd/cv3a_uncompress.F90 (revision 2253) @@ -1,19 +1,30 @@ -SUBROUTINE cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, kbas, & - ktop, precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, ft, fq, fu, fv, & - ftra, sigd, ma, mip, vprecip, upwd, dnwd, dnwd0, qcondc, wd, cape, cin, & - tvp, ftd, fqd, plim1, plim2, asupmax, supmax0, asupmaxmin & - , da, phi, mp, phi2, d1a, dam, sigij & ! RomP+AC+jyg - , clw, elij, evap, ep, epmlmmm, eplamm & ! RomP - , wdtraina, wdtrainm & ! RomP - , qtc, sigt & - - , iflag1, kbas1, ktop1, precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, & - ptop21, ft1, fq1, fu1, fv1, ftra1, sigd1, ma1, mip1, vprecip1, upwd1, & - dnwd1, dnwd01, qcondc1, wd1, cape1, cin1, tvp1, ftd1, fqd1, plim11, & - plim21, asupmax1, supmax01, asupmaxmin1 & - , da1, phi1, mp1, phi21, d1a1, dam1, sigij1 & ! RomP+AC+jyg - , clw1, elij1, evap1, ep1, epmlmmm1, eplamm1 & ! RomP - , wdtraina1, wdtrainm1 & ! RomP - , qtc1, sigt1) +SUBROUTINE cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, & + iflag, kbas, ktop, & + precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, & + ft, fq, fu, fv, ftra, & + sigd, ma, mip, vprecip, upwd, dnwd, dnwd0, & + qcondc, wd, cape, cin, & + tvp, & + ftd, fqd, & + plim1, plim2, asupmax, supmax0, & + asupmaxmin, & + da, phi, mp, phi2, d1a, dam, sigij, & ! RomP+AC+jyg + clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP + wdtrainA, wdtrainM, & ! RomP + qtc, sigt, & + + iflag1, kbas1, ktop1, & + precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, & + ft1, fq1, fu1, fv1, ftra1, & + sigd1, ma1, mip1, vprecip1, upwd1, dnwd1, dnwd01, & + qcondc1, wd1, cape1, cin1, & + tvp1, & + ftd1, fqd1, & + plim11, plim21, asupmax1, supmax01, & + asupmaxmin1, & + da1, phi1, mp1, phi21, d1a1, dam1, sigij1, & ! RomP+AC+jyg + clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP + wdtrainA1, wdtrainM1, & ! RomP + qtc1, sigt1) ! ************************************************************** @@ -31,161 +42,251 @@ ! inputs: - INTEGER nloc, len, ncum, nd, ntra - INTEGER idcum(nloc) - INTEGER iflag(nloc), kbas(nloc), ktop(nloc) - REAL precip(nloc), cbmf(nloc), plcl(nloc), plfc(nloc) - REAL wbeff(len) - REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc) - REAL ft(nloc, nd), fq(nloc, nd), fu(nloc, nd), fv(nloc, nd) - REAL ftra(nloc, nd, ntra) - REAL sigd(nloc) - REAL ma(nloc, nd), mip(nloc, nd), vprecip(nloc, nd+1) - REAL upwd(nloc, nd), dnwd(nloc, nd), dnwd0(nloc, nd) - REAL qcondc(nloc, nd) - REAL wd(nloc), cape(nloc), cin(nloc) - REAL tvp(nloc, nd) - REAL ftd(nloc, nd), fqd(nloc, nd) - REAL plim1(nloc), plim2(nloc) - REAL asupmax(nloc, nd), supmax0(nloc) - REAL asupmaxmin(nloc) - - REAL da(nloc, nd), phi(nloc, nd, nd) !AC! - REAL mp(nloc, nd) !RomP - REAL phi2(nloc, nd, nd) !RomP - REAL d1a(nloc, nd), dam(nloc, nd) !RomP - REAL sigij(nloc, nd, nd) !RomP - REAL clw(nloc, nd), elij(nloc, nd, nd) !RomP - REAL evap(nloc, nd), ep(nloc, nd) !RomP - REAL epmlmmm(nloc, nd, nd), eplamm(nloc, nd) !RomP+jyg - REAL qtc(nloc, nd), sigt(nloc, nd) !RomP - REAL wdtraina(nloc, nd), wdtrainm(nloc, nd) !RomP + INTEGER, INTENT (IN) :: nloc, len, ncum, nd, ntra + INTEGER, DIMENSION (nloc), INTENT (IN) :: idcum(nloc) +!jyg< + LOGICAL, INTENT (IN) :: compress +!>jyg + INTEGER, DIMENSION (nloc), INTENT (IN) ::iflag, kbas, ktop + REAL, DIMENSION (nloc), INTENT (IN) :: precip, cbmf, plcl, plfc + REAL, DIMENSION (nloc), INTENT (IN) :: wbeff + REAL, DIMENSION (nloc, nd), INTENT (IN) :: sig, w0 + REAL, DIMENSION (nloc), INTENT (IN) :: ptop2 + REAL, DIMENSION (nloc, nd), INTENT (IN) :: ft, fq, fu, fv + REAL, DIMENSION (nloc, nd, ntra), INTENT (IN) :: ftra + REAL, DIMENSION (nloc), INTENT (IN) :: sigd + REAL, DIMENSION (nloc, nd), INTENT (IN) :: ma, mip + REAL, DIMENSION (nloc, nd+1), INTENT (IN) :: vprecip + REAL, DIMENSION (nloc, nd), INTENT (IN) :: upwd, dnwd, dnwd0 + REAL, DIMENSION (nloc, nd), INTENT (IN) :: qcondc + REAL, DIMENSION (nloc), INTENT (IN) :: wd, cape, cin + REAL, DIMENSION (nloc, nd), INTENT (IN) :: tvp + REAL, DIMENSION (nloc, nd), INTENT (IN) :: ftd, fqd + REAL, DIMENSION (nloc), INTENT (IN) :: plim1, plim2 + REAL, DIMENSION (nloc, nd), INTENT (IN) :: asupmax + REAL, DIMENSION (nloc), INTENT (IN) :: supmax0, asupmaxmin + + REAL, DIMENSION (nloc, nd), INTENT (IN) :: da + REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: phi !AC! + REAL, DIMENSION (nloc, nd), INTENT (IN) :: mp !RomP + REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: phi2 !RomP + REAL, DIMENSION (nloc, nd), INTENT (IN) :: d1a, dam !RomP + REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: sigij !RomP + REAL, DIMENSION (nloc, nd), INTENT (IN) :: clw !RomP + REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: elij !RomP + REAL, DIMENSION (nloc, nd), INTENT (IN) :: evap, ep !RomP + REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: epmlmMm !RomP+jyg + REAL, DIMENSION (nloc, nd), INTENT (IN) :: eplamM !RomP+jyg + REAL, DIMENSION (nloc, nd), INTENT (IN) :: qtc, sigt !RomP + REAL, DIMENSION (nloc, nd), INTENT (IN) :: wdtrainA, wdtrainM !RomP ! outputs: - INTEGER iflag1(len), kbas1(len), ktop1(len) - REAL precip1(len), cbmf1(len), plcl1(nloc), plfc1(nloc) - REAL wbeff1(len) - REAL sig1(len, nd), w01(len, nd), ptop21(len) - REAL ft1(len, nd), fq1(len, nd), fu1(len, nd), fv1(len, nd) - REAL ftra1(len, nd, ntra) - REAL sigd1(len) - REAL ma1(len, nd), mip1(len, nd), vprecip1(len, nd+1) - REAL upwd1(len, nd), dnwd1(len, nd), dnwd01(len, nd) - REAL qcondc1(len, nd) - REAL wd1(len), cape1(len), cin1(len) - REAL tvp1(len, nd) - REAL ftd1(len, nd), fqd1(len, nd) - REAL plim11(len), plim21(len) - REAL asupmax1(len, nd), supmax01(len) - REAL asupmaxmin1(len) - - REAL da1(nloc, nd), phi1(nloc, nd, nd) !AC! - REAL mp1(nloc, nd) !RomP - REAL phi21(nloc, nd, nd) !RomP - REAL d1a1(nloc, nd), dam1(nloc, nd) !RomP - REAL sigij1(len, nd, nd) !RomP - REAL clw1(len, nd), elij1(len, nd, nd) !RomP - REAL evap1(len, nd), ep1(len, nd) !RomP - REAL epmlmmm1(len, nd, nd), eplamm1(len, nd) !RomP+jyg - REAL qtc1(len, nd), sigt1(len, nd) !RomP - REAL wdtraina1(len, nd), wdtrainm1(len, nd) !RomP + INTEGER, DIMENSION (len), INTENT (OUT) :: iflag1, kbas1, ktop1 + REAL, DIMENSION (len), INTENT (OUT) :: precip1, cbmf1, plcl1, plfc1 + REAL, DIMENSION (len), INTENT (OUT) :: wbeff1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: sig1, w01 + REAL, DIMENSION (len), INTENT (OUT) :: ptop21 + REAL, DIMENSION (len, nd), INTENT (OUT) :: ft1, fq1, fu1, fv1 + REAL, DIMENSION (len, nd, ntra), INTENT (OUT) :: ftra1 + REAL, DIMENSION (len), INTENT (OUT) :: sigd1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: ma1, mip1 + REAL, DIMENSION (len, nd+1), INTENT (OUT) :: vprecip1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: upwd1, dnwd1, dnwd01 + REAL, DIMENSION (len, nd), INTENT (OUT) :: qcondc1 + REAL, DIMENSION (len), INTENT (OUT) :: wd1, cape1, cin1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: tvp1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: ftd1, fqd1 + REAL, DIMENSION (len), INTENT (OUT) :: plim11, plim21 + REAL, DIMENSION (len, nd), INTENT (OUT) :: asupmax1 + REAL, DIMENSION (len), INTENT (OUT) :: supmax01, asupmaxmin1 + + REAL, DIMENSION (len, nd), INTENT (OUT) :: da1 + REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi1 !AC! + REAL, DIMENSION (len, nd), INTENT (OUT) :: mp1 !RomP + REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi21 !RomP + REAL, DIMENSION (len, nd), INTENT (OUT) :: d1a1, dam1 !RomP !RomP + REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: sigij1 !RomP + REAL, DIMENSION (len, nd), INTENT (OUT) :: clw1 !RomP + REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: elij1 !RomP + REAL, DIMENSION (len, nd), INTENT (OUT) :: evap1, ep1 !RomP + REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: epmlmMm1 !RomP+jyg + REAL, DIMENSION (len, nd), INTENT (OUT) :: eplamM1 !RomP+jyg + REAL, DIMENSION (len, nd), INTENT (OUT) :: qtc1, sigt1 !RomP + REAL, DIMENSION (len, nd), INTENT (OUT) :: wdtrainA1, wdtrainM1 !RomP ! local variables: INTEGER i, k, j + INTEGER jdcum ! c integer k1,k2 - DO i = 1, ncum - ptop21(idcum(i)) = ptop2(i) - sigd1(idcum(i)) = sigd(i) - precip1(idcum(i)) = precip(i) - cbmf1(idcum(i)) = cbmf(i) - plcl1(idcum(i)) = plcl(i) - plfc1(idcum(i)) = plfc(i) - wbeff1(idcum(i)) = wbeff(i) - iflag1(idcum(i)) = iflag(i) - kbas1(idcum(i)) = kbas(i) - ktop1(idcum(i)) = ktop(i) - wd1(idcum(i)) = wd(i) - cape1(idcum(i)) = cape(i) - cin1(idcum(i)) = cin(i) - plim11(idcum(i)) = plim1(i) - plim21(idcum(i)) = plim2(i) - supmax01(idcum(i)) = supmax0(i) - asupmaxmin1(idcum(i)) = asupmaxmin(i) - END DO - - DO k = 1, nd +!jyg< + IF (compress) THEN +!>jyg DO i = 1, ncum - sig1(idcum(i), k) = sig(i, k) - w01(idcum(i), k) = w0(i, k) - ft1(idcum(i), k) = ft(i, k) - fq1(idcum(i), k) = fq(i, k) - fu1(idcum(i), k) = fu(i, k) - fv1(idcum(i), k) = fv(i, k) - ma1(idcum(i), k) = ma(i, k) - mip1(idcum(i), k) = mip(i, k) - vprecip1(idcum(i), k) = vprecip(i, k) - upwd1(idcum(i), k) = upwd(i, k) - dnwd1(idcum(i), k) = dnwd(i, k) - dnwd01(idcum(i), k) = dnwd0(i, k) - qcondc1(idcum(i), k) = qcondc(i, k) - tvp1(idcum(i), k) = tvp(i, k) - ftd1(idcum(i), k) = ftd(i, k) - fqd1(idcum(i), k) = fqd(i, k) - asupmax1(idcum(i), k) = asupmax(i, k) - - da1(idcum(i), k) = da(i, k) !AC! - mp1(idcum(i), k) = mp(i, k) !RomP - d1a1(idcum(i), k) = d1a(i, k) !RomP - dam1(idcum(i), k) = dam(i, k) !RomP - clw1(idcum(i), k) = clw(i, k) !RomP - evap1(idcum(i), k) = evap(i, k) !RomP - ep1(idcum(i), k) = ep(i, k) !RomP - eplamm(idcum(i), k) = eplamm(i, k) !RomP+jyg - wdtraina1(idcum(i), k) = wdtraina(i, k) !RomP - wdtrainm1(idcum(i), k) = wdtrainm(i, k) !RomP - qtc1(idcum(i), k) = qtc(i, k) - sigt1(idcum(i), k) = sigt(i, k) - + ptop21(idcum(i)) = ptop2(i) + sigd1(idcum(i)) = sigd(i) + precip1(idcum(i)) = precip(i) + cbmf1(idcum(i)) = cbmf(i) + plcl1(idcum(i)) = plcl(i) + plfc1(idcum(i)) = plfc(i) + wbeff1(idcum(i)) = wbeff(i) + iflag1(idcum(i)) = iflag(i) + kbas1(idcum(i)) = kbas(i) + ktop1(idcum(i)) = ktop(i) + wd1(idcum(i)) = wd(i) + cape1(idcum(i)) = cape(i) + cin1(idcum(i)) = cin(i) + plim11(idcum(i)) = plim1(i) + plim21(idcum(i)) = plim2(i) + supmax01(idcum(i)) = supmax0(i) + asupmaxmin1(idcum(i)) = asupmaxmin(i) END DO - END DO - - DO i = 1, ncum - sig1(idcum(i), nd) = sig(i, nd) - END DO - - - ! AC! do 2100 j=1,ntra - ! AC!c oct3 do 2110 k=1,nl - ! AC! do 2110 k=1,nd ! oct3 - ! AC! do 2120 i=1,ncum - ! AC! ftra1(idcum(i),k,j)=ftra(i,k,j) - ! AC! 2120 continue - ! AC! 2110 continue - ! AC! 2100 continue - - ! AC! - DO j = 1, nd + DO k = 1, nd DO i = 1, ncum - phi1(idcum(i), k, j) = phi(i, k, j) !AC! - phi21(idcum(i), k, j) = phi2(i, k, j) !RomP - sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP - elij1(idcum(i), k, j) = elij(i, k, j) !RomP - epmlmmm(idcum(i), k, j) = epmlmmm(i, k, j) !RomP+jyg + sig1(idcum(i), k) = sig(i, k) + w01(idcum(i), k) = w0(i, k) + ft1(idcum(i), k) = ft(i, k) + fq1(idcum(i), k) = fq(i, k) + fu1(idcum(i), k) = fu(i, k) + fv1(idcum(i), k) = fv(i, k) + ma1(idcum(i), k) = ma(i, k) + mip1(idcum(i), k) = mip(i, k) + vprecip1(idcum(i), k) = vprecip(i, k) + upwd1(idcum(i), k) = upwd(i, k) + dnwd1(idcum(i), k) = dnwd(i, k) + dnwd01(idcum(i), k) = dnwd0(i, k) + qcondc1(idcum(i), k) = qcondc(i, k) + tvp1(idcum(i), k) = tvp(i, k) + ftd1(idcum(i), k) = ftd(i, k) + fqd1(idcum(i), k) = fqd(i, k) + asupmax1(idcum(i), k) = asupmax(i, k) + + da1(idcum(i), k) = da(i, k) !AC! + mp1(idcum(i), k) = mp(i, k) !RomP + d1a1(idcum(i), k) = d1a(i, k) !RomP + dam1(idcum(i), k) = dam(i, k) !RomP + clw1(idcum(i), k) = clw(i, k) !RomP + evap1(idcum(i), k) = evap(i, k) !RomP + ep1(idcum(i), k) = ep(i, k) !RomP + eplamM1(idcum(i), k) = eplamM(i, k) !RomP+jyg + wdtrainA1(idcum(i), k) = wdtrainA(i, k) !RomP + wdtrainM1(idcum(i), k) = wdtrainM(i, k) !RomP + qtc1(idcum(i), k) = qtc(i, k) + sigt1(idcum(i), k) = sigt(i, k) + END DO END DO - END DO - ! AC! - - - ! do 2220 k2=1,nd - ! do 2210 k1=1,nd - ! do 2200 i=1,ncum - ! ment1(idcum(i),k1,k2) = ment(i,k1,k2) - ! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2) - ! 2200 enddo - ! 2210 enddo - ! 2220 enddo + + DO i = 1, ncum + sig1(idcum(i), nd) = sig(i, nd) + END DO + + + ! AC! do 2100 j=1,ntra + ! AC!c oct3 do 2110 k=1,nl + ! AC! do 2110 k=1,nd ! oct3 + ! AC! do 2120 i=1,ncum + ! AC! ftra1(idcum(i),k,j)=ftra(i,k,j) + ! AC! 2120 continue + ! AC! 2110 continue + ! AC! 2100 continue + + ! AC! +!jyg< +! Essais pour gagner du temps en diminuant l'adressage indirect +!! DO j = 1, nd +!! DO k = 1, nd +!! DO i = 1, ncum +!! phi1(idcum(i), k, j) = phi(i, k, j) !AC! +!! phi21(idcum(i), k, j) = phi2(i, k, j) !RomP +!! sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP +!! elij1(idcum(i), k, j) = elij(i, k, j) !RomP +!! epmlmMm(idcum(i), k, j) = epmlmMm(i, k, j) !RomP+jyg +!! END DO +!! END DO +!! END DO + DO i = 1, ncum + jdcum=idcum(i) + phi1(jdcum,:,:) = phi(i,:,:) !AC! + phi21(jdcum,:,:) = phi2(i,:,:) !RomP + sigij1(jdcum,:,:) = sigij(i,:,:) !RomP + elij1(jdcum,:,:) = elij(i,:,:) !RomP + epmlmMm1(jdcum,:,:) = epmlmMm(i,:,:) !RomP+jyg + END DO +!>jyg + ! AC! + + + ! do 2220 k2=1,nd + ! do 2210 k1=1,nd + ! do 2200 i=1,ncum + ! ment1(idcum(i),k1,k2) = ment(i,k1,k2) + ! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2) + ! 2200 enddo + ! 2210 enddo + ! 2220 enddo +! +!jyg< + ELSE !(compress) +! + ptop21(:) = ptop2(:) + sigd1(:) = sigd(:) + precip1(:) = precip(:) + cbmf1(:) = cbmf(:) + plcl1(:) = plcl(:) + plfc1(:) = plfc(:) + wbeff1(:) = wbeff(:) + iflag1(:) = iflag(:) + kbas1(:) = kbas(:) + ktop1(:) = ktop(:) + wd1(:) = wd(:) + cape1(:) = cape(:) + cin1(:) = cin(:) + plim11(:) = plim1(:) + plim21(:) = plim2(:) + supmax01(:) = supmax0(:) + asupmaxmin1(:) = asupmaxmin(:) +! + sig1(:,:) = sig(:,:) + w01(:,:) = w0(:,:) + ft1(:,:) = ft(:,:) + fq1(:,:) = fq(:,:) + fu1(:,:) = fu(:,:) + fv1(:,:) = fv(:,:) + ma1(:,:) = ma(:,:) + mip1(:,:) = mip(:,:) + vprecip1(:,:) = vprecip(:,:) + upwd1(:,:) = upwd(:,:) + dnwd1(:,:) = dnwd(:,:) + dnwd01(:,:) = dnwd0(:,:) + qcondc1(:,:) = qcondc(:,:) + tvp1(:,:) = tvp(:,:) + ftd1(:,:) = ftd(:,:) + fqd1(:,:) = fqd(:,:) + asupmax1(:,:) = asupmax(:,:) + + da1(:,:) = da(:,:) !AC! + mp1(:,:) = mp(:,:) !RomP + d1a1(:,:) = d1a(:,:) !RomP + dam1(:,:) = dam(:,:) !RomP + clw1(:,:) = clw(:,:) !RomP + evap1(:,:) = evap(:,:) !RomP + ep1(:,:) = ep(:,:) !RomP + eplamM1(:,:) = eplamM(:,:) !RomP+jyg + wdtrainA1(:,:) = wdtrainA(:,:) !RomP + wdtrainM1(:,:) = wdtrainM(:,:) !RomP + qtc1(:,:) = qtc(:,:) + sigt1(:,:) = sigt(:,:) +! + sig1(:,:) = sig(:,:) +! + phi1(:,:,:) = phi(:,:,:) !AC! + phi21(:,:,:) = phi2(:,:,:) !RomP + sigij1(:,:,:) = sigij(:,:,:) !RomP + elij1(:,:,:) = elij(:,:,:) !RomP + epmlmMm1(:,:,:) = epmlmMm(:,:,:) !RomP+jyg + ENDIF !(compress) +!>jyg RETURN Index: LMDZ5/trunk/libf/phylmd/cv3p1_closure.F90 =================================================================== --- LMDZ5/trunk/libf/phylmd/cv3p1_closure.F90 (revision 2252) +++ LMDZ5/trunk/libf/phylmd/cv3p1_closure.F90 (revision 2253) @@ -29,26 +29,29 @@ ! input: - INTEGER ncum, nd, nloc - INTEGER icb(nloc), inb(nloc) - REAL pbase(nloc), plcl(nloc) - REAL p(nloc, nd), ph(nloc, nd+1) - REAL tv(nloc, nd), tvp(nloc, nd), buoy(nloc, nd) - REAL supmax(nloc, nd) - LOGICAL ok_inhib ! enable convection inhibition by dryness - REAL ale(nloc), alp(nloc) - REAL omega(nloc,nd) + INTEGER, INTENT (IN) :: ncum, nd, nloc + INTEGER, DIMENSION (nloc), INTENT (IN) :: icb, inb + REAL, DIMENSION (nloc), INTENT (IN) :: pbase, plcl + REAL, DIMENSION (nloc, nd), INTENT (IN) :: p + REAL, DIMENSION (nloc, nd+1), INTENT (IN) :: ph + REAL, DIMENSION (nloc, nd), INTENT (IN) :: tv, tvp, buoy + REAL, DIMENSION (nloc, nd), INTENT (IN) :: supmax + LOGICAL, INTENT (IN) :: ok_inhib ! enable convection inhibition by dryness + REAL, DIMENSION (nloc), INTENT (IN) :: ale, alp + REAL, DIMENSION (nloc, nd), INTENT (IN) :: omega ! input/output: - REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc) + REAL, DIMENSION (nloc, nd), INTENT (INOUT) :: sig, w0 + REAL, DIMENSION (nloc), INTENT (INOUT) :: ptop2 ! output: - REAL cape(nloc), cin(nloc) - REAL m(nloc, nd) - REAL plim1(nloc), plim2(nloc) - REAL asupmax(nloc, nd), supmax0(nloc) - REAL asupmaxmin(nloc) - REAL cbmf(nloc), plfc(nloc) - REAL wbeff(nloc) - INTEGER iflag(nloc) + REAL, DIMENSION (nloc), INTENT (OUT) :: cape, cin + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: m + REAL, DIMENSION (nloc), INTENT (OUT) :: plim1, plim2 + REAL, DIMENSION (nloc, nd), INTENT (OUT) :: asupmax + REAL, DIMENSION (nloc), INTENT (OUT) :: supmax0 + REAL, DIMENSION (nloc), INTENT (OUT) :: asupmaxmin + REAL, DIMENSION (nloc), INTENT (OUT) :: cbmf, plfc + REAL, DIMENSION (nloc), INTENT (OUT) :: wbeff + INTEGER, DIMENSION (nloc), INTENT (OUT) :: iflag ! local variables: @@ -91,5 +94,4 @@ - DO il = 1, ncum alp2(il) = max(alp(il), 1.E-5) @@ -498,9 +500,8 @@ IF (prt_level>=20) PRINT *, 'cv3p1_param apres cbmflim' - ! c 1.5 Compute cloud base mass flux given by Alp closure (Cbmf1), maximum - ! c allowed mass flux (Cbmfmax) and final target mass flux (Cbmf) - ! c Cbmf is set to zero if Cbmflim (the mass flux of elementary cloud) - ! is - ! -- exceedingly small. + ! 1.5 Compute cloud base mass flux given by Alp closure (Cbmf1), maximum + ! allowed mass flux (Cbmfmax) and final target mass flux (Cbmf) + ! Cbmf is set to zero if Cbmflim (the mass flux of elementary cloud) + ! is exceedingly small. DO il = 1, ncum Index: LMDZ5/trunk/libf/phylmd/cv3param.h =================================================================== --- LMDZ5/trunk/libf/phylmd/cv3param.h (revision 2252) +++ LMDZ5/trunk/libf/phylmd/cv3param.h (revision 2253) @@ -19,7 +19,5 @@ real betad - COMMON /cv3param/ noff, minorig, nl, nlp, nlm & - , sigdz, spfac & - ,flag_epKEorig & + COMMON /cv3param/ sigdz, spfac & ,pbcrit, ptcrit & ,elcrit, tlcrit & @@ -27,6 +25,9 @@ ,dtovsh, dpbase, dttrig & ,dtcrit, tau, beta, alpha, alpha1 & - ,flag_wb,wbmax & - ,delta, betad + ,wbmax & + ,delta, betad & + ,flag_epKEorig & + ,flag_wb & + ,noff, minorig, nl, nlp, nlm !$OMP THREADPRIVATE(/cv3param/) Index: LMDZ5/trunk/libf/phylmd/cva_driver.F90 =================================================================== --- LMDZ5/trunk/libf/phylmd/cva_driver.F90 (revision 2252) +++ LMDZ5/trunk/libf/phylmd/cva_driver.F90 (revision 2253) @@ -4,5 +4,7 @@ SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, & iflag_con, iflag_mix, iflag_ice_thermo, iflag_clos, ok_conserv_q, & - delt, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, & +!! delt, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, & ! jyg + delt, comp_threshold, & ! jyg + t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, & ! jyg u1, v1, tra1, & p1, ph1, & @@ -19,5 +21,5 @@ ftd1, fqd1, & Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, & - lalim_conv, & + lalim_conv1, & !! da1,phi1,mp1,phi21,d1a1,dam1,sigij1,clw1, & ! RomP !! elij1,evap1,ep1,epmlmMm1,eplaMm1, & ! RomP @@ -60,4 +62,6 @@ ! ok_conserv_q Logical Input when true corrections for water conservation are swtiched on ! delt Real Input time step +! comp_threshold Real Input threshold on the fraction of convective points below which +! fields are compressed ! t1 Real Input temperature (sat draught envt) ! q1 Real Input specific hum (sat draught envt) @@ -156,67 +160,70 @@ include 'iniprint.h' - ! Input - INTEGER len - INTEGER nd - INTEGER ndp1 - INTEGER ntra - INTEGER iflag_con - INTEGER iflag_mix - INTEGER iflag_ice_thermo - INTEGER iflag_clos - LOGICAL ok_conserv_q - REAL tau_cld_cv - REAL coefw_cld_cv - REAL delt - REAL t1(len, nd) - REAL q1(len, nd) - REAL qs1(len, nd) - REAL t1_wake(len, nd) - REAL q1_wake(len, nd) - REAL qs1_wake(len, nd) - REAL s1_wake(len) - REAL u1(len, nd) - REAL v1(len, nd) - REAL tra1(len, nd, ntra) - REAL p1(len, nd) - REAL ph1(len, ndp1) - REAL Ale1(len) - REAL Alp1(len) - REAL omega1(len,nd) - REAL sig1feed1 ! pressure at lower bound of feeding layer - REAL sig2feed1 ! pressure at upper bound of feeding layer - REAL wght1(nd) ! weight density determining the feeding mixture + INTEGER, INTENT (IN) :: len + INTEGER, INTENT (IN) :: nd + INTEGER, INTENT (IN) :: ndp1 + INTEGER, INTENT (IN) :: ntra + INTEGER, INTENT (IN) :: iflag_con + INTEGER, INTENT (IN) :: iflag_mix + INTEGER, INTENT (IN) :: iflag_ice_thermo + INTEGER, INTENT (IN) :: iflag_clos + LOGICAL, INTENT (IN) :: ok_conserv_q + REAL, INTENT (IN) :: tau_cld_cv + REAL, INTENT (IN) :: coefw_cld_cv + REAL, INTENT (IN) :: delt + REAL, INTENT (IN) :: comp_threshold + REAL, DIMENSION (len, nd), INTENT (IN) :: t1 + REAL, DIMENSION (len, nd), INTENT (IN) :: q1 + REAL, DIMENSION (len, nd), INTENT (IN) :: qs1 + REAL, DIMENSION (len, nd), INTENT (IN) :: t1_wake + REAL, DIMENSION (len, nd), INTENT (IN) :: q1_wake + REAL, DIMENSION (len, nd), INTENT (IN) :: qs1_wake + REAL, DIMENSION (len), INTENT (IN) :: s1_wake + REAL, DIMENSION (len, nd), INTENT (IN) :: u1 + REAL, DIMENSION (len, nd), INTENT (IN) :: v1 + REAL, DIMENSION (len, nd, ntra), INTENT (IN) :: tra1 + REAL, DIMENSION (len, nd), INTENT (IN) :: p1 + REAL, DIMENSION (len, ndp1), INTENT (IN) :: ph1 + REAL, DIMENSION (len), INTENT (IN) :: Ale1 + REAL, DIMENSION (len), INTENT (IN) :: Alp1 + REAL, DIMENSION (len, nd), INTENT (IN) :: omega1 + REAL, INTENT (IN) :: sig1feed1 ! pressure at lower bound of feeding layer + REAL, INTENT (IN) :: sig2feed1 ! pressure at upper bound of feeding layer + REAL, DIMENSION (nd), INTENT (IN) :: wght1 ! weight density determining the feeding mixture + INTEGER, DIMENSION (len), INTENT (IN) :: lalim_conv1 + +! Input/Output + REAL, DIMENSION (len, nd), INTENT (INOUT) :: sig1 + REAL, DIMENSION (len, nd), INTENT (INOUT) :: w01 ! Output - INTEGER iflag1(len) - REAL ft1(len, nd) - REAL fq1(len, nd) - REAL fu1(len, nd) - REAL fv1(len, nd) - REAL ftra1(len, nd, ntra) - REAL precip1(len) - INTEGER kbas1(len) - INTEGER ktop1(len) - REAL cbmf1(len) - REAL plcl1(klon) - REAL plfc1(klon) - REAL wbeff1(klon) - REAL sig1(len, klev) !input/output - REAL w01(len, klev) !input/output - REAL ptop21(len) - REAL sigd1(len) - REAL ma1(len, nd) - REAL mip1(len, nd) + INTEGER, DIMENSION (len), INTENT (OUT) :: iflag1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: ft1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: fq1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: fu1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: fv1 + REAL, DIMENSION (len, nd, ntra), INTENT (OUT) :: ftra1 + REAL, DIMENSION (len), INTENT (OUT) :: precip1 + INTEGER, DIMENSION (len), INTENT (OUT) :: kbas1 + INTEGER, DIMENSION (len), INTENT (OUT) :: ktop1 + REAL, DIMENSION (len), INTENT (OUT) :: cbmf1 + REAL, DIMENSION (len), INTENT (OUT) :: plcl1 + REAL, DIMENSION (len), INTENT (OUT) :: plfc1 + REAL, DIMENSION (len), INTENT (OUT) :: wbeff1 + REAL, DIMENSION (len), INTENT (OUT) :: ptop21 + REAL, DIMENSION (len), INTENT (OUT) :: sigd1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: ma1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: mip1 ! real Vprecip1(len,nd) - REAL vprecip1(len, nd+1) - REAL upwd1(len, nd) - REAL dnwd1(len, nd) - REAL dnwd01(len, nd) - REAL qcondc1(len, nd) ! cld - REAL wd1(len) ! gust - REAL cape1(len) - REAL cin1(len) - REAL tvp1(len, nd) + REAL, DIMENSION (len, ndp1), INTENT (OUT) :: vprecip1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: upwd1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: dnwd1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: dnwd01 + REAL, DIMENSION (len, nd), INTENT (OUT) :: qcondc1 ! cld + REAL, DIMENSION (len), INTENT (OUT) :: wd1 ! gust + REAL, DIMENSION (len), INTENT (OUT) :: cape1 + REAL, DIMENSION (len), INTENT (OUT) :: cin1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: tvp1 !AC! @@ -224,26 +231,27 @@ !! real da(len,nd),phi(len,nd,nd) !AC! - REAL ftd1(len, nd) - REAL fqd1(len, nd) - REAL Plim11(len) - REAL Plim21(len) - REAL asupmax1(len, nd) - REAL supmax01(len) - REAL asupmaxmin1(len) - INTEGER lalim_conv(len) - REAL qtc1(len, nd) ! cld - REAL sigt1(len, nd) ! cld + REAL, DIMENSION (len, nd), INTENT (OUT) :: ftd1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: fqd1 + REAL, DIMENSION (len), INTENT (OUT) :: Plim11 + REAL, DIMENSION (len), INTENT (OUT) :: Plim21 + REAL, DIMENSION (len, nd), INTENT (OUT) :: asupmax1 + REAL, DIMENSION (len), INTENT (OUT) :: supmax01 + REAL, DIMENSION (len), INTENT (OUT) :: asupmaxmin1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: qtc1 ! cld + REAL, DIMENSION (len, nd), INTENT (OUT) :: sigt1 ! cld ! RomP >>> - REAL wdtrainA1(len, nd), wdtrainM1(len, nd) - REAL da1(len, nd), phi1(len, nd, nd), mp1(len, nd) - REAL epmlmMm1(len, nd, nd), eplaMm1(len, nd) - REAL evap1(len, nd), ep1(len, nd) - REAL sigij1(len, nd, nd), elij1(len, nd, nd) + REAL, DIMENSION (len, nd), INTENT (OUT) :: wdtrainA1, wdtrainM1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: da1, mp1 + REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi1 + REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: epmlmMm1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: eplaMm1 + REAL, DIMENSION (len, nd), INTENT (OUT) :: evap1, ep1 + REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: sigij1, elij1 !JYG,RL - REAL wghti1(len, nd) ! final weight of the feeding layers + REAL, DIMENSION (len, nd), INTENT (OUT) :: wghti1 ! final weight of the feeding layers !JYG,RL - REAL phi21(len, nd, nd) - REAL d1a1(len, nd), dam1(len, nd) + REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi21 + REAL, DIMENSION (len, nd), INTENT (OUT) :: d1a1, dam1 ! RomP <<< @@ -388,4 +396,5 @@ !$OMP THREADPRIVATE(debut) + REAL coef_convective(len) ! = 1 for convective points, = 0 otherwise REAL tnk1(klon) REAL thnk1(klon) @@ -430,4 +439,7 @@ INTEGER idcum(nloc) +!jyg< + LOGICAL compress ! True if compression occurs +!>jyg INTEGER iflag(nloc), nk(nloc), icb(nloc) INTEGER nent(nloc, klev) @@ -682,5 +694,5 @@ ! p2feed1(i)=ph1(i,3) !testCR: on prend la couche alim des thermiques -! p2feed1(i)=ph1(i,lalim_conv(i)+1) +! p2feed1(i)=ph1(i,lalim_conv1(i)+1) ! print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2) END DO @@ -762,7 +774,12 @@ ! ===================================================================== +! Determine the number "ncum" of convective gridpoints, the list "idcum" of convective +! gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0. +! elsewhere). ncum = 0 + coef_convective(:) = 0. DO i = 1, len IF (iflag1(i)==0) THEN + coef_convective(i) = 1. ncum = ncum + 1 idcum(ncum) = i @@ -782,5 +799,19 @@ ! print*,'ncum tv1 ',ncum,tv1 ! print*,'tvp1 ',tvp1 - CALL cv3a_compress(len, nloc, ncum, nd, ntra, & +!jyg< +! If the fraction of convective points is larger than comp_threshold, then compression +! is assumed useless. +! + compress = ncum .lt. len*comp_threshold +! + IF (.not. compress) THEN + DO i = 1,len + idcum(i) = i + ENDDO + ENDIF +! + print *,' ncum, len, comp_threshold, compress ',ncum, len, comp_threshold, compress +!>jyg + CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, & iflag1, nk1, icb1, icbs1, & plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, & @@ -837,5 +868,4 @@ inb, tp, tvp, clw, hp, ep, sigp, buoy, & frac) - END IF @@ -897,5 +927,4 @@ Plim1, plim2, asupmax, supmax0, & asupmaxmin, cbmf, plfc, wbeff) - if (prt_level >= 10) & PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1) @@ -1035,5 +1064,5 @@ IF (iflag_con==3) THEN - CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, & + CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, & iflag, icb, inb, & precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, & @@ -1078,4 +1107,12 @@ END IF ! ncum>0 +! +! In order take into account the possibility of changing the compression, +! reset m, sig and w0 to zero for non-convective points. + DO k = 1,nd-1 + sig1(:, k) = sig1(:, k)*coef_convective(:) + w01(:, k) = w01(:, k)*coef_convective(:) + ENDDO + IF (debut) THEN PRINT *, ' cv_compress -> ' Index: LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90 =================================================================== --- LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90 (revision 2252) +++ LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90 (revision 2253) @@ -723,9 +723,10 @@ CALL histwrite_phy(o_dqwak, zx_tmp_fi3d) ENDIF ! iflag_wake>=1 - CALL histwrite_phy(o_Vprecip, Vprecip) CALL histwrite_phy(o_ftd, ftd) CALL histwrite_phy(o_fqd, fqd) - ELSEIF (iflag_con.EQ.30) THEN + ENDIF !(iflag_con.EQ.3) + IF (iflag_con.EQ.3.OR.iflag_con.EQ.30) THEN ! sortie RomP convection descente insaturee iflag_con=30 + ! etendue a iflag_con=3 (jyg) CALL histwrite_phy(o_Vprecip, Vprecip) CALL histwrite_phy(o_wdtrainA, wdtrainA)