Changeset 2253 for LMDZ5/trunk


Ignore:
Timestamp:
Mar 30, 2015, 11:08:45 AM (10 years ago)
Author:
jyg
Message:

1/ Introduction of two variables in the ".def" files: (i) cvl_sig2feed is
the top of the convective feeding layer in sigma coordinates (D=0.97);
(ii) cvl_comp_threshold is the threshold fraction of convective points
below which compression occurs (D=1.).
2/ Corrections of various bugs revealed by the changes in compression:

  • correct bugs in cv3a_uncompress.F90 for 3 fields used for convective

scavenging.

  • add a reset to zero of "sig" and "w0" for non-convective points

(cva_driver.F90).

  • in cv3_routines.F90, correct bounds of a few loops in cv3_undilute2,

correct the reset of the no-convection counter in cv3_yield.

  • in phys_output_write_mod.F90, correct output of wdtrainA and wdtrainM.

3/ Improve declarations in various subroutines.

Modified files:

conema3.h
cv3param.h
cv3p1_closure.F90
conf_phys_m.F90
cv3a_compress.F90
phys_output_write_mod.F90
cv3_routines.F90
concvl.F90
cva_driver.F90
cv3a_uncompress.F90

Location:
LMDZ5/trunk/libf/phylmd
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/concvl.F90

    r2205 r2253  
    214214  include "FCTTRE.h"
    215215  include "iniprint.h"
     216!jyg<
     217  include "conema3.h"
     218!>jyg
    216219
    217220  IF (first) THEN
    … …  
    307310
    308311  em_sig1feed = 1.
    309   em_sig2feed = 0.97
     312!jyg<
     313!  em_sig2feed = 0.97
     314  em_sig2feed = cvl_sig2feed
     315!>jyg
    310316! em_sig2feed = 0.8
    311317! Relative Weight densities
    … …  
    401407    CALL cva_driver(klon, klev, klev+1, ntra, nloc, &
    402408                    iflag_con, iflag_mix, iflag_ice_thermo, &
    403                     iflag_clos, ok_conserv_q, dtime, &
     409                    iflag_clos, ok_conserv_q, dtime, cvl_comp_threshold, &
    404410                    t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, tra, &
    405411                    em_p, em_ph, &

  • LMDZ5/trunk/libf/phylmd/conema3.h

    r1907 r2253  
    44!
    55      real epmax             ! 0.993
     6!jyg<
     7      REAL  cvl_comp_threshold     ! 0.
     8!>jyg
    69      logical ok_adj_ema      ! F
    710      integer iflag_clw      ! 0
    811      integer iflag_cvl_sigd
    9       real sig1feed      ! 1.
    10       real sig2feed      ! 0.95
     12      real cvl_sig2feed      ! 0.97
    1113
    12       common/comconema1/epmax,ok_adj_ema,iflag_clw,sig1feed,sig2feed
    13       common/comconema2/iflag_cvl_sigd
     14!jyg<
     15!!      common/comconema1/epmax,ok_adj_ema,iflag_clw,sig1feed,sig2feed
     16!!      common/comconema2/iflag_cvl_sigd
     17      common/comconema1/epmax, cvl_comp_threshold, cvl_sig2feed
     18      common/comconema2/iflag_cvl_sigd, iflag_clw, ok_adj_ema
     19!>jyg
    1420
    1521!      common/comconema/epmax,ok_adj_ema,iflag_clw
    1622!$OMP THREADPRIVATE(/comconema1/)
    1723!$OMP THREADPRIVATE(/comconema2/)
     24

  • LMDZ5/trunk/libf/phylmd/conf_phys_m.F90

    r2243 r2253  
    191191    REAL,SAVE :: ecrit_LES_omp
    192192    REAL,SAVE :: ecrit_tra_omp
     193    REAL,SAVE :: cvl_comp_threshold_omp
     194    REAL,SAVE :: cvl_sig2feed_omp
    193195    REAL,SAVE :: cvl_corr_omp
    194196    LOGICAL,SAVE :: ok_lic_melt_omp
    … …  
    764766    ! KE
    765767    !
     768
     769    !Config key  = cvl_comp_threshold
     770    !Config Desc = maximum fraction of convective points enabling compression
     771    !Config Def  = 1.00
     772    !Config Help = fields are compressed when less than a fraction cvl_comp_threshold
     773    !Config Help = of the points is convective.
     774    cvl_comp_threshold_omp = 1.00
     775    CALL getin('cvl_comp_threshold', cvl_comp_threshold_omp)
     776
     777    !Config key  = cvl_sig2feed
     778    !Config Desc = sigma coordinate at top of feeding layer
     779    !Config Def  = 0.97
     780    !Config Help = deep convection is fed by the layer extending from the surface (pressure ps)
     781    !Config Help = and cvl_sig2feed*ps.
     782    cvl_sig2feed_omp = 0.97
     783    CALL getin('cvl_sig2feed', cvl_sig2feed_omp)
    766784
    767785    !Config key  = cvl_corr
    … …  
    20342052    ecrit_tra = ecrit_tra_omp
    20352053    ecrit_reg = ecrit_reg_omp
     2054    cvl_comp_threshold = cvl_comp_threshold_omp
     2055    cvl_sig2feed = cvl_sig2feed_omp
    20362056    cvl_corr = cvl_corr_omp
    20372057    ok_lic_melt = ok_lic_melt_omp
    … …  
    21352155    write(lunout,*)' RN2O_per = ',RN2O_per,' RCFC11_per = ', RCFC11_per
    21362156    write(lunout,*)' RCFC12_per = ',RCFC12_per
     2157    write(lunout,*)' cvl_comp_threshold=', cvl_comp_threshold
     2158    write(lunout,*)' cvl_sig2feed=', cvl_sig2feed
    21372159    write(lunout,*)' cvl_corr=', cvl_corr
    21382160    write(lunout,*)'ok_lic_melt=', ok_lic_melt

  • LMDZ5/trunk/libf/phylmd/cv3_routines.F90

    r2208 r2253  
    264264
    265265!inputs:
    266   INTEGER len, nd
    267   LOGICAL ok_conserv_q
    268   REAL t(len, nd), q(len, nd), p(len, nd)
    269   REAL u(len, nd), v(len, nd)
    270   REAL hm(len, nd), gz(len, nd)
    271   REAL ph(len, nd+1)
    272   REAL p1feed(len)
    273 ! ,  wght(len)
    274   REAL wght(nd)
     266  INTEGER, INTENT (IN)                               :: len, nd
     267  LOGICAL, INTENT (IN)                               :: ok_conserv_q
     268  REAL, DIMENSION (len, nd), INTENT (IN)             :: t, q, p
     269  REAL, DIMENSION (len, nd), INTENT (IN)             :: u, v
     270  REAL, DIMENSION (len, nd), INTENT (IN)             :: hm, gz
     271  REAL, DIMENSION (len, nd+1), INTENT (IN)           :: ph
     272  REAL, DIMENSION (len), INTENT (IN)                 :: p1feed
     273  REAL, DIMENSION (nd), INTENT (IN)                  :: wght
    275274!input-output
    276   REAL p2feed(len)
     275  REAL, DIMENSION (len), INTENT (INOUT)              :: p2feed
    277276!outputs:
    278   INTEGER iflag(len), nk(len), icb(len), icbmax
    279 !   real   wghti(len)
    280   REAL wghti(len, nd)
    281   REAL tnk(len), thnk(len), qnk(len), qsnk(len)
    282   REAL unk(len), vnk(len)
    283   REAL cpnk(len), hnk(len), gznk(len)
    284   REAL plcl(len)
     277  INTEGER, INTENT (OUT)                              :: icbmax
     278  INTEGER, DIMENSION (len), INTENT (OUT)             :: iflag, nk, icb
     279  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wghti
     280  REAL, DIMENSION (len), INTENT (OUT)                :: tnk, thnk, qnk, qsnk
     281  REAL, DIMENSION (len), INTENT (OUT)                :: unk, vnk
     282  REAL, DIMENSION (len), INTENT (OUT)                :: cpnk, hnk, gznk
     283  REAL, DIMENSION (len), INTENT (OUT)                :: plcl
    285284
    286285!local variables:
    … …  
    514513
    515514! inputs:
    516   INTEGER len, nd
    517   INTEGER icb(len)
    518   REAL t(len, nd), qs(len, nd), gz(len, nd)
    519   REAL tnk(len), qnk(len), gznk(len)
    520   REAL p(len, nd)
    521   REAL plcl(len) ! convect3
     515  INTEGER, INTENT (IN)                              :: len, nd
     516  INTEGER, DIMENSION (len), INTENT (IN)             :: icb
     517  REAL, DIMENSION (len, nd), INTENT (IN)            :: t, qs, gz
     518  REAL, DIMENSION (len), INTENT (IN)                :: tnk, qnk, gznk
     519  REAL, DIMENSION (len, nd), INTENT (IN)            :: p
     520  REAL, DIMENSION (len), INTENT (IN)                :: plcl              ! convect3
    522521
    523522! outputs:
    524   REAL tp(len, nd), tvp(len, nd), clw(len, nd)
     523  INTEGER, DIMENSION (len), INTENT (OUT)            :: icbs
     524  REAL, DIMENSION (len, nd), INTENT (OUT)           :: tp, tvp, clw
    525525
    526526! local variables:
    527527  INTEGER i, k
    528   INTEGER icb1(len), icbs(len), icbsmax2 ! convect3
     528  INTEGER icb1(len), icbsmax2                                            ! convect3
    529529  REAL tg, qg, alv, s, ahg, tc, denom, es, rg
    530530  REAL ah0(len), cpp(len)
    531531  REAL ticb(len), gzicb(len)
    532   REAL qsicb(len) ! convect3
    533   REAL cpinv(len) ! convect3
     532  REAL qsicb(len)                                                        ! convect3
     533  REAL cpinv(len)                                                        ! convect3
    534534
    535535! -------------------------------------------------------------------
    … …  
    10511051
    10521052!inputs:
    1053   INTEGER ncum, nd, nloc, j
    1054   INTEGER icb(nloc), icbs(nloc), nk(nloc)
    1055   REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd), gz(nloc, nd)
    1056   REAL p(nloc, nd)
    1057   REAL tnk(nloc), qnk(nloc), gznk(nloc)
    1058   REAL hnk(nloc)
    1059   REAL lv(nloc, nd), lf(nloc, nd), tv(nloc, nd), h(nloc, nd)
    1060   REAL pbase(nloc), buoybase(nloc), plcl(nloc)
     1053  INTEGER, INTENT (IN)                               :: ncum, nd, nloc
     1054  INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, icbs, nk
     1055  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: t, q, qs, gz
     1056  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: p
     1057  REAL, DIMENSION (nloc), INTENT (IN)                :: tnk, qnk, gznk
     1058  REAL, DIMENSION (nloc), INTENT (IN)                :: hnk
     1059  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: lv, lf, tv, h
     1060  REAL, DIMENSION (nloc), INTENT (IN)                :: pbase, buoybase, plcl
     1061
     1062!input/outputs:
     1063  REAL, DIMENSION (nloc, nd), INTENT (INOUT)         :: tp, tvp, clw   ! Input for k = 1, icb+1 (computed in cv3_undilute1)
     1064                                                                       ! Output above
    10611065
    10621066!outputs:
    1063   INTEGER inb(nloc)
    1064   REAL tp(nloc, nd), tvp(nloc, nd), clw(nloc, nd)
    1065   REAL ep(nloc, nd), sigp(nloc, nd), hp(nloc, nd)
    1066   REAL buoy(nloc, nd)
     1067  INTEGER, DIMENSION (nloc), INTENT (OUT)            :: inb
     1068  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: ep, sigp, hp
     1069  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: buoy
    10671070
    10681071!local variables:
    1069   INTEGER i, k
     1072  INTEGER i, j, k
    10701073  REAL tg, qg, ahg, alv, alf, s, tc, es, esi, denom, rg, tca, elacrit
    10711074  REAL als
    … …  
    10841087  DO k = 1, nl
    10851088    DO i = 1, ncum
    1086       ep(i, k) = 0.0
    1087       sigp(i, k) = spfac
    10881089      qi(i, k) = 0.
    10891090    END DO
    … …  
    11871188          END IF
    11881189        END IF
    1189       END IF
     1190!jyg<
     1191!!      END IF  ! Endif moved to the end of the loop
     1192!>jyg
    11901193
    11911194      IF (cvflag_ice) THEN
    … …  
    12581261        END IF
    12591262      END IF ! (cvflag_ice)
    1260 
     1263!jyg<
     1264      END IF ! (k>=(icbs(i)+1))
     1265!>jyg
    12611266    END DO
    12621267  END DO
    … …  
    12671272! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)
    12681273! =====================================================================
    1269 
     1274!
     1275!jyg<
     1276  DO k = 1, nl
     1277    DO i = 1, ncum
     1278      ep(i, k) = 0.0
     1279      sigp(i, k) = spfac
     1280    END DO
     1281  END DO
     1282!>jyg
     1283!
    12701284  IF (flag_epkeorig/=1) THEN
    12711285    DO k = 1, nl ! convect3
    12721286      DO i = 1, ncum
    1273         pden = ptcrit - pbcrit
    1274         ep(i, k) = (plcl(i)-p(i,k)-pbcrit)/pden*epmax
    1275         ep(i, k) = max(ep(i,k), 0.0)
    1276         ep(i, k) = min(ep(i,k), epmax)
    1277         sigp(i, k) = spfac
     1287!jyg<
     1288       IF(k>=icb(i)) THEN
     1289!>jyg
     1290         pden = ptcrit - pbcrit
     1291         ep(i, k) = (plcl(i)-p(i,k)-pbcrit)/pden*epmax
     1292         ep(i, k) = max(ep(i,k), 0.0)
     1293         ep(i, k) = min(ep(i,k), epmax)
     1294!!         sigp(i, k) = spfac  ! jyg
     1295        ENDIF   ! (k>=icb(i))
    12781296      END DO
    12791297    END DO
    … …  
    12811299    DO k = 1, nl
    12821300      DO i = 1, ncum
    1283         IF (k>=(nk(i)+1)) THEN
     1301        IF(k>=icb(i)) THEN
     1302!!        IF (k>=(nk(i)+1)) THEN
     1303!>jyg
    12841304          tca = tp(i, k) - t0
    12851305          IF (tca>=0.0) THEN
    … …  
    12921312          ep(i, k) = max(ep(i,k), 0.0)
    12931313          ep(i, k) = min(ep(i,k), epmax)
    1294           sigp(i, k) = spfac
    1295         END IF
     1314!!          sigp(i, k) = spfac  ! jyg
     1315        END IF  ! (k>=icb(i))
    12961316      END DO
    12971317    END DO
    12981318  END IF
     1319!
    12991320! =====================================================================
    13001321! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
    … …  
    17681789
    17691790!inputs:
    1770   INTEGER ncum, nd, na, ntra, nloc
    1771   INTEGER icb(nloc), inb(nloc), nk(nloc)
    1772   REAL sig(nloc, nd)
    1773   REAL qnk(nloc), unk(nloc), vnk(nloc)
    1774   REAL ph(nloc, nd+1)
    1775   REAL t(nloc, nd), rr(nloc, nd), rs(nloc, nd)
    1776   REAL u(nloc, nd), v(nloc, nd)
    1777   REAL tra(nloc, nd, ntra) ! input of convect3
    1778   REAL lv(nloc, na), h(nloc, na), hp(nloc, na)
    1779   REAL lf(nloc, na), frac(nloc, na)
    1780   REAL tv(nloc, na), tvp(nloc, na), ep(nloc, na), clw(nloc, na)
    1781   REAL m(nloc, na) ! input of convect3
     1791  INTEGER, INTENT (IN)                               :: ncum, nd, na, ntra, nloc
     1792  INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, inb, nk
     1793  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: sig
     1794  REAL, DIMENSION (nloc), INTENT (IN)                :: qnk, unk, vnk
     1795  REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: ph
     1796  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: t, rr, rs
     1797  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: u, v
     1798  REAL, DIMENSION (nloc, nd, ntra), INTENT (IN)      :: tra              ! input of convect3
     1799  REAL, DIMENSION (nloc, na), INTENT (IN)            :: lv, h, hp
     1800  REAL, DIMENSION (nloc, na), INTENT (IN)            :: lf, frac
     1801  REAL, DIMENSION (nloc, na), INTENT (IN)            :: tv, tvp, ep, clw
     1802  REAL, DIMENSION (nloc, na), INTENT (IN)            :: m                ! input of convect3
    17821803
    17831804!outputs:
    1784   REAL ment(nloc, na, na), qent(nloc, na, na)
    1785   REAL uent(nloc, na, na), vent(nloc, na, na)
    1786   REAL sij(nloc, na, na), elij(nloc, na, na)
    1787   REAL traent(nloc, nd, nd, ntra)
    1788   REAL ments(nloc, nd, nd), qents(nloc, nd, nd)
    1789   REAL sigij(nloc, nd, nd)
    1790   INTEGER nent(nloc, nd)
     1805  REAL, DIMENSION (nloc, na, na), INTENT (OUT)        :: ment, qent
     1806  REAL, DIMENSION (nloc, na, na), INTENT (OUT)        :: uent, vent
     1807  REAL, DIMENSION (nloc, na, na), INTENT (OUT)        :: sij, elij
     1808  REAL, DIMENSION (nloc, nd, nd, ntra), INTENT (OUT)  :: traent
     1809  REAL, DIMENSION (nloc, nd, nd), INTENT (OUT)        :: ments, qents
     1810  INTEGER, DIMENSION (nloc, nd), INTENT (OUT)         :: nent
    17911811
    17921812!local variables:
    … …  
    17971817  REAL asij(nloc), smax(nloc), scrit(nloc)
    17981818  REAL asum(nloc, nd), bsum(nloc, nd), csum(nloc, nd)
     1819  REAL sigij(nloc, nd, nd)
    17991820  REAL wgh
    18001821  REAL zm(nloc, na)
    … …  
    35883609! ***           reset counter and return           ***
    35893610
     3611! Reset counter only for points actually convective (jyg)
     3612! In order take into account the possibility of changing the compression,
     3613! reset m, sig and w0 to zero for non-convecting points.
    35903614  DO il = 1, ncum
    3591     sig(il, nd) = 2.0
     3615    IF (iflag(il) < 3) THEN
     3616      sig(il, nd) = 2.0
     3617    ENDIF
    35923618  END DO
    35933619

  • LMDZ5/trunk/libf/phylmd/cv3a_compress.F90

    r2201 r2253  
    1 SUBROUTINE cv3a_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, &
    2     plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, wghti1, pbase1, buoybase1, &
    3     t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, u1, v1, gz1, th1, &
    4     th1_wake, tra1, h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
    5     h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, sig1, w01, ptop21, &
    6     ale1, alp1, omega1, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, hnk, unk, vnk, &
    7     wghti, pbase, buoybase, t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, &
    8     gz, th, th_wake, tra, h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, h_wake, &
    9     lv_wake, lf_wake, cpn_wake, tv_wake, sig, w0, ptop2, ale, alp, omega)
     1SUBROUTINE cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
     2                         iflag1, nk1, icb1, icbs1, &
     3                         plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
     4                         wghti1, pbase1, buoybase1, &
     5                         t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
     6                         u1, v1, gz1, th1, th1_wake, &
     7                         tra1, &
     8                         h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
     9                         h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
     10                         sig1, w01, ptop21, &
     11                         Ale1, Alp1, omega1, &
     12                         iflag, nk, icb, icbs, &
     13                         plcl, tnk, qnk, gznk, hnk, unk, vnk, &
     14                         wghti, pbase, buoybase, &
     15                         t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
     16                         u, v, gz, th, th_wake, &
     17                         tra, &
     18                         h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
     19                         h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
     20                         sig, w0, ptop2, &
     21                         Ale, Alp, omega)
    1022  ! **************************************************************
    1123  ! *
    … …  
    2234
    2335  ! inputs:
    24   INTEGER len, nloc, ncum, nd, ntra
    25   INTEGER iflag1(len), nk1(len), icb1(len), icbs1(len)
    26   REAL plcl1(len), tnk1(len), qnk1(len), gznk1(len)
    27   REAL hnk1(len), unk1(len), vnk1(len)
    28   REAL wghti1(len, nd), pbase1(len), buoybase1(len)
    29   REAL t1(len, nd), q1(len, nd), qs1(len, nd)
    30   REAL t1_wake(len, nd), q1_wake(len, nd), qs1_wake(len, nd)
    31   REAL s1_wake(len)
    32   REAL u1(len, nd), v1(len, nd)
    33   REAL gz1(len, nd), th1(len, nd), th1_wake(len, nd)
    34   REAL tra1(len, nd, ntra)
    35   REAL h1(len, nd), lv1(len, nd), lf1(len, nd), cpn1(len, nd)
    36   REAL p1(len, nd), ph1(len, nd+1), tv1(len, nd), tp1(len, nd)
    37   REAL tvp1(len, nd), clw1(len, nd)
    38   REAL h1_wake(len, nd), lv1_wake(len, nd), cpn1_wake(len, nd)
    39   REAL tv1_wake(len, nd), lf1_wake(len, nd)
    40   REAL sig1(len, nd), w01(len, nd), ptop21(len)
    41   REAL ale1(len), alp1(len)
    42   REAL omega1(len,nd)
    43 
     36  INTEGER, INTENT (IN)                               :: len, nloc, nd, ntra
     37!jyg<
     38  LOGICAL, INTENT (IN)                               :: compress  ! compression is performed if compress is true
     39!>jyg
     40  INTEGER, DIMENSION (len), INTENT (IN)              :: iflag1, nk1, icb1, icbs1
     41  REAL, DIMENSION (len), INTENT (IN)                 :: plcl1, tnk1, qnk1, gznk1
     42  REAL, DIMENSION (len), INTENT (IN)                 :: hnk1, unk1, vnk1
     43  REAL, DIMENSION (len, nd), INTENT (IN)             :: wghti1(len, nd)
     44  REAL, DIMENSION (len), INTENT (IN)                 :: pbase1, buoybase1
     45  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1, q1, qs1
     46  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1_wake, q1_wake, qs1_wake
     47  REAL, DIMENSION (len), INTENT (IN)                 :: s1_wake
     48  REAL, DIMENSION (len, nd), INTENT (IN)             :: u1, v1
     49  REAL, DIMENSION (len, nd), INTENT (IN)             :: gz1, th1, th1_wake
     50  REAL, DIMENSION (len, nd,ntra), INTENT (IN)        :: tra1
     51  REAL, DIMENSION (len, nd), INTENT (IN)             :: h1, lv1, lf1, cpn1
     52  REAL, DIMENSION (len, nd), INTENT (IN)             :: p1
     53  REAL, DIMENSION (len, nd+1), INTENT (IN)           :: ph1(len, nd+1)
     54  REAL, DIMENSION (len, nd), INTENT (IN)             :: tv1, tp1
     55  REAL, DIMENSION (len, nd), INTENT (IN)             :: tvp1, clw1
     56  REAL, DIMENSION (len, nd), INTENT (IN)             :: h1_wake, lv1_wake, cpn1_wake
     57  REAL, DIMENSION (len, nd), INTENT (IN)             :: tv1_wake, lf1_wake
     58  REAL, DIMENSION (len, nd), INTENT (IN)             :: sig1, w01
     59  REAL, DIMENSION (len), INTENT (IN)                 :: ptop21
     60  REAL, DIMENSION (len), INTENT (IN)                 :: Ale1, Alp1
     61  REAL, DIMENSION (len, nd), INTENT (IN)             :: omega1
     62!
     63  ! in/out
     64  INTEGER, INTENT (INOUT)                            :: ncum
     65!
    4466  ! outputs:
    4567  ! en fait, on a nloc=len pour l'instant (cf cv_driver)
    46   INTEGER iflag(len), nk(len), icb(len), icbs(len)
    47   REAL plcl(len), tnk(len), qnk(len), gznk(len)
    48   REAL hnk(len), unk(len), vnk(len)
    49   REAL wghti(len, nd), pbase(len), buoybase(len)
    50   REAL t(len, nd), q(len, nd), qs(len, nd)
    51   REAL t_wake(len, nd), q_wake(len, nd), qs_wake(len, nd)
    52   REAL s_wake(len)
    53   REAL u(len, nd), v(len, nd)
    54   REAL gz(len, nd), th(len, nd), th_wake(len, nd)
    55   REAL tra(len, nd, ntra)
    56   REAL h(len, nd), lv(len, nd), lf(len, nd), cpn(len, nd)
    57   REAL p(len, nd), ph(len, nd+1), tv(len, nd), tp(len, nd)
    58   REAL tvp(len, nd), clw(len, nd)
    59   REAL h_wake(len, nd), lv_wake(len, nd), cpn_wake(len, nd)
    60   REAL tv_wake(len, nd), lf_wake(len, nd)
    61   REAL sig(len, nd), w0(len, nd), ptop2(len)
    62   REAL ale(len), alp(len)
    63   REAL omega(len,nd)
     68  INTEGER, DIMENSION (nloc), INTENT (OUT)            ::  iflag, nk, icb, icbs
     69  REAL, DIMENSION (nloc), INTENT (OUT)               ::  plcl, tnk, qnk, gznk
     70  REAL, DIMENSION (nloc), INTENT (OUT)               ::  hnk, unk, vnk
     71  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  wghti
     72  REAL, DIMENSION (nloc), INTENT (OUT)               ::  pbase, buoybase
     73  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  t, q, qs
     74  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  t_wake, q_wake, qs_wake
     75  REAL, DIMENSION (nloc), INTENT (OUT)               ::  s_wake
     76  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  u, v
     77  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  gz, th, th_wake
     78  REAL, DIMENSION (nloc, nd,ntra), INTENT (OUT)      ::  tra
     79  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  h, lv, lf, cpn
     80  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  p
     81  REAL, DIMENSION (nloc, nd+1), INTENT (OUT)         ::  ph
     82  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  tv, tp
     83  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  tvp, clw
     84  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  h_wake, lv_wake, cpn_wake
     85  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  tv_wake, lf_wake
     86  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  sig, w0
     87  REAL, DIMENSION (nloc), INTENT (OUT)               ::  ptop2
     88  REAL, DIMENSION (nloc), INTENT (OUT)               ::  Ale, Alp
     89  REAL, DIMENSION (nloc, nd), INTENT (OUT)           ::  omega
    6490
    6591  ! local variables:
    … …  
    6995  CHARACTER (LEN=80) :: abort_message
    7096
     97!jyg<
     98  IF (compress) THEN
     99!>jyg
    71100
    72101  DO k = 1, nl + 1
    … …  
    108137    END DO
    109138  END DO
    110 
     139!
    111140  ! AC!      do 121 j=1,ntra
    112141  ! AC!ccccc      do 111 k=1,nl+1
    … …  
    147176      buoybase(nn) = buoybase1(i)
    148177      ptop2(nn) = ptop2(i)
    149       ale(nn) = ale1(i)
    150       alp(nn) = alp1(i)
     178      Ale(nn) = Ale1(i)
     179      Alp(nn) = Alp1(i)
    151180    END IF
    152181  END DO
    … …  
    157186    CALL abort_gcm(modname, abort_message, 1)
    158187  END IF
     188!
     189!jyg<
     190  ELSE  !(compress)
     191!
     192      ncum = len
     193!
     194      wghti(:,:) = wghti1(:,:)
     195      t(:,:) = t1(:,:)
     196      q(:,:) = q1(:,:)
     197      qs(:,:) = qs1(:,:)
     198      t_wake(:,:) = t1_wake(:,:)
     199      q_wake(:,:) = q1_wake(:,:)
     200      qs_wake(:,:) = qs1_wake(:,:)
     201      u(:,:) = u1(:,:)
     202      v(:,:) = v1(:,:)
     203      gz(:,:) = gz1(:,:)
     204      th(:,:) = th1(:,:)
     205      th_wake(:,:) = th1_wake(:,:)
     206      h(:,:) = h1(:,:)
     207      lv(:,:) = lv1(:,:)
     208      lf(:,:) = lf1(:,:)
     209      cpn(:,:) = cpn1(:,:)
     210      p(:,:) = p1(:,:)
     211      ph(:,:) = ph1(:,:)
     212      tv(:,:) = tv1(:,:)
     213      tp(:,:) = tp1(:,:)
     214      tvp(:,:) = tvp1(:,:)
     215      clw(:,:) = clw1(:,:)
     216      h_wake(:,:) = h1_wake(:,:)
     217      lv_wake(:,:) = lv1_wake(:,:)
     218      lf_wake(:,:) = lf1_wake(:,:)
     219      cpn_wake(:,:) = cpn1_wake(:,:)
     220      tv_wake(:,:) = tv1_wake(:,:)
     221      sig(:,:) = sig1(:,:)
     222      w0(:,:) = w01(:,:)
     223      omega(:,:) = omega1(:,:)
     224!
     225      s_wake(:) = s1_wake(:)
     226      iflag(:) = iflag1(:)
     227      nk(:) = nk1(:)
     228      icb(:) = icb1(:)
     229      icbs(:) = icbs1(:)
     230      plcl(:) = plcl1(:)
     231      tnk(:) = tnk1(:)
     232      qnk(:) = qnk1(:)
     233      gznk(:) = gznk1(:)
     234      hnk(:) = hnk1(:)
     235      unk(:) = unk1(:)
     236      vnk(:) = vnk1(:)
     237      pbase(:) = pbase1(:)
     238      buoybase(:) = buoybase1(:)
     239      ptop2(:) = ptop2(:)
     240      Ale(:) = Ale1(:)
     241      Alp(:) = Alp1(:)
     242!
     243  ENDIF !(compress)
     244!>jyg
    159245
    160246  RETURN

  • LMDZ5/trunk/libf/phylmd/cv3a_uncompress.F90

    r2207 r2253  
    1 SUBROUTINE cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, kbas, &
    2     ktop, precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, ft, fq, fu, fv, &
    3     ftra, sigd, ma, mip, vprecip, upwd, dnwd, dnwd0, qcondc, wd, cape, cin, &
    4     tvp, ftd, fqd, plim1, plim2, asupmax, supmax0, asupmaxmin &
    5     , da, phi, mp, phi2, d1a, dam, sigij & ! RomP+AC+jyg
    6     , clw, elij, evap, ep, epmlmmm, eplamm & ! RomP
    7     , wdtraina, wdtrainm &         ! RomP
    8     , qtc, sigt          &
    9 
    10     , iflag1, kbas1, ktop1, precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, &
    11     ptop21, ft1, fq1, fu1, fv1, ftra1, sigd1, ma1, mip1, vprecip1, upwd1, &
    12     dnwd1, dnwd01, qcondc1, wd1, cape1, cin1, tvp1, ftd1, fqd1, plim11, &
    13     plim21, asupmax1, supmax01, asupmaxmin1 &
    14     , da1, phi1, mp1, phi21, d1a1, dam1, sigij1 & ! RomP+AC+jyg
    15     , clw1, elij1, evap1, ep1, epmlmmm1, eplamm1 & ! RomP
    16     , wdtraina1, wdtrainm1 & ! RomP
    17     , qtc1, sigt1)
     1SUBROUTINE cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
     2                           iflag, kbas, ktop, &
     3                           precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
     4                           ft, fq, fu, fv, ftra,  &
     5                           sigd, ma, mip, vprecip, upwd, dnwd, dnwd0, &
     6                           qcondc, wd, cape, cin, &
     7                           tvp, &
     8                           ftd, fqd, &
     9                           plim1, plim2, asupmax, supmax0, &
     10                           asupmaxmin, &
     11                           da, phi, mp, phi2, d1a, dam, sigij, &                ! RomP+AC+jyg
     12                           clw, elij, evap, ep, epmlmMm, eplaMm, &              ! RomP
     13                           wdtrainA, wdtrainM, &                                ! RomP
     14                           qtc, sigt,          &
     15                         
     16                           iflag1, kbas1, ktop1, &
     17                           precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
     18                           ft1, fq1, fu1, fv1, ftra1, &
     19                           sigd1, ma1, mip1, vprecip1, upwd1, dnwd1, dnwd01, &
     20                           qcondc1, wd1, cape1, cin1, &
     21                           tvp1, &
     22                           ftd1, fqd1, &
     23                           plim11, plim21, asupmax1, supmax01, &
     24                           asupmaxmin1, &
     25                           da1, phi1, mp1, phi21, d1a1, dam1, sigij1, &         ! RomP+AC+jyg
     26                           clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &        ! RomP
     27                           wdtrainA1, wdtrainM1, &                              ! RomP
     28                           qtc1, sigt1)
    1829
    1930  ! **************************************************************
    … …  
    3142
    3243  ! inputs:
    33   INTEGER nloc, len, ncum, nd, ntra
    34   INTEGER idcum(nloc)
    35   INTEGER iflag(nloc), kbas(nloc), ktop(nloc)
    36   REAL precip(nloc), cbmf(nloc), plcl(nloc), plfc(nloc)
    37   REAL wbeff(len)
    38   REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc)
    39   REAL ft(nloc, nd), fq(nloc, nd), fu(nloc, nd), fv(nloc, nd)
    40   REAL ftra(nloc, nd, ntra)
    41   REAL sigd(nloc)
    42   REAL ma(nloc, nd), mip(nloc, nd), vprecip(nloc, nd+1)
    43   REAL upwd(nloc, nd), dnwd(nloc, nd), dnwd0(nloc, nd)
    44   REAL qcondc(nloc, nd)
    45   REAL wd(nloc), cape(nloc), cin(nloc)
    46   REAL tvp(nloc, nd)
    47   REAL ftd(nloc, nd), fqd(nloc, nd)
    48   REAL plim1(nloc), plim2(nloc)
    49   REAL asupmax(nloc, nd), supmax0(nloc)
    50   REAL asupmaxmin(nloc)
    51 
    52   REAL da(nloc, nd), phi(nloc, nd, nd) !AC!
    53   REAL mp(nloc, nd) !RomP
    54   REAL phi2(nloc, nd, nd) !RomP
    55   REAL d1a(nloc, nd), dam(nloc, nd) !RomP
    56   REAL sigij(nloc, nd, nd) !RomP
    57   REAL clw(nloc, nd), elij(nloc, nd, nd) !RomP
    58   REAL evap(nloc, nd), ep(nloc, nd) !RomP
    59   REAL epmlmmm(nloc, nd, nd), eplamm(nloc, nd) !RomP+jyg
    60   REAL qtc(nloc, nd), sigt(nloc, nd) !RomP
    61   REAL wdtraina(nloc, nd), wdtrainm(nloc, nd) !RomP
     44  INTEGER, INTENT (IN)                               :: nloc, len, ncum, nd, ntra
     45  INTEGER, DIMENSION (nloc), INTENT (IN)             :: idcum(nloc)
     46!jyg<
     47  LOGICAL, INTENT (IN)                               :: compress
     48!>jyg
     49  INTEGER, DIMENSION (nloc), INTENT (IN)             ::iflag, kbas, ktop
     50  REAL, DIMENSION (nloc), INTENT (IN)                :: precip, cbmf, plcl, plfc
     51  REAL, DIMENSION (nloc), INTENT (IN)                :: wbeff
     52  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: sig, w0
     53  REAL, DIMENSION (nloc), INTENT (IN)                :: ptop2
     54  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: ft, fq, fu, fv
     55  REAL, DIMENSION (nloc, nd, ntra), INTENT (IN)      :: ftra
     56  REAL, DIMENSION (nloc), INTENT (IN)                :: sigd
     57  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: ma, mip
     58  REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: vprecip
     59  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: upwd, dnwd, dnwd0
     60  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: qcondc
     61  REAL, DIMENSION (nloc), INTENT (IN)                :: wd, cape, cin
     62  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: tvp
     63  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: ftd, fqd
     64  REAL, DIMENSION (nloc), INTENT (IN)                :: plim1, plim2
     65  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: asupmax
     66  REAL, DIMENSION (nloc), INTENT (IN)                :: supmax0, asupmaxmin
     67
     68  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: da
     69  REAL, DIMENSION (nloc, nd, nd), INTENT (IN)        :: phi                    !AC!
     70  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: mp                     !RomP
     71  REAL, DIMENSION (nloc, nd, nd), INTENT (IN)        :: phi2                   !RomP
     72  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: d1a, dam               !RomP
     73  REAL, DIMENSION (nloc, nd, nd), INTENT (IN)        :: sigij                  !RomP
     74  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: clw                    !RomP
     75  REAL, DIMENSION (nloc, nd, nd), INTENT (IN)        :: elij                   !RomP
     76  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: evap, ep               !RomP
     77  REAL, DIMENSION (nloc, nd, nd), INTENT (IN)        :: epmlmMm                !RomP+jyg
     78  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: eplamM                 !RomP+jyg
     79  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: qtc, sigt              !RomP
     80  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: wdtrainA, wdtrainM     !RomP
    6281
    6382  ! outputs:
    64   INTEGER iflag1(len), kbas1(len), ktop1(len)
    65   REAL precip1(len), cbmf1(len), plcl1(nloc), plfc1(nloc)
    66   REAL wbeff1(len)
    67   REAL sig1(len, nd), w01(len, nd), ptop21(len)
    68   REAL ft1(len, nd), fq1(len, nd), fu1(len, nd), fv1(len, nd)
    69   REAL ftra1(len, nd, ntra)
    70   REAL sigd1(len)
    71   REAL ma1(len, nd), mip1(len, nd), vprecip1(len, nd+1)
    72   REAL upwd1(len, nd), dnwd1(len, nd), dnwd01(len, nd)
    73   REAL qcondc1(len, nd)
    74   REAL wd1(len), cape1(len), cin1(len)
    75   REAL tvp1(len, nd)
    76   REAL ftd1(len, nd), fqd1(len, nd)
    77   REAL plim11(len), plim21(len)
    78   REAL asupmax1(len, nd), supmax01(len)
    79   REAL asupmaxmin1(len)
    80 
    81   REAL da1(nloc, nd), phi1(nloc, nd, nd) !AC!
    82   REAL mp1(nloc, nd) !RomP
    83   REAL phi21(nloc, nd, nd) !RomP
    84   REAL d1a1(nloc, nd), dam1(nloc, nd) !RomP
    85   REAL sigij1(len, nd, nd) !RomP
    86   REAL clw1(len, nd), elij1(len, nd, nd) !RomP
    87   REAL evap1(len, nd), ep1(len, nd) !RomP
    88   REAL epmlmmm1(len, nd, nd), eplamm1(len, nd) !RomP+jyg
    89   REAL qtc1(len, nd), sigt1(len, nd) !RomP
    90   REAL wdtraina1(len, nd), wdtrainm1(len, nd) !RomP
     83  INTEGER, DIMENSION (len), INTENT (OUT)             :: iflag1, kbas1, ktop1
     84  REAL, DIMENSION (len), INTENT (OUT)                :: precip1, cbmf1, plcl1, plfc1
     85  REAL, DIMENSION (len), INTENT (OUT)                :: wbeff1
     86  REAL, DIMENSION (len, nd), INTENT (OUT)            :: sig1, w01
     87  REAL, DIMENSION (len), INTENT (OUT)                :: ptop21
     88  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ft1, fq1, fu1, fv1
     89  REAL, DIMENSION (len, nd, ntra), INTENT (OUT)      :: ftra1
     90  REAL, DIMENSION (len), INTENT (OUT)                :: sigd1
     91  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ma1, mip1
     92  REAL, DIMENSION (len, nd+1), INTENT (OUT)          :: vprecip1
     93  REAL, DIMENSION (len, nd), INTENT (OUT)            :: upwd1, dnwd1, dnwd01
     94  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qcondc1
     95  REAL, DIMENSION (len), INTENT (OUT)                :: wd1, cape1, cin1
     96  REAL, DIMENSION (len, nd), INTENT (OUT)            :: tvp1
     97  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ftd1, fqd1
     98  REAL, DIMENSION (len), INTENT (OUT)                :: plim11, plim21
     99  REAL, DIMENSION (len, nd), INTENT (OUT)            :: asupmax1
     100  REAL, DIMENSION (len), INTENT (OUT)                :: supmax01, asupmaxmin1
     101                                                   
     102  REAL, DIMENSION (len, nd), INTENT (OUT)            :: da1
     103  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi1                   !AC!
     104  REAL, DIMENSION (len, nd), INTENT (OUT)            :: mp1                    !RomP
     105  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi21                  !RomP
     106  REAL, DIMENSION (len, nd), INTENT (OUT)            :: d1a1, dam1 !RomP       !RomP
     107  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: sigij1                 !RomP
     108  REAL, DIMENSION (len, nd), INTENT (OUT)            :: clw1                   !RomP
     109  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: elij1                  !RomP
     110  REAL, DIMENSION (len, nd), INTENT (OUT)            :: evap1, ep1             !RomP
     111  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: epmlmMm1               !RomP+jyg
     112  REAL, DIMENSION (len, nd), INTENT (OUT)            :: eplamM1                !RomP+jyg
     113  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qtc1, sigt1            !RomP
     114  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wdtrainA1, wdtrainM1   !RomP
    91115
    92116
    93117  ! local variables:
    94118  INTEGER i, k, j
     119  INTEGER jdcum
    95120  ! c    integer k1,k2
    96121
    97   DO i = 1, ncum
    98     ptop21(idcum(i)) = ptop2(i)
    99     sigd1(idcum(i)) = sigd(i)
    100     precip1(idcum(i)) = precip(i)
    101     cbmf1(idcum(i)) = cbmf(i)
    102     plcl1(idcum(i)) = plcl(i)
    103     plfc1(idcum(i)) = plfc(i)
    104     wbeff1(idcum(i)) = wbeff(i)
    105     iflag1(idcum(i)) = iflag(i)
    106     kbas1(idcum(i)) = kbas(i)
    107     ktop1(idcum(i)) = ktop(i)
    108     wd1(idcum(i)) = wd(i)
    109     cape1(idcum(i)) = cape(i)
    110     cin1(idcum(i)) = cin(i)
    111     plim11(idcum(i)) = plim1(i)
    112     plim21(idcum(i)) = plim2(i)
    113     supmax01(idcum(i)) = supmax0(i)
    114     asupmaxmin1(idcum(i)) = asupmaxmin(i)
    115   END DO
    116 
    117   DO k = 1, nd
     122!jyg<
     123  IF (compress) THEN
     124!>jyg
    118125    DO i = 1, ncum
    119       sig1(idcum(i), k) = sig(i, k)
    120       w01(idcum(i), k) = w0(i, k)
    121       ft1(idcum(i), k) = ft(i, k)
    122       fq1(idcum(i), k) = fq(i, k)
    123       fu1(idcum(i), k) = fu(i, k)
    124       fv1(idcum(i), k) = fv(i, k)
    125       ma1(idcum(i), k) = ma(i, k)
    126       mip1(idcum(i), k) = mip(i, k)
    127       vprecip1(idcum(i), k) = vprecip(i, k)
    128       upwd1(idcum(i), k) = upwd(i, k)
    129       dnwd1(idcum(i), k) = dnwd(i, k)
    130       dnwd01(idcum(i), k) = dnwd0(i, k)
    131       qcondc1(idcum(i), k) = qcondc(i, k)
    132       tvp1(idcum(i), k) = tvp(i, k)
    133       ftd1(idcum(i), k) = ftd(i, k)
    134       fqd1(idcum(i), k) = fqd(i, k)
    135       asupmax1(idcum(i), k) = asupmax(i, k)
    136 
    137       da1(idcum(i), k) = da(i, k) !AC!
    138       mp1(idcum(i), k) = mp(i, k) !RomP
    139       d1a1(idcum(i), k) = d1a(i, k) !RomP
    140       dam1(idcum(i), k) = dam(i, k) !RomP
    141       clw1(idcum(i), k) = clw(i, k) !RomP
    142       evap1(idcum(i), k) = evap(i, k) !RomP
    143       ep1(idcum(i), k) = ep(i, k) !RomP
    144       eplamm(idcum(i), k) = eplamm(i, k) !RomP+jyg
    145       wdtraina1(idcum(i), k) = wdtraina(i, k) !RomP
    146       wdtrainm1(idcum(i), k) = wdtrainm(i, k) !RomP
    147       qtc1(idcum(i), k) = qtc(i, k)
    148       sigt1(idcum(i), k) = sigt(i, k)
    149 
     126      ptop21(idcum(i)) = ptop2(i)
     127      sigd1(idcum(i)) = sigd(i)
     128      precip1(idcum(i)) = precip(i)
     129      cbmf1(idcum(i)) = cbmf(i)
     130      plcl1(idcum(i)) = plcl(i)
     131      plfc1(idcum(i)) = plfc(i)
     132      wbeff1(idcum(i)) = wbeff(i)
     133      iflag1(idcum(i)) = iflag(i)
     134      kbas1(idcum(i)) = kbas(i)
     135      ktop1(idcum(i)) = ktop(i)
     136      wd1(idcum(i)) = wd(i)
     137      cape1(idcum(i)) = cape(i)
     138      cin1(idcum(i)) = cin(i)
     139      plim11(idcum(i)) = plim1(i)
     140      plim21(idcum(i)) = plim2(i)
     141      supmax01(idcum(i)) = supmax0(i)
     142      asupmaxmin1(idcum(i)) = asupmaxmin(i)
    150143    END DO
    151   END DO
    152 
    153   DO i = 1, ncum
    154     sig1(idcum(i), nd) = sig(i, nd)
    155   END DO
    156 
    157 
    158   ! AC!        do 2100 j=1,ntra
    159   ! AC!c oct3         do 2110 k=1,nl
    160   ! AC!         do 2110 k=1,nd ! oct3
    161   ! AC!          do 2120 i=1,ncum
    162   ! AC!            ftra1(idcum(i),k,j)=ftra(i,k,j)
    163   ! AC! 2120     continue
    164   ! AC! 2110    continue
    165   ! AC! 2100   continue
    166 
    167   ! AC!
    168   DO j = 1, nd
     144   
    169145    DO k = 1, nd
    170146      DO i = 1, ncum
    171         phi1(idcum(i), k, j) = phi(i, k, j) !AC!
    172         phi21(idcum(i), k, j) = phi2(i, k, j) !RomP
    173         sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP
    174         elij1(idcum(i), k, j) = elij(i, k, j) !RomP
    175         epmlmmm(idcum(i), k, j) = epmlmmm(i, k, j) !RomP+jyg
     147        sig1(idcum(i), k) = sig(i, k)
     148        w01(idcum(i), k) = w0(i, k)
     149        ft1(idcum(i), k) = ft(i, k)
     150        fq1(idcum(i), k) = fq(i, k)
     151        fu1(idcum(i), k) = fu(i, k)
     152        fv1(idcum(i), k) = fv(i, k)
     153        ma1(idcum(i), k) = ma(i, k)
     154        mip1(idcum(i), k) = mip(i, k)
     155        vprecip1(idcum(i), k) = vprecip(i, k)
     156        upwd1(idcum(i), k) = upwd(i, k)
     157        dnwd1(idcum(i), k) = dnwd(i, k)
     158        dnwd01(idcum(i), k) = dnwd0(i, k)
     159        qcondc1(idcum(i), k) = qcondc(i, k)
     160        tvp1(idcum(i), k) = tvp(i, k)
     161        ftd1(idcum(i), k) = ftd(i, k)
     162        fqd1(idcum(i), k) = fqd(i, k)
     163        asupmax1(idcum(i), k) = asupmax(i, k)
     164   
     165        da1(idcum(i), k) = da(i, k) !AC!
     166        mp1(idcum(i), k) = mp(i, k) !RomP
     167        d1a1(idcum(i), k) = d1a(i, k) !RomP
     168        dam1(idcum(i), k) = dam(i, k) !RomP
     169        clw1(idcum(i), k) = clw(i, k) !RomP
     170        evap1(idcum(i), k) = evap(i, k) !RomP
     171        ep1(idcum(i), k) = ep(i, k) !RomP
     172        eplamM1(idcum(i), k) = eplamM(i, k) !RomP+jyg
     173        wdtrainA1(idcum(i), k) = wdtrainA(i, k) !RomP
     174        wdtrainM1(idcum(i), k) = wdtrainM(i, k) !RomP
     175        qtc1(idcum(i), k) = qtc(i, k)
     176        sigt1(idcum(i), k) = sigt(i, k)
     177   
    176178      END DO
    177179    END DO
    178   END DO
    179   ! AC!
    180 
    181 
    182   ! do 2220 k2=1,nd
    183   ! do 2210 k1=1,nd
    184   ! do 2200 i=1,ncum
    185   ! ment1(idcum(i),k1,k2) = ment(i,k1,k2)
    186   ! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
    187   ! 2200      enddo
    188   ! 2210     enddo
    189   ! 2220    enddo
     180
     181    DO i = 1, ncum
     182      sig1(idcum(i), nd) = sig(i, nd)
     183    END DO
     184   
     185   
     186    ! AC!        do 2100 j=1,ntra
     187    ! AC!c oct3         do 2110 k=1,nl
     188    ! AC!         do 2110 k=1,nd ! oct3
     189    ! AC!          do 2120 i=1,ncum
     190    ! AC!            ftra1(idcum(i),k,j)=ftra(i,k,j)
     191    ! AC! 2120     continue
     192    ! AC! 2110    continue
     193    ! AC! 2100   continue
     194   
     195    ! AC!
     196!jyg<
     197!  Essais pour gagner du temps en diminuant l'adressage indirect
     198!!    DO j = 1, nd
     199!!      DO k = 1, nd
     200!!        DO i = 1, ncum
     201!!          phi1(idcum(i), k, j) = phi(i, k, j) !AC!
     202!!          phi21(idcum(i), k, j) = phi2(i, k, j) !RomP
     203!!          sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP
     204!!          elij1(idcum(i), k, j) = elij(i, k, j) !RomP
     205!!          epmlmMm(idcum(i), k, j) = epmlmMm(i, k, j) !RomP+jyg
     206!!        END DO
     207!!      END DO
     208!!    END DO
     209      DO i = 1, ncum
     210        jdcum=idcum(i)
     211        phi1(jdcum,:,:) = phi(i,:,:)          !AC!
     212        phi21(jdcum,:,:) = phi2(i,:,:)        !RomP
     213        sigij1(jdcum,:,:) = sigij(i,:,:)      !RomP
     214        elij1(jdcum,:,:) = elij(i,:,:)        !RomP
     215        epmlmMm1(jdcum,:,:) = epmlmMm(i,:,:)  !RomP+jyg
     216      END DO
     217!>jyg
     218    ! AC!
     219   
     220   
     221    ! do 2220 k2=1,nd
     222    ! do 2210 k1=1,nd
     223    ! do 2200 i=1,ncum
     224    ! ment1(idcum(i),k1,k2) = ment(i,k1,k2)
     225    ! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
     226    ! 2200      enddo
     227    ! 2210     enddo
     228    ! 2220    enddo
     229!
     230!jyg<
     231  ELSE  !(compress)
     232!
     233      ptop21(:) = ptop2(:)
     234      sigd1(:) = sigd(:)
     235      precip1(:) = precip(:)
     236      cbmf1(:) = cbmf(:)
     237      plcl1(:) = plcl(:)
     238      plfc1(:) = plfc(:)
     239      wbeff1(:) = wbeff(:)
     240      iflag1(:) = iflag(:)
     241      kbas1(:) = kbas(:)
     242      ktop1(:) = ktop(:)
     243      wd1(:) = wd(:)
     244      cape1(:) = cape(:)
     245      cin1(:) = cin(:)
     246      plim11(:) = plim1(:)
     247      plim21(:) = plim2(:)
     248      supmax01(:) = supmax0(:)
     249      asupmaxmin1(:) = asupmaxmin(:)
     250!
     251      sig1(:,:) = sig(:,:)
     252      w01(:,:) = w0(:,:)
     253      ft1(:,:) = ft(:,:)
     254      fq1(:,:) = fq(:,:)
     255      fu1(:,:) = fu(:,:)
     256      fv1(:,:) = fv(:,:)
     257      ma1(:,:) = ma(:,:)
     258      mip1(:,:) = mip(:,:)
     259      vprecip1(:,:) = vprecip(:,:)
     260      upwd1(:,:) = upwd(:,:)
     261      dnwd1(:,:) = dnwd(:,:)
     262      dnwd01(:,:) = dnwd0(:,:)
     263      qcondc1(:,:) = qcondc(:,:)
     264      tvp1(:,:) = tvp(:,:)
     265      ftd1(:,:) = ftd(:,:)
     266      fqd1(:,:) = fqd(:,:)
     267      asupmax1(:,:) = asupmax(:,:)
     268
     269      da1(:,:) = da(:,:)              !AC!
     270      mp1(:,:) = mp(:,:)              !RomP
     271      d1a1(:,:) = d1a(:,:)            !RomP
     272      dam1(:,:) = dam(:,:)            !RomP
     273      clw1(:,:) = clw(:,:)            !RomP
     274      evap1(:,:) = evap(:,:)          !RomP
     275      ep1(:,:) = ep(:,:)              !RomP
     276      eplamM1(:,:) = eplamM(:,:)       !RomP+jyg
     277      wdtrainA1(:,:) = wdtrainA(:,:)  !RomP
     278      wdtrainM1(:,:) = wdtrainM(:,:)  !RomP
     279      qtc1(:,:) = qtc(:,:)
     280      sigt1(:,:) = sigt(:,:)
     281!
     282      sig1(:,:) = sig(:,:)
     283!
     284      phi1(:,:,:)   = phi(:,:,:)      !AC!
     285      phi21(:,:,:)  = phi2(:,:,:)     !RomP
     286      sigij1(:,:,:) = sigij(:,:,:)    !RomP
     287      elij1(:,:,:)  = elij(:,:,:)     !RomP
     288      epmlmMm1(:,:,:) = epmlmMm(:,:,:) !RomP+jyg
     289  ENDIF !(compress)
     290!>jyg
    190291
    191292  RETURN

  • LMDZ5/trunk/libf/phylmd/cv3p1_closure.F90

    r2224 r2253  
    2929
    3030  ! input:
    31   INTEGER ncum, nd, nloc
    32   INTEGER icb(nloc), inb(nloc)
    33   REAL pbase(nloc), plcl(nloc)
    34   REAL p(nloc, nd), ph(nloc, nd+1)
    35   REAL tv(nloc, nd), tvp(nloc, nd), buoy(nloc, nd)
    36   REAL supmax(nloc, nd)
    37   LOGICAL ok_inhib ! enable convection inhibition by dryness
    38   REAL ale(nloc), alp(nloc)
    39   REAL omega(nloc,nd)
     31  INTEGER, INTENT (IN)                               :: ncum, nd, nloc
     32  INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, inb
     33  REAL, DIMENSION (nloc), INTENT (IN)                :: pbase, plcl
     34  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: p
     35  REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: ph
     36  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: tv, tvp, buoy
     37  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: supmax
     38  LOGICAL, INTENT (IN)                               :: ok_inhib ! enable convection inhibition by dryness
     39  REAL, DIMENSION (nloc), INTENT (IN)                :: ale, alp
     40  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: omega
    4041
    4142  ! input/output:
    42   REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc)
     43  REAL, DIMENSION (nloc, nd), INTENT (INOUT)         :: sig, w0
     44  REAL, DIMENSION (nloc), INTENT (INOUT)             :: ptop2
    4345
    4446  ! output:
    45   REAL cape(nloc), cin(nloc)
    46   REAL m(nloc, nd)
    47   REAL plim1(nloc), plim2(nloc)
    48   REAL asupmax(nloc, nd), supmax0(nloc)
    49   REAL asupmaxmin(nloc)
    50   REAL cbmf(nloc), plfc(nloc)
    51   REAL wbeff(nloc)
    52   INTEGER iflag(nloc)
     47  REAL, DIMENSION (nloc), INTENT (OUT)               :: cape, cin
     48  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: m
     49  REAL, DIMENSION (nloc), INTENT (OUT)               :: plim1, plim2
     50  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: asupmax
     51  REAL, DIMENSION (nloc), INTENT (OUT)               :: supmax0
     52  REAL, DIMENSION (nloc), INTENT (OUT)               :: asupmaxmin
     53  REAL, DIMENSION (nloc), INTENT (OUT)               :: cbmf, plfc
     54  REAL, DIMENSION (nloc), INTENT (OUT)               :: wbeff
     55  INTEGER, DIMENSION (nloc), INTENT (OUT)            :: iflag
    5356
    5457  ! local variables:
    … …  
    9194
    9295
    93 
    9496  DO il = 1, ncum
    9597    alp2(il) = max(alp(il), 1.E-5)
    … …  
    498500  IF (prt_level>=20) PRINT *, 'cv3p1_param apres cbmflim'
    499501
    500   ! c 1.5 Compute cloud base mass flux given by Alp closure (Cbmf1), maximum
    501   ! c     allowed mass flux (Cbmfmax) and final target mass flux (Cbmf)
    502   ! c     Cbmf is set to zero if Cbmflim (the mass flux of elementary cloud)
    503   ! is
    504   ! --    exceedingly small.
     502  ! 1.5 Compute cloud base mass flux given by Alp closure (Cbmf1), maximum
     503  !     allowed mass flux (Cbmfmax) and final target mass flux (Cbmf)
     504  !     Cbmf is set to zero if Cbmflim (the mass flux of elementary cloud)
     505  !     is exceedingly small.
    505506
    506507  DO il = 1, ncum

  • LMDZ5/trunk/libf/phylmd/cv3param.h

    r1992 r2253  
    1919      real betad
    2020
    21       COMMON /cv3param/  noff, minorig, nl, nlp, nlm &
    22                       ,  sigdz, spfac &
    23                       ,flag_epKEorig &
     21      COMMON /cv3param/ sigdz, spfac &
    2422                      ,pbcrit, ptcrit &
    2523                      ,elcrit, tlcrit &
    … …  
    2725                      ,dtovsh, dpbase, dttrig &
    2826                      ,dtcrit, tau, beta, alpha, alpha1 &
    29                       ,flag_wb,wbmax &
    30                       ,delta, betad
     27                      ,wbmax &
     28                      ,delta, betad  &
     29                      ,flag_epKEorig &
     30                      ,flag_wb &
     31                      ,noff, minorig, nl, nlp, nlm
    3132!$OMP THREADPRIVATE(/cv3param/)
    3233

  • LMDZ5/trunk/libf/phylmd/cva_driver.F90

    r2207 r2253  
    44SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, &
    55                      iflag_con, iflag_mix, iflag_ice_thermo, iflag_clos, ok_conserv_q, &
    6                       delt, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
     6!!                      delt, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &  ! jyg
     7                      delt, comp_threshold, &                                      ! jyg
     8                      t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &          ! jyg
    79                      u1, v1, tra1, &
    810                      p1, ph1, &
    … …  
    1921                      ftd1, fqd1, &
    2022                      Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
    21                       lalim_conv, &
     23                      lalim_conv1, &
    2224!!                      da1,phi1,mp1,phi21,d1a1,dam1,sigij1,clw1, &        ! RomP
    2325!!                      elij1,evap1,ep1,epmlmMm1,eplaMm1, &                ! RomP
    … …  
    6062! ok_conserv_q  Logical        Input        when true corrections for water conservation are swtiched on
    6163! delt          Real           Input        time step
     64! comp_threshold Real           Input       threshold on the fraction of convective points below which
     65!                                            fields  are compressed
    6266! t1            Real           Input        temperature (sat draught envt)
    6367! q1            Real           Input        specific hum (sat draught envt)
    … …  
    156160  include 'iniprint.h'
    157161
    158 
    159162! Input
    160   INTEGER len
    161   INTEGER nd
    162   INTEGER ndp1
    163   INTEGER ntra
    164   INTEGER iflag_con
    165   INTEGER iflag_mix
    166   INTEGER iflag_ice_thermo
    167   INTEGER iflag_clos
    168   LOGICAL ok_conserv_q
    169   REAL tau_cld_cv
    170   REAL coefw_cld_cv
    171   REAL delt
    172   REAL t1(len, nd)
    173   REAL q1(len, nd)
    174   REAL qs1(len, nd)
    175   REAL t1_wake(len, nd)
    176   REAL q1_wake(len, nd)
    177   REAL qs1_wake(len, nd)
    178   REAL s1_wake(len)
    179   REAL u1(len, nd)
    180   REAL v1(len, nd)
    181   REAL tra1(len, nd, ntra)
    182   REAL p1(len, nd)
    183   REAL ph1(len, ndp1)
    184   REAL Ale1(len)
    185   REAL Alp1(len)
    186   REAL omega1(len,nd)
    187   REAL sig1feed1 ! pressure at lower bound of feeding layer
    188   REAL sig2feed1 ! pressure at upper bound of feeding layer
    189   REAL wght1(nd) ! weight density determining the feeding mixture
     163  INTEGER, INTENT (IN)                               :: len
     164  INTEGER, INTENT (IN)                               :: nd
     165  INTEGER, INTENT (IN)                               :: ndp1
     166  INTEGER, INTENT (IN)                               :: ntra
     167  INTEGER, INTENT (IN)                               :: iflag_con
     168  INTEGER, INTENT (IN)                               :: iflag_mix
     169  INTEGER, INTENT (IN)                               :: iflag_ice_thermo
     170  INTEGER, INTENT (IN)                               :: iflag_clos
     171  LOGICAL, INTENT (IN)                               :: ok_conserv_q
     172  REAL, INTENT (IN)                                  :: tau_cld_cv
     173  REAL, INTENT (IN)                                  :: coefw_cld_cv
     174  REAL, INTENT (IN)                                  :: delt
     175  REAL, INTENT (IN)                                  :: comp_threshold
     176  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1
     177  REAL, DIMENSION (len, nd), INTENT (IN)             :: q1
     178  REAL, DIMENSION (len, nd), INTENT (IN)             :: qs1
     179  REAL, DIMENSION (len, nd), INTENT (IN)             :: t1_wake
     180  REAL, DIMENSION (len, nd), INTENT (IN)             :: q1_wake
     181  REAL, DIMENSION (len, nd), INTENT (IN)             :: qs1_wake
     182  REAL, DIMENSION (len), INTENT (IN)                 :: s1_wake
     183  REAL, DIMENSION (len, nd), INTENT (IN)             :: u1
     184  REAL, DIMENSION (len, nd), INTENT (IN)             :: v1
     185  REAL, DIMENSION (len, nd, ntra), INTENT (IN)       :: tra1
     186  REAL, DIMENSION (len, nd), INTENT (IN)             :: p1
     187  REAL, DIMENSION (len, ndp1), INTENT (IN)           :: ph1
     188  REAL, DIMENSION (len), INTENT (IN)                 :: Ale1
     189  REAL, DIMENSION (len), INTENT (IN)                 :: Alp1
     190  REAL, DIMENSION (len, nd), INTENT (IN)             :: omega1
     191  REAL, INTENT (IN)                                  :: sig1feed1 ! pressure at lower bound of feeding layer
     192  REAL, INTENT (IN)                                  :: sig2feed1 ! pressure at upper bound of feeding layer
     193  REAL, DIMENSION (nd), INTENT (IN)                  :: wght1     ! weight density determining the feeding mixture
     194  INTEGER, DIMENSION (len), INTENT (IN)              :: lalim_conv1
     195
     196! Input/Output
     197  REAL, DIMENSION (len, nd), INTENT (INOUT)          :: sig1
     198  REAL, DIMENSION (len, nd), INTENT (INOUT)          :: w01
    190199
    191200! Output
    192   INTEGER iflag1(len)
    193   REAL ft1(len, nd)
    194   REAL fq1(len, nd)
    195   REAL fu1(len, nd)
    196   REAL fv1(len, nd)
    197   REAL ftra1(len, nd, ntra)
    198   REAL precip1(len)
    199   INTEGER kbas1(len)
    200   INTEGER ktop1(len)
    201   REAL cbmf1(len)
    202   REAL plcl1(klon)
    203   REAL plfc1(klon)
    204   REAL wbeff1(klon)
    205   REAL sig1(len, klev) !input/output
    206   REAL w01(len, klev) !input/output
    207   REAL ptop21(len)
    208   REAL sigd1(len)
    209   REAL ma1(len, nd)
    210   REAL mip1(len, nd)
     201  INTEGER, DIMENSION (len), INTENT (OUT)             :: iflag1
     202  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ft1
     203  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fq1
     204  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fu1
     205  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fv1
     206  REAL, DIMENSION (len, nd, ntra), INTENT (OUT)      :: ftra1
     207  REAL, DIMENSION (len), INTENT (OUT)                :: precip1
     208  INTEGER, DIMENSION (len), INTENT (OUT)             :: kbas1
     209  INTEGER, DIMENSION (len), INTENT (OUT)             :: ktop1
     210  REAL, DIMENSION (len), INTENT (OUT)                :: cbmf1
     211  REAL, DIMENSION (len), INTENT (OUT)                :: plcl1
     212  REAL, DIMENSION (len), INTENT (OUT)                :: plfc1
     213  REAL, DIMENSION (len), INTENT (OUT)                :: wbeff1
     214  REAL, DIMENSION (len), INTENT (OUT)                :: ptop21
     215  REAL, DIMENSION (len), INTENT (OUT)                :: sigd1
     216  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ma1
     217  REAL, DIMENSION (len, nd), INTENT (OUT)            :: mip1
    211218! real Vprecip1(len,nd)
    212   REAL vprecip1(len, nd+1)
    213   REAL upwd1(len, nd)
    214   REAL dnwd1(len, nd)
    215   REAL dnwd01(len, nd)
    216   REAL qcondc1(len, nd) ! cld
    217   REAL wd1(len) ! gust
    218   REAL cape1(len)
    219   REAL cin1(len)
    220   REAL tvp1(len, nd)
     219  REAL, DIMENSION (len, ndp1), INTENT (OUT)          :: vprecip1
     220  REAL, DIMENSION (len, nd), INTENT (OUT)            :: upwd1
     221  REAL, DIMENSION (len, nd), INTENT (OUT)            :: dnwd1
     222  REAL, DIMENSION (len, nd), INTENT (OUT)            :: dnwd01
     223  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qcondc1        ! cld
     224  REAL, DIMENSION (len), INTENT (OUT)                :: wd1            ! gust
     225  REAL, DIMENSION (len), INTENT (OUT)                :: cape1
     226  REAL, DIMENSION (len), INTENT (OUT)                :: cin1
     227  REAL, DIMENSION (len, nd), INTENT (OUT)            :: tvp1
    221228
    222229!AC!
    … …  
    224231!!      real da(len,nd),phi(len,nd,nd)
    225232!AC!
    226   REAL ftd1(len, nd)
    227   REAL fqd1(len, nd)
    228   REAL Plim11(len)
    229   REAL Plim21(len)
    230   REAL asupmax1(len, nd)
    231   REAL supmax01(len)
    232   REAL asupmaxmin1(len)
    233   INTEGER lalim_conv(len)
    234   REAL qtc1(len, nd)         ! cld
    235   REAL sigt1(len, nd)        ! cld
     233  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ftd1
     234  REAL, DIMENSION (len, nd), INTENT (OUT)            :: fqd1
     235  REAL, DIMENSION (len), INTENT (OUT)                :: Plim11
     236  REAL, DIMENSION (len), INTENT (OUT)                :: Plim21
     237  REAL, DIMENSION (len, nd), INTENT (OUT)            :: asupmax1
     238  REAL, DIMENSION (len), INTENT (OUT)                :: supmax01
     239  REAL, DIMENSION (len), INTENT (OUT)                :: asupmaxmin1
     240  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qtc1            ! cld
     241  REAL, DIMENSION (len, nd), INTENT (OUT)            :: sigt1           ! cld
    236242
    237243! RomP >>>
    238   REAL wdtrainA1(len, nd), wdtrainM1(len, nd)
    239   REAL da1(len, nd), phi1(len, nd, nd), mp1(len, nd)
    240   REAL epmlmMm1(len, nd, nd), eplaMm1(len, nd)
    241   REAL evap1(len, nd), ep1(len, nd)
    242   REAL sigij1(len, nd, nd), elij1(len, nd, nd)
     244  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wdtrainA1, wdtrainM1
     245  REAL, DIMENSION (len, nd), INTENT (OUT)            :: da1, mp1
     246  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi1
     247  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: epmlmMm1
     248  REAL, DIMENSION (len, nd), INTENT (OUT)            :: eplaMm1
     249  REAL, DIMENSION (len, nd), INTENT (OUT)            :: evap1, ep1
     250  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: sigij1, elij1
    243251!JYG,RL
    244   REAL wghti1(len, nd) ! final weight of the feeding layers
     252  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wghti1      ! final weight of the feeding layers
    245253!JYG,RL
    246   REAL phi21(len, nd, nd)
    247   REAL d1a1(len, nd), dam1(len, nd)
     254  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi21
     255  REAL, DIMENSION (len, nd), INTENT (OUT)            :: d1a1, dam1
    248256! RomP <<<
    249257
    … …  
    388396!$OMP THREADPRIVATE(debut)
    389397
     398  REAL coef_convective(len)   ! = 1 for convective points, = 0 otherwise
    390399  REAL tnk1(klon)
    391400  REAL thnk1(klon)
    … …  
    430439
    431440  INTEGER idcum(nloc)
     441!jyg<
     442  LOGICAL compress    ! True if compression occurs
     443!>jyg
    432444  INTEGER iflag(nloc), nk(nloc), icb(nloc)
    433445  INTEGER nent(nloc, klev)
    … …  
    682694!   p2feed1(i)=ph1(i,3)
    683695!testCR: on prend la couche alim des thermiques
    684 !   p2feed1(i)=ph1(i,lalim_conv(i)+1)
     696!   p2feed1(i)=ph1(i,lalim_conv1(i)+1)
    685697!   print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
    686698  END DO
    … …  
    762774! =====================================================================
    763775
     776!  Determine the number "ncum" of convective gridpoints, the list "idcum" of convective
     777!  gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0.
     778!  elsewhere).
    764779  ncum = 0
     780  coef_convective(:) = 0.
    765781  DO i = 1, len
    766782    IF (iflag1(i)==0) THEN
     783      coef_convective(i) = 1.
    767784      ncum = ncum + 1
    768785      idcum(ncum) = i
    … …  
    782799! print*,'ncum tv1 ',ncum,tv1
    783800! print*,'tvp1 ',tvp1
    784       CALL cv3a_compress(len, nloc, ncum, nd, ntra, &
     801!jyg<
     802!   If the fraction of convective points is larger than comp_threshold, then compression
     803!   is assumed useless.
     804!
     805  compress = ncum .lt. len*comp_threshold
     806!
     807  IF (.not. compress) THEN
     808    DO i = 1,len
     809      idcum(i) = i
     810    ENDDO
     811  ENDIF
     812!
     813  print *,' ncum, len, comp_threshold, compress ',ncum, len, comp_threshold, compress
     814!>jyg
     815      CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
    785816                         iflag1, nk1, icb1, icbs1, &
    786817                         plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
    … …  
    837868                         inb, tp, tvp, clw, hp, ep, sigp, buoy, &
    838869                         frac)
    839 
    840870    END IF
    841871
    … …  
    897927                           Plim1, plim2, asupmax, supmax0, &
    898928                           asupmaxmin, cbmf, plfc, wbeff)
    899 
    900929        if (prt_level >= 10) &
    901930             PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
    … …  
    10351064
    10361065    IF (iflag_con==3) THEN
    1037       CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, &
     1066      CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
    10381067                           iflag, icb, inb, &
    10391068                           precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
    … …  
    10781107  END IF ! ncum>0
    10791108
     1109!
     1110! In order take into account the possibility of changing the compression,
     1111! reset m, sig and w0 to zero for non-convective points.
     1112  DO k = 1,nd-1
     1113        sig1(:, k) = sig1(:, k)*coef_convective(:)
     1114        w01(:, k)  = w01(:, k)*coef_convective(:)
     1115  ENDDO
     1116
    10801117  IF (debut) THEN
    10811118    PRINT *, ' cv_compress -> '

  • LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90

    r2243 r2253  
    723723             CALL histwrite_phy(o_dqwak, zx_tmp_fi3d)
    724724          ENDIF ! iflag_wake>=1
    725           CALL histwrite_phy(o_Vprecip, Vprecip)
    726725          CALL histwrite_phy(o_ftd, ftd)
    727726          CALL histwrite_phy(o_fqd, fqd)
    728        ELSEIF (iflag_con.EQ.30) THEN
     727       ENDIF !(iflag_con.EQ.3)
     728       IF (iflag_con.EQ.3.OR.iflag_con.EQ.30) THEN
    729729          ! sortie RomP convection descente insaturee iflag_con=30
     730          ! etendue a iflag_con=3 (jyg)
    730731          CALL histwrite_phy(o_Vprecip, Vprecip)
    731732          CALL histwrite_phy(o_wdtrainA, wdtrainA)
Note: See TracChangeset for help on using the changeset viewer.