Changeset 3758


Ignore:
Timestamp:
Jul 15, 2020, 10:14:33 PM (4 years ago)
Author:
adurocher
Message:

Refactoring and cleaning cv3a_driver

Location:
LMDZ6/branches/Optimisation_LMDZ/libf/phylmd
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Optimisation_LMDZ/libf/phylmd/cv3a_compress.f90

    r3738 r3758  
    2020    integer :: array_count_r = 0 ! number of real arrays
    2121    type(array_r_t) :: arrays_r(2,max_array_count) ! array of real arrays
    22     logical :: arrays_r_init(max_array_count) = .false. ! Should arrays (2,:) be initialized before uncompress?
     22    logical :: arrays_r_init(max_array_count) = .true. ! Should arrays (2,:) be initialized before uncompress?
    2323    integer :: array_count_i = 0 ! number of int arrays
    2424    type(array_i_t) :: arrays_i(2,max_array_count) ! array of int arrays
    25     logical :: arrays_i_init(max_array_count) = .false. ! Should arrays (2,:) be initialized before uncompress?
     25    logical :: arrays_i_init(max_array_count) = .true. ! Should arrays (2,:) be initialized before uncompress?
    2626  end type
    2727 

  • LMDZ6/branches/Optimisation_LMDZ/libf/phylmd/cv3a_driver.f90

    r3757 r3758  
    11module cv3a_driver_mod
    2   contains
    3 
    4 SUBROUTINE cv3a_driver(len, nd, ndp1, ntra, nloc, k_upper, &
    5                       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, &  ! jyg
    7                       delt, comp_threshold, &                                      ! jyg
    8                       t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &          ! jyg
    9                       u1, v1, tra1, &
    10                       p1, ph1, &
    11                       Ale1, Alp1, omega1, &
    12                       sig1feed1, sig2feed1, wght1, &
    13                       iflag1, ft1, fq1, fu1, fv1, ftra1, &
    14                       precip1, kbas1, ktop1, &
    15                       cbmf1, plcl1, plfc1, wbeff1, &
    16                       sig1, w01, & !input/output
    17                       ptop21, sigd1, &
    18                       ma1, mip1, Vprecip1, Vprecipi1, upwd1, dnwd1, dnwd01, &      ! jyg
    19                       qcondc1, wd1, &
    20                       cape1, cin1, tvp1, &
    21                       ftd1, fqd1, &
    22                       Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
    23                       lalim_conv1, &
    24 !!                      da1,phi1,mp1,phi21,d1a1,dam1,sigij1,clw1, &        ! RomP
    25 !!                      elij1,evap1,ep1,epmlmMm1,eplaMm1, &                ! RomP
    26                       da1, phi1, mp1, phi21, d1a1, dam1, sigij1, wghti1, & ! RomP, RL
    27                       qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &  ! RomP, RL
    28                       wdtrainA1, wdtrainS1, wdtrainM1, qtc1, sigt1, tau_cld_cv, &     !!jygprl
    29                       coefw_cld_cv, &                                      ! RomP, AJ
    30                       epmax_diag1)  ! epmax_cape
    31 ! **************************************************************
    32 ! *
    33 ! CV_DRIVER                                                   *
    34 ! *
    35 ! *
    36 ! written by   : Sandrine Bony-Lena , 17/05/2003, 11.19.41    *
    37 ! modified by :                                               *
    38 ! **************************************************************
    39 ! **************************************************************
    40 
    41   USE print_control_mod, ONLY: prt_level, lunout
    42   USE add_phys_tend_mod, ONLY: fl_cor_ebil
    43   USE cv3a_compress_mod
    44   USE cv3p_mixing_mod
    45   IMPLICIT NONE
    46 
    47 ! .............................START PROLOGUE............................
    48 
    49 
    50 ! All argument names (except len,nd,ntra,nloc,delt and the flags) have a "1" appended.
    51 ! The "1" is removed for the corresponding compressed variables.
    52 ! PARAMETERS:
    53 ! Name            Type         Usage            Description
    54 ! ----------      ----------     -------  ----------------------------
    55 
    56 ! len           Integer        Input        first (i) dimension
    57 ! nd            Integer        Input        vertical (k) dimension
    58 ! ndp1          Integer        Input        nd + 1
    59 ! ntra          Integer        Input        number of tracors
    60 ! nloc          Integer        Input        dimension of arrays for compressed fields
    61 ! k_upper       Integer        Input        upmost level for vertical loops
    62 ! iflag_con     Integer        Input        version of convect (3/4)
    63 ! iflag_mix     Integer        Input        version of mixing  (0/1/2)
    64 ! iflag_ice_thermo Integer        Input        accounting for ice thermodynamics (0/1)
    65 ! iflag_clos    Integer        Input        version of closure (0/1)
    66 ! tau_cld_cv    Real           Input        characteristic time of dissipation of mixing fluxes
    67 ! coefw_cld_cv  Real           Input        coefficient for updraft velocity in convection
    68 ! ok_conserv_q  Logical        Input        when true corrections for water conservation are swtiched on
    69 ! delt          Real           Input        time step
    70 ! comp_threshold Real           Input       threshold on the fraction of convective points below which
    71 !                                            fields  are compressed
    72 ! t1            Real           Input        temperature (sat draught envt)
    73 ! q1            Real           Input        specific hum (sat draught envt)
    74 ! qs1           Real           Input        sat specific hum (sat draught envt)
    75 ! t1_wake       Real           Input        temperature (unsat draught envt)
    76 ! q1_wake       Real           Input        specific hum(unsat draught envt)
    77 ! qs1_wake      Real           Input        sat specific hum(unsat draughts envt)
    78 ! s1_wake       Real           Input        fractionnal area covered by wakes
    79 ! u1            Real           Input        u-wind
    80 ! v1            Real           Input        v-wind
    81 ! tra1          Real           Input        tracors
    82 ! p1            Real           Input        full level pressure
    83 ! ph1           Real           Input        half level pressure
    84 ! ALE1          Real           Input        Available lifting Energy
    85 ! ALP1          Real           Input        Available lifting Power
    86 ! sig1feed1     Real           Input        sigma coord at lower bound of feeding layer
    87 ! sig2feed1     Real           Input        sigma coord at upper bound of feeding layer
    88 ! wght1         Real           Input        weight density determining the feeding mixture
    89 ! iflag1        Integer        Output       flag for Emanuel conditions
    90 ! ft1           Real           Output       temp tend
    91 ! fq1           Real           Output       spec hum tend
    92 ! fu1           Real           Output       u-wind tend
    93 ! fv1           Real           Output       v-wind tend
    94 ! ftra1         Real           Output       tracor tend
    95 ! precip1       Real           Output       precipitation
    96 ! kbas1         Integer        Output       cloud base level
    97 ! ktop1         Integer        Output       cloud top level
    98 ! cbmf1         Real           Output       cloud base mass flux
    99 ! sig1          Real           In/Out       section adiabatic updraft
    100 ! w01           Real           In/Out       vertical velocity within adiab updraft
    101 ! ptop21        Real           In/Out       top of entraining zone
    102 ! Ma1           Real           Output       mass flux adiabatic updraft
    103 ! mip1          Real           Output       mass flux shed by the adiabatic updraft
    104 ! Vprecip1      Real           Output       vertical profile of total precipitation
    105 ! Vprecipi1     Real           Output       vertical profile of ice precipitation
    106 ! upwd1         Real           Output       total upward mass flux (adiab+mixed)
    107 ! dnwd1         Real           Output       saturated downward mass flux (mixed)
    108 ! dnwd01        Real           Output       unsaturated downward mass flux
    109 ! qcondc1       Real           Output       in-cld mixing ratio of condensed water
    110 ! wd1           Real           Output       downdraft velocity scale for sfc fluxes
    111 ! cape1         Real           Output       CAPE
    112 ! cin1          Real           Output       CIN
    113 ! tvp1          Real           Output       adiab lifted parcell virt temp
    114 ! ftd1          Real           Output       precip temp tend
    115 ! fqt1          Real           Output       precip spec hum tend
    116 ! Plim11        Real           Output
    117 ! Plim21        Real           Output
    118 ! asupmax1      Real           Output
    119 ! supmax01      Real           Output
    120 ! asupmaxmin1   Real           Output
    121 
    122 ! ftd1          Real           Output  Array of temperature tendency due to precipitations (K/s) of dimension ND,
    123 !                                      defined at same grid levels as T, Q, QS and P.
    124 
    125 ! fqd1          Real           Output  Array of specific humidity tendencies due to precipitations ((gm/gm)/s)
    126 !                                      of dimension ND, defined at same grid levels as T, Q, QS and P.
    127 
    128 ! wdtrainA1     Real           Output   precipitation ejected from adiabatic draught;
    129 !                                         should be used in tracer transport (cvltr)
    130 ! wdtrainS1     Real           Output   precipitation detrained from shedding of adiabatic draught;
    131 !                                         used in tracer transport (cvltr)
    132 ! wdtrainM1     Real           Output   precipitation detrained from mixed draughts;
    133 !                                         used in tracer transport (cvltr)
    134 ! da1           Real           Output     used in tracer transport (cvltr)
    135 ! phi1          Real           Output     used in tracer transport (cvltr)
    136 ! mp1           Real           Output     used in tracer transport (cvltr)
    137 ! qtc1          Real           Output     specific humidity in convection
    138 ! sigt1         Real           Output     surface fraction in adiabatic updrafts                                         
    139 ! phi21         Real           Output     used in tracer transport (cvltr)
    140                                          
    141 ! d1a1          Real           Output     used in tracer transport (cvltr)
    142 ! dam1          Real           Output     used in tracer transport (cvltr)
    143                                          
    144 ! epmlmMm1      Real           Output     used in tracer transport (cvltr)
    145 ! eplaMm1       Real           Output     used in tracer transport (cvltr)
    146                                          
    147 ! evap1         Real           Output   
    148 ! ep1           Real           Output   
    149 ! sigij1        Real           Output     used in tracer transport (cvltr)
    150 ! clw1          Real           Output   condensed water content of the adiabatic updraught
    151 ! elij1         Real           Output
    152 ! wghti1        Real           Output   final weight of the feeding layers,
    153 !                                         used in tracer transport (cvltr)
    154 
    155 
    156 ! S. Bony, Mar 2002:
    157 ! * Several modules corresponding to different physical processes
    158 ! * Several versions of convect may be used:
    159 !         - iflag_con=3: version lmd  (previously named convect3)
    160 !         - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
    161 ! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
    162 ! S. Bony, Oct 2002:
    163 ! * Vectorization of convect3 (ie version lmd)
    164 
    165 ! ..............................END PROLOGUE.............................
    166 
    167 
    168 
    169 ! Input
    170   INTEGER, INTENT (IN)                               :: len
    171   INTEGER, INTENT (IN)                               :: nd
    172   INTEGER, INTENT (IN)                               :: ndp1
    173   INTEGER, INTENT (IN)                               :: ntra
    174   INTEGER, INTENT(IN)                                :: nloc ! (nloc=len)  pour l'instant
    175   INTEGER, INTENT (IN)                               :: k_upper
    176   INTEGER, INTENT (IN)                               :: iflag_con
    177   INTEGER, INTENT (IN)                               :: iflag_mix
    178   INTEGER, INTENT (IN)                               :: iflag_ice_thermo
    179   INTEGER, INTENT (IN)                               :: iflag_clos
    180   LOGICAL, INTENT (IN)                               :: ok_conserv_q
    181   REAL, INTENT (IN)                                  :: tau_cld_cv
    182   REAL, INTENT (IN)                                  :: coefw_cld_cv
    183   REAL, INTENT (IN)                                  :: delt
    184   REAL, INTENT (IN)                                  :: comp_threshold
    185   REAL, DIMENSION (len, nd), INTENT (IN)             :: t1
    186   REAL, DIMENSION (len, nd), INTENT (IN)             :: q1
    187   REAL, DIMENSION (len, nd), INTENT (IN)             :: qs1
    188   REAL, DIMENSION (len, nd), INTENT (IN)             :: t1_wake
    189   REAL, DIMENSION (len, nd), INTENT (IN)             :: q1_wake
    190   REAL, DIMENSION (len, nd), INTENT (IN)             :: qs1_wake
    191   REAL, DIMENSION (len), INTENT (IN)                 :: s1_wake
    192   REAL, DIMENSION (len, nd), INTENT (IN)             :: u1
    193   REAL, DIMENSION (len, nd), INTENT (IN)             :: v1
    194   REAL, DIMENSION (len, nd, ntra), INTENT (IN)       :: tra1
    195   REAL, DIMENSION (len, nd), INTENT (IN)             :: p1
    196   REAL, DIMENSION (len, ndp1), INTENT (IN)           :: ph1
    197   REAL, DIMENSION (len), INTENT (IN)                 :: Ale1
    198   REAL, DIMENSION (len), INTENT (IN)                 :: Alp1
    199   REAL, DIMENSION (len, nd), INTENT (IN)             :: omega1
    200   REAL, INTENT (IN)                                  :: sig1feed1 ! pressure at lower bound of feeding layer
    201   REAL, INTENT (IN)                                  :: sig2feed1 ! pressure at upper bound of feeding layer
    202   REAL, DIMENSION (nd), INTENT (IN)                  :: wght1     ! weight density determining the feeding mixture
    203   INTEGER, DIMENSION (len), INTENT (IN)              :: lalim_conv1
    204 
    205 ! Input/Output
    206   REAL, DIMENSION (len, nd), INTENT (INOUT)          :: sig1
    207   REAL, DIMENSION (len, nd), INTENT (INOUT)          :: w01
    208 
    209 ! Output
    210   INTEGER, DIMENSION (len), INTENT (OUT)             :: iflag1
    211   REAL, DIMENSION (len, nd), INTENT (OUT)            :: ft1
    212   REAL, DIMENSION (len, nd), INTENT (OUT)            :: fq1
    213   REAL, DIMENSION (len, nd), INTENT (OUT)            :: fu1
    214   REAL, DIMENSION (len, nd), INTENT (OUT)            :: fv1
    215   REAL, DIMENSION (len, nd, ntra), INTENT (OUT)      :: ftra1
    216   REAL, DIMENSION (len), INTENT (OUT)                :: precip1
    217   INTEGER, DIMENSION (len), INTENT (OUT)             :: kbas1
    218   INTEGER, DIMENSION (len), INTENT (OUT)             :: ktop1
    219   REAL, DIMENSION (len), INTENT (OUT)                :: cbmf1
    220   REAL, DIMENSION (len), INTENT (OUT)                :: plcl1
    221   REAL, DIMENSION (len), INTENT (OUT)                :: plfc1
    222   REAL, DIMENSION (len), INTENT (OUT)                :: wbeff1
    223   REAL, DIMENSION (len), INTENT (OUT)                :: ptop21
    224   REAL, DIMENSION (len), INTENT (OUT)                :: sigd1
    225   REAL, DIMENSION (len, nd), INTENT (OUT)            :: ma1        ! adiab. asc. mass flux (staggered grid)
    226   REAL, DIMENSION (len, nd), INTENT (OUT)            :: mip1       ! mass flux shed from adiab. ascent (extensive)
    227 ! real Vprecip1(len,nd)
    228   REAL, DIMENSION (len, ndp1), INTENT (OUT)          :: vprecip1   ! tot precipitation flux (staggered grid)
    229   REAL, DIMENSION (len, ndp1), INTENT (OUT)          :: vprecipi1  ! ice precipitation flux (staggered grid)
    230   REAL, DIMENSION (len, nd), INTENT (OUT)            :: upwd1      ! upwd sat. mass flux (staggered grid)
    231   REAL, DIMENSION (len, nd), INTENT (OUT)            :: dnwd1      ! dnwd sat. mass flux (staggered grid)
    232   REAL, DIMENSION (len, nd), INTENT (OUT)            :: dnwd01     ! unsat. mass flux (staggered grid)
    233   REAL, DIMENSION (len, nd), INTENT (OUT)            :: qcondc1    ! max cloud condensate (intensive)  ! cld
    234   REAL, DIMENSION (len), INTENT (OUT)                :: wd1             ! gust
    235   REAL, DIMENSION (len), INTENT (OUT)                :: cape1
    236   REAL, DIMENSION (len), INTENT (OUT)                :: cin1
    237   REAL, DIMENSION (len, nd), INTENT (OUT)            :: tvp1       ! Virt. temp. in the adiab. ascent
    238 
    239 !AC!
    240 !!      real da1(len,nd),phi1(len,nd,nd)
    241 !!      real da(len,nd),phi(len,nd,nd)
    242 !AC!
    243   REAL, DIMENSION (len, nd), INTENT (OUT)            :: ftd1       ! Temp. tendency due to the sole unsat. drafts
    244   REAL, DIMENSION (len, nd), INTENT (OUT)            :: fqd1       ! Moist. tendency due to the sole unsat. drafts
    245   REAL, DIMENSION (len), INTENT (OUT)                :: Plim11
    246   REAL, DIMENSION (len), INTENT (OUT)                :: Plim21
    247   REAL, DIMENSION (len, nd), INTENT (OUT)            :: asupmax1   ! Highest mixing fraction of mixed updraughts
    248   REAL, DIMENSION (len), INTENT (OUT)                :: supmax01
    249   REAL, DIMENSION (len), INTENT (OUT)                :: asupmaxmin1
    250   REAL, DIMENSION (len, nd), INTENT (OUT)            :: qtc1    ! in cloud water content (intensive)   ! cld
    251   REAL, DIMENSION (len, nd), INTENT (OUT)            :: sigt1   ! fract. cloud area (intensive)        ! cld
    252 
    253 ! RomP >>>
    254   REAL, DIMENSION (len, nd), INTENT (OUT)            :: wdtrainA1, wdtrainS1, wdtrainM1 ! precipitation sources (extensive)
    255   REAL, DIMENSION (len, nd), INTENT (OUT)            :: mp1  ! unsat. mass flux (staggered grid)
    256   REAL, DIMENSION (len, nd), INTENT (OUT)            :: da1  ! detrained mass flux of adiab. asc. air (extensive)
    257   REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi1 ! mass flux of envt. air in mixed draughts (extensive)
    258   REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: epmlmMm1  ! (extensive)
    259   REAL, DIMENSION (len, nd), INTENT (OUT)            :: eplaMm1   ! (extensive)
    260   REAL, DIMENSION (len, nd), INTENT (OUT)            :: evap1 ! evaporation rate in precip. downdraft. (intensive)
    261   REAL, DIMENSION (len, nd), INTENT (OUT)            :: ep1
    262   REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: sigij1 ! mass fraction of env. air in mixed draughts (intensive)
    263   REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: elij1! cond. water per unit mass of mixed draughts (intensive)
    264   REAL, DIMENSION (len, nd), INTENT (OUT)            :: qta1 ! total water per unit mass of the adiab. asc. (intensive)
    265   REAL, DIMENSION (len, nd), INTENT (OUT)            :: clw1 ! cond. water per unit mass of the adiab. asc. (intensive)
    266 !JYG,RL
    267   REAL, DIMENSION (len, nd), INTENT (OUT)            :: wghti1   ! final weight of the feeding layers (extensive)
    268 !JYG,RL
    269   REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi21    ! (extensive)
    270   REAL, DIMENSION (len, nd), INTENT (OUT)            :: d1a1     ! (extensive)
    271   REAL, DIMENSION (len, nd), INTENT (OUT)            :: dam1     ! (extensive)
    272 ! RomP <<<
    273   REAL, DIMENSION (len ), INTENT (OUT)               :: epmax_diag1     
     2contains
    2743
    2754! -------------------------------------------------------------------
    … …  
    2798! -------------------------------------------------------------------
    2809! --- On input:
    281 
     10!
    28211! t:   Array of absolute temperature (K) of dimension ND, with first
    28312! index corresponding to lowest model level. Note that this array
    28413! will be altered by the subroutine if dry convective adjustment
    28514! occurs and if IPBL is not equal to 0.
    286 
     15!
    28716! q:   Array of specific humidity (gm/gm) of dimension ND, with first
    28817! index corresponding to lowest model level. Must be defined
    28918! at same grid levels as T. Note that this array will be altered
    29019! if dry convective adjustment occurs and if IPBL is not equal to 0.
    291 
     20!
    29221! qs:  Array of saturation specific humidity of dimension ND, with first
    29322! index corresponding to lowest model level. Must be defined
    29423! at same grid levels as T. Note that this array will be altered
    29524! if dry convective adjustment occurs and if IPBL is not equal to 0.
    296 
     25!
    29726! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
    29827! of dimension ND, with first index corresponding to lowest model level.
    299 
     28!
    30029! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
    30130! of dimension ND, with first index corresponding to lowest model level.
    30231! Must be defined at same grid levels as T.
    303 
     32!
    30433! qs_wake: Array of saturation specific humidity, seen by unsaturated draughts,
    30534! of dimension ND, with first index corresponding to lowest model level.
    30635! Must be defined at same grid levels as T.
    307 
     36!
    30837! s_wake: Array of fractionnal area occupied by the wakes.
    309 
     38!
    31039! u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
    31140! index corresponding with the lowest model level. Defined at
    31241! same levels as T. Note that this array will be altered if
    31342! dry convective adjustment occurs and if IPBL is not equal to 0.
    314 
     43!
    31544! v:   Same as u but for meridional velocity.
    316 
     45!
    31746! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
    31847! where NTRA is the number of different tracers. If no
    … …  
    32150! same vertical levels as T. Note that this array will be altered
    32251! if dry convective adjustment occurs and if IPBL is not equal to 0.
    323 
     52!
    32453! p:   Array of pressure (mb) of dimension ND, with first
    32554! index corresponding to lowest model level. Must be defined
    32655! at same grid levels as T.
    327 
     56!
    32857! ph:  Array of pressure (mb) of dimension ND+1, with first index
    32958! corresponding to lowest level. These pressures are defined at
    … …  
    33160! value of PH should be greater than (i.e. at a lower level than)
    33261! the first value of the array P.
    333 
     62!
    33463! ALE:  Available lifting Energy
    335 
     64!
    33665! ALP:  Available lifting Power
    337 
     66!
    33867! nl:  The maximum number of levels to which convection can penetrate, plus 1.
    33968!       NL MUST be less than or equal to ND-1.
    340 
     69!
    34170! delt: The model time step (sec) between calls to CONVECT
    342 
     71!
    34372! ----------------------------------------------------------------------------
    34473! ---   On Output:
    345 
     74!
    34675! iflag: An output integer whose value denotes the following:
    34776!       VALUE   INTERPRETATION
    … …  
    36493!        10     No moist convection: cloud top is too warm.
    36594!
    366 
     95!
    36796! ft:   Array of temperature tendency (K/s) of dimension ND, defined at same
    36897!       grid levels as T, Q, QS and P.
    369 
     98!
    37099! fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
    371100!       defined at same grid levels as T, Q, QS and P.
    372 
     101!
    373102! fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
    374103!      defined at same grid levels as T.
    375 
     104!
    376105! fv:   Same as FU, but for forcing of meridional velocity.
    377 
     106!
    378107! ftra: Array of forcing of tracer content, in tracer mixing ratio per
    379108!       second, defined at same levels as T. Dimensioned (ND,NTRA).
    380 
     109!
    381110! precip: Scalar convective precipitation rate (mm/day).
    382 
     111!
    383112! wd:   A convective downdraft velocity scale. For use in surface
    384113!       flux parameterizations. See convect.ps file for details.
    385 
     114!
    386115! tprime: A convective downdraft temperature perturbation scale (K).
    387116!         For use in surface flux parameterizations. See convect.ps
    388117!         file for details.
    389 
     118!
    390119! qprime: A convective downdraft specific humidity
    391120!         perturbation scale (gm/gm).
    … …  
    397126!       ITS NEXT CALL. That is, the value of CBMF must be "remembered"
    398127!       by the calling program between calls to CONVECT.
    399 
     128!
    400129! det:   Array of detrainment mass flux of dimension ND.
    401130! -------------------------------------------------------------------
     131! written by   : Sandrine Bony-Lena , 17/05/2003, 11.19.41
     132! S. Bony, Mar 2002:
     133! * Several modules corresponding to different physical processes
     134! * Several versions of convect may be used:
     135!         - iflag_con=3: version lmd  (previously named convect3)
     136!         - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
     137! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
     138! S. Bony, Oct 2002:
     139! * Vectorization of convect3 (ie version lmd)
     140  SUBROUTINE cv3a_driver(len, nd, ndp1, ntra, nloc, k_upper, &
     141                         iflag_con, iflag_mix, iflag_ice_thermo, iflag_clos, ok_conserv_q, &
     142                         delt, &
     143                         t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
     144                         u1, v1, &
     145                         p1, ph1, &
     146                         Ale1, Alp1, omega1, &
     147                         sig1feed1, sig2feed1, wght1, &
     148                         iflag1, ft1, fq1, fu1, fv1, ftra1, &
     149                         precip1, kbas1, ktop1, &
     150                         cbmf1, plcl1, plfc1, wbeff1, &
     151                         sig1, w01, & !input/output
     152                         ptop21, sigd1, &
     153                         ma1, mip1, Vprecip1, Vprecipi1, upwd1, dnwd1, dnwd01, &
     154                         qcondc1, wd1, &
     155                         cape1, cin1, tvp1, &
     156                         ftd1, fqd1, &
     157                         Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
     158                         da1, phi1, mp1, phi21, d1a1, dam1, sigij1, wghti1, &
     159                         qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &
     160                         wdtrainA1, wdtrainS1, wdtrainM1, qtc1, sigt1, tau_cld_cv, &
     161                         coefw_cld_cv, &
     162                         epmax_diag1)
     163
     164    USE print_control_mod, ONLY: prt_level, lunout
     165    USE cv3a_compress_mod
     166    USE cv3p_mixing_mod, ONLY : cv3p_mixing
     167    IMPLICIT NONE
     168! Input
     169    INTEGER, INTENT(IN)                               :: len ! first (i) dimension
     170    INTEGER, INTENT(IN)                               :: nd ! vertical (k) dimension
     171    INTEGER, INTENT(IN)                               :: ndp1 ! nd + 1
     172    INTEGER, INTENT(IN)                               :: ntra ! number of tracors
     173    INTEGER, INTENT(IN)                                :: nloc ! dimension of arrays for compressed fields (nloc=len) pour l'instant
     174    INTEGER, INTENT(IN)                               :: k_upper ! upmost level for vertical loops
     175    INTEGER, INTENT(IN)                               :: iflag_con ! version of convect (3)
     176    INTEGER, INTENT(IN)                               :: iflag_mix ! version of mixing  (0/1/2)
     177    INTEGER, INTENT(IN)                               :: iflag_ice_thermo ! accounting for ice thermodynamics (0/1)
     178    INTEGER, INTENT(IN)                               :: iflag_clos ! version of closure (0/1)
     179    LOGICAL, INTENT(IN)                               :: ok_conserv_q ! when true corrections for water conservation are swtiched on
     180    REAL, INTENT(IN)                                  :: tau_cld_cv ! characteristic time of dissipation of mixing fluxes
     181    REAL, INTENT(IN)                                  :: coefw_cld_cv ! coefficient for updraft velocity in convection
     182    REAL, INTENT(IN)                                  :: delt ! time step
     183    REAL, DIMENSION(len, nd), INTENT(IN)             :: t1 ! temperature (sat draught envt)
     184    REAL, DIMENSION(len, nd), INTENT(IN)             :: q1 ! specific hum (sat draught envt)
     185    REAL, DIMENSION(len, nd), INTENT(IN)             :: qs1 ! sat specific hum (sat draught envt)
     186    REAL, DIMENSION(len, nd), INTENT(IN)             :: t1_wake ! temperature (unsat draught envt)
     187    REAL, DIMENSION(len, nd), INTENT(IN)             :: q1_wake ! specific hum(unsat draught envt)
     188    REAL, DIMENSION(len, nd), INTENT(IN)             :: qs1_wake ! sat specific hum(unsat draughts envt)
     189    REAL, DIMENSION(len), INTENT(IN)                 :: s1_wake ! fractionnal area covered by wakes
     190    REAL, DIMENSION(len, nd), INTENT(IN)             :: u1 ! u-wind
     191    REAL, DIMENSION(len, nd), INTENT(IN)             :: v1 ! v-wind
     192    REAL, DIMENSION(len, nd), INTENT(IN)             :: p1 ! full level pressure
     193    REAL, DIMENSION(len, ndp1), INTENT(IN)           :: ph1 ! half level pressure
     194    REAL, DIMENSION(len), INTENT(IN)                 :: Ale1 ! Available lifting Energy
     195    REAL, DIMENSION(len), INTENT(IN)                 :: Alp1 ! Available lifting Power
     196    REAL, DIMENSION(len, nd), INTENT(IN)             :: omega1
     197    REAL, INTENT(IN)                                  :: sig1feed1 ! sigma coord/pressure at lower bound of feeding layer
     198    REAL, INTENT(IN)                                  :: sig2feed1 ! sigma coord/pressure at upper bound of feeding layer
     199    REAL, DIMENSION(nd), INTENT(IN)                  :: wght1     ! weight density determining the feeding mixture
     200
     201! Input/Output
     202    REAL, DIMENSION(len, nd), INTENT(INOUT)          :: sig1 ! section adiabatic updraft
     203    REAL, DIMENSION(len, nd), INTENT(INOUT)          :: w01 ! vertical velocity within adiab updraft
     204
     205! Output
     206    INTEGER, DIMENSION(len), INTENT(OUT)             :: iflag1 ! flag for Emanuel conditions
     207    REAL, DIMENSION(len, nd), INTENT(OUT)            :: ft1 ! temp tend
     208    REAL, DIMENSION(len, nd), INTENT(OUT)            :: fq1 ! spec hum tend
     209    REAL, DIMENSION(len, nd), INTENT(OUT)            :: fu1 ! u-wind tend
     210    REAL, DIMENSION(len, nd), INTENT(OUT)            :: fv1 ! v-wind tend
     211    REAL, DIMENSION(len, nd, ntra), INTENT(OUT)      :: ftra1 ! tracor tend
     212    REAL, DIMENSION(len), INTENT(OUT)                :: precip1 ! precipitation
     213    INTEGER, DIMENSION(len), INTENT(OUT)             :: kbas1 ! cloud base level
     214    INTEGER, DIMENSION(len), INTENT(OUT)             :: ktop1 ! cloud top level
     215    REAL, DIMENSION(len), INTENT(OUT)                :: cbmf1 ! cloud base mass flux
     216    REAL, DIMENSION(len), INTENT(OUT)                :: plcl1
     217    REAL, DIMENSION(len), INTENT(OUT)                :: plfc1
     218    REAL, DIMENSION(len), INTENT(OUT)                :: wbeff1
     219    REAL, DIMENSION(len), INTENT(OUT)                :: ptop21 ! top of entraining zone
     220    REAL, DIMENSION(len), INTENT(OUT)                :: sigd1
     221    REAL, DIMENSION(len, nd), INTENT(OUT)            :: ma1        ! mass flux adiabatic updraft (staggered grid)
     222    REAL, DIMENSION(len, nd), INTENT(OUT)            :: mip1       ! mass flux shed by the adiabatic updraft (extensive)
     223    REAL, DIMENSION(len, ndp1), INTENT(OUT)          :: vprecip1   ! vertical profile of total precipitation (staggered grid)
     224    REAL, DIMENSION(len, ndp1), INTENT(OUT)          :: vprecipi1  ! vertical profile of ice precipitation (staggered grid)
     225    REAL, DIMENSION(len, nd), INTENT(OUT)            :: upwd1      ! total upward mass flux (adiab+mixed) (staggered grid)
     226    REAL, DIMENSION(len, nd), INTENT(OUT)            :: dnwd1      ! saturated downward mass flux (mixed) (staggered grid)
     227    REAL, DIMENSION(len, nd), INTENT(OUT)            :: dnwd01     ! unsaturated downward mass flux (staggered grid)
     228    REAL, DIMENSION(len, nd), INTENT(OUT)            :: qcondc1    ! in-cld mixing ratio of condensed water (intensive)
     229    REAL, DIMENSION(len), INTENT(OUT)                :: wd1        ! downdraft velocity scale for sfc fluxes
     230    REAL, DIMENSION(len), INTENT(OUT)                :: cape1
     231    REAL, DIMENSION(len), INTENT(OUT)                :: cin1
     232    REAL, DIMENSION(len, nd), INTENT(OUT)            :: tvp1       ! adiab lifted parcell virt temp
     233    REAL, DIMENSION(len, nd), INTENT(OUT)            :: ftd1       ! temperature tendency due to precipitations (K/s)
     234    REAL, DIMENSION(len, nd), INTENT(OUT)            :: fqd1       ! specific humidity tendencies due to precipitations ((gm/gm)/s)
     235    REAL, DIMENSION(len), INTENT(OUT)                :: Plim11
     236    REAL, DIMENSION(len), INTENT(OUT)                :: Plim21
     237    REAL, DIMENSION(len, nd), INTENT(OUT)            :: asupmax1   ! Highest mixing fraction of mixed updraughts
     238    REAL, DIMENSION(len), INTENT(OUT)                :: supmax01
     239    REAL, DIMENSION(len), INTENT(OUT)                :: asupmaxmin1
     240    REAL, DIMENSION(len, nd), INTENT(OUT)            :: qtc1    ! in cloud water content / specific humidity in convection (intensive)
     241    REAL, DIMENSION(len, nd), INTENT(OUT)            :: sigt1   ! surface fraction in adiabatic updrafts / fract. cloud area (intensive)
     242    REAL, DIMENSION(len, nd), INTENT(OUT)            :: wdtrainA1 ! precipitation ejected from adiabatic draught
     243    REAL, DIMENSION(len, nd), INTENT(OUT)            :: wdtrainS1 ! precipitation detrained from shedding of adiabatic draught
     244    REAL, DIMENSION(len, nd), INTENT(OUT)            :: wdtrainM1 ! precipitation detrained from mixed draughts
     245    REAL, DIMENSION(len, nd), INTENT(OUT)            :: mp1  ! unsat. mass flux (staggered grid)
     246    REAL, DIMENSION(len, nd), INTENT(OUT)            :: da1  ! detrained mass flux of adiab. asc. air (extensive)
     247    REAL, DIMENSION(len, nd, nd), INTENT(OUT)        :: phi1 ! mass flux of envt. air in mixed draughts (extensive)
     248    REAL, DIMENSION(len, nd, nd), INTENT(OUT)        :: epmlmMm1  ! (extensive)
     249    REAL, DIMENSION(len, nd), INTENT(OUT)            :: eplaMm1   ! (extensive)
     250    REAL, DIMENSION(len, nd), INTENT(OUT)            :: evap1 ! evaporation rate in precip. downdraft. (intensive)
     251    REAL, DIMENSION(len, nd), INTENT(OUT)            :: ep1
     252    REAL, DIMENSION(len, nd, nd), INTENT(OUT)        :: sigij1 ! mass fraction of env. air in mixed draughts (intensive)
     253    REAL, DIMENSION(len, nd, nd), INTENT(OUT)        :: elij1! cond. water per unit mass of mixed draughts (intensive)
     254    REAL, DIMENSION(len, nd), INTENT(OUT)            :: qta1 ! total water per unit mass of the adiab. asc. (intensive)
     255    REAL, DIMENSION(len, nd), INTENT(OUT)            :: clw1 ! condensed water content of the adiabatic updraught / cond. water per unit mass of the adiab. asc. (intensive)
     256    REAL, DIMENSION(len, nd), INTENT(OUT)            :: wghti1   ! final weight of the feeding layers (extensive)
     257    REAL, DIMENSION(len, nd, nd), INTENT(OUT)        :: phi21    ! (extensive)
     258    REAL, DIMENSION(len, nd), INTENT(OUT)            :: d1a1     ! (extensive)
     259    REAL, DIMENSION(len, nd), INTENT(OUT)            :: dam1     ! (extensive)
     260    REAL, DIMENSION(len), INTENT(OUT)               :: epmax_diag1
    402261
    403262! Local (non compressed) arrays
    404 
    405 
    406   INTEGER i, k, il
    407   INTEGER nword1, nword2, nword3, nword4
    408   INTEGER icbmax
    409   INTEGER nk1(len)
    410   INTEGER icb1(len)
    411   INTEGER icbs1(len)
    412 
    413   LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
    414   LOGICAL, SAVE :: debut = .TRUE.
    415 !$OMP THREADPRIVATE(debut)
    416 
    417   REAL coef_convective(len)   ! = 1 for convective points, = 0 otherwise
    418   REAL tnk1(len)
    419   REAL thnk1(len)
    420   REAL qnk1(len)
    421   REAL gznk1(len)
    422   REAL qsnk1(len)
    423   REAL unk1(len)
    424   REAL vnk1(len)
    425   REAL cpnk1(len)
    426   REAL hnk1(len)
    427   REAL pbase1(len)
    428   REAL buoybase1(len)
    429 
    430   REAL lf1(len, nd), lf1_wake(len, nd)
    431   REAL lv1(len, nd), lv1_wake(len, nd)
    432   REAL cpn1(len, nd), cpn1_wake(len, nd)
    433   REAL tv1(len, nd), tv1_wake(len, nd)
    434   REAL gz1(len, nd), gz1_wake(len, nd)
    435   REAL hm1(len, nd)
    436   REAL h1(len, nd), h1_wake(len, nd)
    437   REAL tp1(len, nd)
    438   REAL th1(len, nd), th1_wake(len, nd)
    439 
    440   REAL bid(len, nd) ! dummy array
    441 
    442   INTEGER ncum
    443 
    444   REAL p1feed1(len) ! pressure at lower bound of feeding layer
    445   REAL p2feed1(len) ! pressure at upper bound of feeding layer
    446 !JYG,RL
    447 !!      real wghti1(len,nd) ! weights of the feeding layers
    448 !JYG,RL
     263    INTEGER i, k, il
     264    INTEGER icbmax
     265    INTEGER nk1(len)
     266    INTEGER icb1(len)
     267    INTEGER icbs1(len)
     268
     269    LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
     270    LOGICAL, SAVE :: debut = .TRUE.
     271!$omp THREADPRIVATE(debut)
     272
     273    REAL tnk1(len)
     274    REAL thnk1(len)
     275    REAL qnk1(len)
     276    REAL gznk1(len)
     277    REAL qsnk1(len)
     278    REAL unk1(len)
     279    REAL vnk1(len)
     280    REAL cpnk1(len)
     281    REAL hnk1(len)
     282    REAL pbase1(len)
     283    REAL buoybase1(len)
     284
     285    REAL lf1(len, nd), lf1_wake(len, nd)
     286    REAL lv1(len, nd), lv1_wake(len, nd)
     287    REAL cpn1(len, nd), cpn1_wake(len, nd)
     288    REAL tv1(len, nd), tv1_wake(len, nd)
     289    REAL gz1(len, nd), gz1_wake(len, nd)
     290    REAL hm1(len, nd)
     291    REAL h1(len, nd), h1_wake(len, nd)
     292    REAL tp1(len, nd)
     293    REAL th1(len, nd), th1_wake(len, nd)
     294
     295    REAL bid(len, nd) ! dummy array
     296
     297    INTEGER ncum
     298
     299    REAL p1feed1(len) ! pressure at lower bound of feeding layer
     300    REAL p2feed1(len) ! pressure at upper bound of feeding layer
    449301
    450302! (local) compressed fields:
    451 
    452 
    453   INTEGER idcum(nloc)
    454 !jyg<
    455   LOGICAL compress    ! True if compression occurs
    456 !>jyg
    457   INTEGER iflag(nloc), nk(nloc), icb(nloc)
    458   INTEGER nent(nloc, nd)
    459   INTEGER icbs(nloc)
    460   INTEGER inb(nloc), inbis(nloc)
    461 
    462   REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
    463   REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd)
    464   REAL t_wake(nloc, nd), q_wake(nloc, nd), qs_wake(nloc, nd)
    465   REAL s_wake(nloc)
    466   REAL u(nloc, nd), v(nloc, nd)
    467   REAL gz(nloc, nd), h(nloc, nd)
    468   REAL h_wake(nloc, nd)
    469   REAL lv(nloc, nd), lf(nloc, nd), cpn(nloc, nd)
    470   REAL lv_wake(nloc, nd), lf_wake(nloc, nd), cpn_wake(nloc, nd)
    471   REAL p(nloc, nd), ph(nloc, nd+1), tv(nloc, nd), tp(nloc, nd)
    472   REAL tv_wake(nloc, nd)
    473   REAL clw(nloc, nd)
    474   REAL, DIMENSION(nloc, nd)    :: qta, qpreca                       !!jygprl
    475   REAL dph(nloc, nd)
    476   REAL pbase(nloc), buoybase(nloc), th(nloc, nd)
    477   REAL th_wake(nloc, nd)
    478   REAL tvp(nloc, nd)
    479   REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc)
    480   REAL hp(nloc, nd), ep(nloc, nd), sigp(nloc, nd)
    481   REAL buoy(nloc, nd)
    482   REAL cape(nloc)
    483   REAL cin(nloc)
    484   REAL m(nloc, nd)
    485   REAL mm(nloc, nd)
    486   REAL ment(nloc, nd, nd), sigij(nloc, nd, nd)
    487   REAL qent(nloc, nd, nd)
    488   REAL hent(nloc, nd, nd)
    489   REAL uent(nloc, nd, nd), vent(nloc, nd, nd)
    490   REAL ments(nloc, nd, nd), qents(nloc, nd, nd)
    491   REAL elij(nloc, nd, nd)
    492   REAL supmax(nloc, nd)
    493   REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
    494   REAL omega(nloc,nd)
    495   REAL sigd(nloc)
    496 ! real mp(nloc,nd), qp(nloc,nd), up(nloc,nd), vp(nloc,nd)
    497 ! real wt(nloc,nd), water(nloc,nd), evap(nloc,nd), ice(nloc,nd)
    498 ! real b(nloc,nd), sigd(nloc)
    499 ! save mp,qp,up,vp,wt,water,evap,b
    500   REAL, DIMENSION(len,nd)     :: mp, qp, up, vp
    501   REAL, DIMENSION(len,nd)     :: wt, water, evap
    502   REAL, DIMENSION(len,nd)     :: ice, fondue, b
    503   REAL, DIMENSION(len,nd)     :: frac_a, frac_s, faci               !!jygprl
    504   REAL ft(nloc, nd), fq(nloc, nd)
    505   REAL ftd(nloc, nd), fqd(nloc, nd)
    506   REAL fu(nloc, nd), fv(nloc, nd)
    507   REAL upwd(nloc, nd), dnwd(nloc, nd), dnwd0(nloc, nd)
    508   REAL ma(nloc, nd), mip(nloc, nd)
    509 !!  REAL tls(nloc, nd), tps(nloc, nd)                 ! unused . jyg
    510   REAL qprime(nloc), tprime(nloc)
    511   REAL precip(nloc)
    512 ! real Vprecip(nloc,nd)
    513   REAL vprecip(nloc, nd+1)
    514   REAL vprecipi(nloc, nd+1)
    515   REAL tra(nloc, nd, ntra), trap(nloc, nd, ntra)
    516   REAL ftra(nloc, nd, ntra), traent(nloc, nd, nd, ntra)
    517   REAL qcondc(nloc, nd)      ! cld
    518   REAL wd(nloc)                ! gust
    519   REAL Plim1(nloc), plim2(nloc)
    520   REAL asupmax(nloc, nd)
    521   REAL supmax0(nloc)
    522   REAL asupmaxmin(nloc)
    523 
    524   REAL tnk(nloc), qnk(nloc), gznk(nloc)
    525   REAL wghti(nloc, nd)
    526   REAL hnk(nloc), unk(nloc), vnk(nloc)
    527 
    528   REAL qtc(nloc, nd)         ! cld
    529   REAL sigt(nloc, nd)        ! cld
    530  
    531 ! RomP >>>
    532   REAL wdtrainA(nloc, nd), wdtrainS(nloc, nd), wdtrainM(nloc, nd)   !!jygprl
    533   REAL da(len, nd), phi(len, nd, nd)
    534   REAL epmlmMm(nloc, nd, nd), eplaMm(nloc, nd)
    535   REAL phi2(len, nd, nd)
    536   REAL d1a(len, nd), dam(len, nd)
    537 ! RomP <<<
    538   REAL epmax_diag(nloc) ! epmax_cape
    539 
    540   CHARACTER (LEN=20) :: modname = 'cva_driver'
    541   CHARACTER (LEN=80) :: abort_message
    542 
    543   INTEGER,SAVE                                       :: igout=1
    544 !$OMP THREADPRIVATE(igout)
    545 
    546   type(compress_data_t) :: compress_data
    547   type(array_list) :: cv3a_compress_list, cv3a_uncompress_list
    548 
    549 ! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,nd)
    550 ! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,nd)
     303    LOGICAL compress    ! True if compression occurs
     304    INTEGER iflag(nloc), nk(nloc), icb(nloc)
     305    INTEGER nent(nloc, nd)
     306    INTEGER icbs(nloc)
     307    INTEGER inb(nloc)
     308
     309    REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
     310    REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd)
     311    REAL t_wake(nloc, nd), q_wake(nloc, nd), qs_wake(nloc, nd)
     312    REAL s_wake(nloc)
     313    REAL u(nloc, nd), v(nloc, nd)
     314    REAL gz(nloc, nd), h(nloc, nd)
     315    REAL h_wake(nloc, nd)
     316    REAL lv(nloc, nd), lf(nloc, nd), cpn(nloc, nd)
     317    REAL lv_wake(nloc, nd), lf_wake(nloc, nd), cpn_wake(nloc, nd)
     318    REAL p(nloc, nd), ph(nloc, nd + 1), tv(nloc, nd), tp(nloc, nd)
     319    REAL tv_wake(nloc, nd)
     320    REAL clw(nloc, nd)
     321    REAL, DIMENSION(nloc, nd)    :: qta, qpreca
     322    REAL pbase(nloc), buoybase(nloc), th(nloc, nd)
     323    REAL th_wake(nloc, nd)
     324    REAL tvp(nloc, nd)
     325    REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc)
     326    REAL hp(nloc, nd), ep(nloc, nd), sigp(nloc, nd)
     327    REAL buoy(nloc, nd)
     328    REAL cape(nloc)
     329    REAL cin(nloc)
     330    REAL m(nloc, nd)
     331    REAL mm(nloc, nd)
     332    REAL ment(nloc, nd, nd), sigij(nloc, nd, nd)
     333    REAL qent(nloc, nd, nd)
     334    REAL hent(nloc, nd, nd)
     335    REAL uent(nloc, nd, nd), vent(nloc, nd, nd)
     336    REAL ments(nloc, nd, nd), qents(nloc, nd, nd)
     337    REAL elij(nloc, nd, nd)
     338    REAL supmax(nloc, nd)
     339    REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
     340    REAL omega(nloc, nd)
     341    REAL sigd(nloc)
     342    REAL, DIMENSION(len, nd)     :: mp, qp, up, vp
     343    REAL, DIMENSION(len, nd)     :: wt, water, evap
     344    REAL, DIMENSION(len, nd)     :: ice, fondue, b
     345    REAL, DIMENSION(len, nd)     :: frac_a, frac_s, faci
     346    REAL ft(nloc, nd), fq(nloc, nd)
     347    REAL ftd(nloc, nd), fqd(nloc, nd)
     348    REAL fu(nloc, nd), fv(nloc, nd)
     349    REAL upwd(nloc, nd), dnwd(nloc, nd), dnwd0(nloc, nd)
     350    REAL ma(nloc, nd), mip(nloc, nd)
     351    REAL precip(nloc)
     352    REAL vprecip(nloc, nd + 1)
     353    REAL vprecipi(nloc, nd + 1)
     354    REAL tra(nloc, nd, ntra), trap(nloc, nd, ntra)
     355    REAL ftra(nloc, nd, ntra), traent(nloc, nd, nd, ntra)
     356    REAL qcondc(nloc, nd)
     357    REAL wd(nloc)
     358    REAL Plim1(nloc), plim2(nloc)
     359    REAL asupmax(nloc, nd)
     360    REAL supmax0(nloc)
     361    REAL asupmaxmin(nloc)
     362
     363    REAL tnk(nloc), qnk(nloc), gznk(nloc)
     364    REAL wghti(nloc, nd)
     365    REAL hnk(nloc), unk(nloc), vnk(nloc)
     366
     367    REAL qtc(nloc, nd)
     368    REAL sigt(nloc, nd)
     369
     370    REAL wdtrainA(nloc, nd), wdtrainS(nloc, nd), wdtrainM(nloc, nd)
     371    REAL da(len, nd), phi(len, nd, nd)
     372    REAL epmlmMm(nloc, nd, nd), eplaMm(nloc, nd)
     373    REAL phi2(len, nd, nd)
     374    REAL d1a(len, nd), dam(len, nd)
     375    REAL epmax_diag(nloc) ! epmax_cape
     376
     377    CHARACTER(LEN=20) :: modname = 'cva_driver'
     378    CHARACTER(LEN=80) :: abort_message
     379
     380    INTEGER, SAVE :: igout = 1
     381!$omp THREADPRIVATE(igout)
     382
     383    type(compress_data_t) :: compress_data
     384    type(array_list) :: cv3a_compress_list, cv3a_uncompress_list
     385
     386    if (iflag_con /= 3) call abort_physic("cv3a_driver", "iflag_con must be 3", 1)
    551387
    552388! -------------------------------------------------------------------
    553389! --- SET CONSTANTS AND PARAMETERS
    554390! -------------------------------------------------------------------
    555 
    556391! -- set simulation flags:
    557 ! (common cvflag)
    558 
    559   CALL cv_flag(iflag_ice_thermo)
    560 
     392! (common cvflag
     393    CALL cv_flag(iflag_ice_thermo)
    561394! -- set thermodynamical constants:
    562395! (common cvthermo)
    563 
    564   CALL cv_thermo(iflag_con)
    565 
     396    CALL cv_thermo(iflag_con)
    566397! -- set convect parameters
    567 
    568398! includes microphysical parameters and parameters that
    569399! control the rate of approach to quasi-equilibrium)
    570400! (common cvparam)
    571 
    572   IF (iflag_con==3) THEN
    573401    CALL cv3_param(nd, k_upper, delt)
    574402
    575   END IF
    576 
    577   IF (iflag_con==4) THEN
    578     CALL cv_param(nd)
    579   END IF
    580 
    581 ! ---------------------------------------------------------------------
    582 ! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
    583 ! ---------------------------------------------------------------------
    584   nword1 = len
    585   nword2 = len*nd
    586   nword3 = len*nd*ntra
    587   nword4 = len*nd*nd
    588 
    589   iflag1(:) = 0
    590   ktop1(:) = 0
    591   kbas1(:) = 0
    592   ft1(:, :) = 0.0
    593   fq1(:, :) = 0.0
    594   fu1(:, :) = 0.0
    595   fv1(:, :) = 0.0
    596   ftra1(:, :, :) = 0.
    597   precip1(:) = 0.
    598   cbmf1(:) = 0.
    599   plcl1(:) = 0.
    600   plfc1(:) = 0.
    601   wbeff1(:) = 0.
    602   ptop21(:) = 0.
    603   sigd1(:) = 0.
    604   ma1(:, :) = 0.
    605   mip1(:, :) = 0.
    606   vprecip1(:, :) = 0.
    607   vprecipi1(:, :) = 0.
    608   upwd1(:, :) = 0.
    609   dnwd1(:, :) = 0.
    610   dnwd01(:, :) = 0.
    611   qcondc1(:, :) = 0.
    612   wd1(:) = 0.
    613   cape1(:) = 0.
    614   cin1(:) = 0.
    615   tvp1(:, :) = 0.
    616   ftd1(:, :) = 0.
    617   fqd1(:, :) = 0.
    618   Plim11(:) = 0.
    619   Plim21(:) = 0.
    620   asupmax1(:, :) = 0.
    621   supmax01(:) = 0.
    622   asupmaxmin1(:) = 0.
    623 
    624   tvp(:, :) = 0. !ym missing init, need to have a look by developpers
    625   tv(:, :) = 0. !ym missing init, need to have a look by developpers
    626 
    627   DO il = 1, len
    628     cin1(il) = -100000.
    629     cape1(il) = -1.
    630   END DO
    631 
    632 !!  IF (iflag_con==3) THEN
    633 !!    DO il = 1, len
    634 !!      sig1(il, nd) = sig1(il, nd) + 1.
    635 !!      sig1(il, nd) = amin1(sig1(il,nd), 12.1)
    636 !!    END DO
    637 !!  END IF
    638 
    639   IF (iflag_con==3) THEN
    640       CALL cv3_incrcount(len,nd,delt,sig1)
    641   END IF  ! (iflag_con==3)
    642 
    643 ! RomP >>>
    644   sigt1(:, :) = 0.
    645   qtc1(:, :) = 0.
    646   wdtrainA1(:, :) = 0.
    647   wdtrainS1(:, :) = 0.
    648   wdtrainM1(:, :) = 0.
    649   da1(:, :) = 0.
    650   phi1(:, :, :) = 0.
    651   epmlmMm1(:, :, :) = 0.
    652   eplaMm1(:, :) = 0.
    653   mp1(:, :) = 0.
    654   evap1(:, :) = 0.
    655   ep1(:, :) = 0.
    656   sigij1(:, :, :) = 0.
    657   elij1(:, :, :) = 0.
    658   qta1(:,:) = 0.
    659   clw1(:,:) = 0.
    660   wghti1(:,:) = 0.
    661   phi21(:, :, :) = 0.
    662   d1a1(:, :) = 0.
    663   dam1(:, :) = 0.
    664 ! RomP <<<
     403    CALL cv3_incrcount(len, nd, delt, sig1)
     404
    665405! ---------------------------------------------------------------------
    666406! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
    667407! ---------------------------------------------------------------------
    668408
    669   DO il = 1, nloc
    670     coef_clos(il) = 1.
    671   END DO
     409    DO il = 1, nloc
     410      coef_clos(il) = 1.
     411    END DO
    672412
    673413! --------------------------------------------------------------------
    … …  
    675415! --------------------------------------------------------------------
    676416
    677   IF (iflag_con==3) THEN
    678 
    679     IF (debut) THEN
    680       PRINT *, 'Emanuel version 3 nouvelle'
    681     END IF
    682 ! print*,'t1, q1 ',t1,q1
    683         if (prt_level >= 9) &
    684              PRINT *, 'cva_driver -> cv3_prelim'
    685     CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, &           ! nd->na
     417    IF (debut) PRINT *, 'Emanuel version 3 nouvelle'
     418
     419    call driver_log('cv3_prelim')
     420    CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
    686421                    lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
    687422
    688 
    689         if (prt_level >= 9) &
    690              PRINT *, 'cva_driver -> cv3_prelim'
    691     CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
     423    call driver_log('cv3_prelim')
     424    CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, &
    692425                    lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
    693426                    h1_wake, bid, th1_wake)
    694 
    695   END IF
    696 
    697   IF (iflag_con==4) THEN
    698     PRINT *, 'Emanuel version 4 '
    699         if (prt_level >= 9) &
    700              PRINT *, 'cva_driver -> cv_prelim'
    701     CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
    702                    lv1, cpn1, tv1, gz1, h1, hm1)
    703   END IF
    704427
    705428! --------------------------------------------------------------------
    706429! --- CONVECTIVE FEED
    707430! --------------------------------------------------------------------
    708 
    709431! compute feeding layer potential temperature and mixing ratio :
    710 
    711432! get bounds of feeding layer
    712 
    713433! test niveaux couche alimentation KE
    714   IF (sig1feed1==sig2feed1) THEN
    715     WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
    716     WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
    717     abort_message = ''
    718     CALL abort_physic(modname, abort_message, 1)
    719   END IF
    720 
    721   DO i = 1, len
    722     p1feed1(i) = sig1feed1*ph1(i, 1)
    723     p2feed1(i) = sig2feed1*ph1(i, 1)
    724 !test maf
    725 !   p1feed1(i)=ph1(i,1)
    726 !   p2feed1(i)=ph1(i,2)
    727 !   p2feed1(i)=ph1(i,3)
    728 !testCR: on prend la couche alim des thermiques
    729 !   p2feed1(i)=ph1(i,lalim_conv1(i)+1)
    730 !   print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
    731   END DO
    732 
    733   IF (iflag_con==3) THEN
    734   END IF
    735   DO i = 1, len
    736 ! print*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
    737   END DO
    738   IF (iflag_con==3) THEN
    739 
    740 ! print*, 'IFLAG1 avant cv3_feed'
    741 ! print*,'len,nd',len,nd
    742 ! write(*,'(64i1)') iflag1(2:len-1)
    743 
    744         if (prt_level >= 9) &
    745              PRINT *, 'cva_driver -> cv3_feed'
    746     CALL cv3_feed(len, nd, ok_conserv_q, &                 ! nd->na
    747                   t1, q1, u1, v1, p1, ph1, h1, gz1, &
     434    IF (sig1feed1 == sig2feed1) THEN
     435      WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
     436      WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
     437      abort_message = ''
     438      CALL abort_physic(modname, abort_message, 1)
     439    END IF
     440
     441    DO i = 1, len
     442      p1feed1(i) = sig1feed1*ph1(i, 1)
     443      p2feed1(i) = sig2feed1*ph1(i, 1)
     444    END DO
     445
     446    call driver_log('cv3_feed')
     447
     448    ! GLITCHY : arrays are set to zero but are intent(out) in call to cv3_feed
     449    iflag1(:) = 0
     450    plcl1(:) = 0.
     451    wghti1(:, :) = 0.
     452    CALL cv3_feed(len, nd, ok_conserv_q, &
     453                  t1, q1, u1, v1, p1, ph1, h1, gz1, &
    748454                  p1feed1, p2feed1, wght1, &
    749455                  wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
    750456                  cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
    751   END IF
    752 
    753 ! print*, 'IFLAG1 apres cv3_feed'
    754 ! print*,'len,nd',len,nd
    755 ! write(*,'(64i1)') iflag1(2:len-1)
    756 
    757   IF (iflag_con==4) THEN
    758         if (prt_level >= 9) &
    759              PRINT *, 'cva_driver -> cv_feed'
    760     CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
    761                  nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
    762   END IF
    763 
    764 ! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
    765457
    766458! --------------------------------------------------------------------
    … …  
    770462! actual temperature, and the adiabatic liquid water content.
    771463! --------------------------------------------------------------------
    772 
    773   IF (iflag_con==3) THEN
    774 
    775         if (prt_level >= 9) &
    776              PRINT *, 'cva_driver -> cv3_undilute1'
     464    call driver_log('cv3_undilute1')
     465    ! GLITCHY : arrays are set to zero but are intent(out) in call to cv3_feed
     466    tvp1(:, :) = 0.
     467    clw1(:, :) = 0.
    777468    CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
    778469                       gznk1, tp1, tvp1, clw1, icbs1)
    779   END IF
    780 
    781 
    782   IF (iflag_con==4) THEN
    783         if (prt_level >= 9) &
    784              PRINT *, 'cva_driver -> cv_undilute1'
    785     CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
    786                       tp1, tvp1, clw1)
    787   END IF
    788470
    789471! -------------------------------------------------------------------
    … …  
    791473! -------------------------------------------------------------------
    792474
    793 ! print *,' avant triggering, iflag_con ',iflag_con
    794 
    795   IF (iflag_con==3) THEN
    796 
    797         if (prt_level >= 9) &
    798              PRINT *, 'cva_driver -> cv3_trigger'
     475    call driver_log('cv3_trigger')
    799476    CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
    800                       pbase1, buoybase1, iflag1, sig1, w01)
    801 
    802 
    803 ! print*, 'IFLAG1 apres cv3_triger'
    804 ! print*,'len,nd',len,nd
    805 ! write(*,'(64i1)') iflag1(2:len-1)
    806 
    807 ! call dump2d(iim,jjm-1,sig1(2)
    808   END IF
    809 
    810   IF (iflag_con==4) THEN
    811         if (prt_level >= 9) &
    812              PRINT *, 'cva_driver -> cv_trigger'
    813     CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
    814   END IF
    815 
     477                     pbase1, buoybase1, iflag1, sig1, w01)
    816478
    817479! =====================================================================
    818480! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
    819481! =====================================================================
    820 
    821 !  Determine the number "ncum" of convective gridpoints, the list "idcum" of convective
    822 !  gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0.
    823 !  elsewhere).
    824   ncum = 0
    825   coef_convective(:) = 0.
    826   DO i = 1, len
    827     IF (iflag1(i)==0) THEN
    828       coef_convective(i) = 1.
    829       ncum = ncum + 1
    830       idcum(ncum) = i
    831     END IF
    832   END DO
    833 
    834 ! print*,'len, ncum = ',len,ncum
    835 
    836   IF (ncum>0) THEN
    837482
    838483! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    … …  
    840485!       (-> vectorization over convective gridpoints)
    841486! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    842 
    843     IF (iflag_con==3) THEN
    844 ! print*,'ncum tv1 ',ncum,tv1
    845 ! print*,'tvp1 ',tvp1
    846 !jyg<
    847 !   If the fraction of convective points is larger than comp_threshold, then compression
    848 !   is assumed useless.
    849   compress = ncum <= len*comp_threshold
    850 
    851   if( compress ) then
    852     compress_mode = COMPRESS_MODE_COMPRESS
    853   else
    854     compress_mode = COMPRESS_MODE_COPY
    855   endif
    856 
    857   if (prt_level >= 9) &
    858         PRINT *, 'cva_driver -> cv3a_compress'
    859 
    860   call add_array_i1(cv3a_compress_list, iflag1, iflag)
    861   call add_array_i1(cv3a_compress_list, nk1, nk)
    862   call add_array_i1(cv3a_compress_list, icb1, icb)
    863   call add_array_i1(cv3a_compress_list, icbs1, icbs)
    864   call add_array_r1(cv3a_compress_list, plcl1, plcl)
    865   call add_array_r1(cv3a_compress_list, tnk1, tnk)
    866   call add_array_r1(cv3a_compress_list, qnk1, qnk)
    867   call add_array_r1(cv3a_compress_list, gznk1, gznk)
    868   call add_array_r1(cv3a_compress_list, hnk1, hnk)
    869   call add_array_r1(cv3a_compress_list, unk1, unk)
    870   call add_array_r1(cv3a_compress_list, vnk1, vnk)
    871   call add_array_r2(cv3a_compress_list, wghti1, wghti)
    872   call add_array_r1(cv3a_compress_list, pbase1, pbase)
    873   call add_array_r1(cv3a_compress_list, buoybase1, buoybase)
    874   call add_array_r2(cv3a_compress_list, th1, th)
    875   call add_array_r2(cv3a_compress_list, t1, t)
    876   call add_array_r2(cv3a_compress_list, q1, q)
    877   call add_array_r2(cv3a_compress_list, qs1, qs)
    878   call add_array_r2(cv3a_compress_list, t1_wake, t_wake)
    879   call add_array_r2(cv3a_compress_list, q1_wake, q_wake)
    880   call add_array_r2(cv3a_compress_list, qs1_wake, qs_wake)
    881   call add_array_r1(cv3a_compress_list, s1_wake, s_wake)
    882   call add_array_r2(cv3a_compress_list, u1, u)
    883   call add_array_r2(cv3a_compress_list, v1, v)
    884   call add_array_r2(cv3a_compress_list, gz1, gz)
    885   call add_array_r2(cv3a_compress_list, h1, h)
    886   call add_array_r2(cv3a_compress_list, th1_wake, th_wake)
    887   !call add_array_r3(cv3a_compress_list, tra1, tra) !
    888   call add_array_r2(cv3a_compress_list, lv1, lv)
    889   call add_array_r2(cv3a_compress_list, lf1, lf)
    890   call add_array_r2(cv3a_compress_list, cpn1, cpn)
    891   call add_array_r2(cv3a_compress_list, p1, p)
    892   call add_array_r2(cv3a_compress_list, ph1, ph)
    893   call add_array_r2(cv3a_compress_list, tv1, tv)
    894   call add_array_r2(cv3a_compress_list, tp1, tp)
    895   call add_array_r2(cv3a_compress_list, tvp1, tvp)
    896   call add_array_r2(cv3a_compress_list, clw1, clw)
    897   call add_array_r2(cv3a_compress_list, h1_wake, h_wake)
    898   call add_array_r2(cv3a_compress_list, lv1_wake, lv_wake)
    899   call add_array_r2(cv3a_compress_list, lf1_wake, lf_wake)
    900   call add_array_r2(cv3a_compress_list, cpn1_wake, cpn_wake)
    901   call add_array_r2(cv3a_compress_list, tv1_wake, tv_wake)
    902   call add_array_r2(cv3a_compress_list, sig1, sig)
    903   call add_array_r1(cv3a_compress_list, sig1(:,nd), sig(:,nd))
    904   call add_array_r2(cv3a_compress_list, w01, w0)
    905   call add_array_r1(cv3a_compress_list, ptop21, ptop2)
    906   call add_array_r1(cv3a_compress_list, Ale1, Ale)
    907   call add_array_r1(cv3a_compress_list, Alp1, Alp)
    908   call add_array_r2(cv3a_compress_list, omega1, omega)
    909  
    910   call cv3a_compress(len, (iflag1 == 0), cv3a_compress_list, compress_data)
    911   ncum = compress_data%ncum
    912       ! IF (.not. compress) THEN
    913       !   DO i = 1,len
    914       !     idcum(i) = i
    915       !   ENDDO
    916       ! ENDIF
    917       ! CALL cv3a_compress_old(len, nloc, ncum, nd, ntra, compress, &
    918       !                    iflag1, nk1, icb1, icbs1, &
    919       !                    plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
    920       !                    wghti1, pbase1, buoybase1, &
    921       !                    t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
    922       !                    u1, v1, gz1, th1, th1_wake, &
    923       !                    tra1, &
    924       !                    h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
    925       !                    h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
    926       !                    sig1, w01, ptop21, &
    927       !                    Ale1, Alp1, omega1, &
    928       !                    iflag, nk, icb, icbs, &
    929       !                    plcl, tnk, qnk, gznk, hnk, unk, vnk, &
    930       !                    wghti, pbase, buoybase, &
    931       !                    t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
    932       !                    u, v, gz, th, th_wake, &
    933       !                    tra, &
    934       !                    h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
    935       !                    h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
    936       !                    sig, w0, ptop2, &
    937       !                    Ale, Alp, omega)
    938 
    939 ! print*,'tv ',tv
    940 ! print*,'tvp ',tvp
    941 
    942     END IF
    943 
    944     IF (iflag_con==4) THEN
    945         if (prt_level >= 9) &
    946              PRINT *, 'cva_driver -> cv_compress'
    947       ! TODO : new compress interface could be used here too
    948       CALL cv_compress(len, nloc, ncum, nd, &
    949                        iflag1, nk1, icb1, &
    950                        cbmf1, plcl1, tnk1, qnk1, gznk1, &
    951                        t1, q1, qs1, u1, v1, gz1, &
    952                        h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
    953                        iflag, nk, icb, &
    954                        cbmf, plcl, tnk, qnk, gznk, &
    955                        t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
    956                        dph)
    957     END IF
     487    compress = .true.
     488    if (compress) then
     489      compress_mode = COMPRESS_MODE_COMPRESS
     490    else
     491      compress_mode = COMPRESS_MODE_COPY
     492    endif
     493
     494    call driver_log('cv3a_compress')
     495
     496    call add_array_i1(cv3a_compress_list, iflag1, iflag)
     497    call add_array_i1(cv3a_compress_list, nk1, nk)
     498    call add_array_i1(cv3a_compress_list, icb1, icb)
     499    call add_array_i1(cv3a_compress_list, icbs1, icbs)
     500    call add_array_r1(cv3a_compress_list, plcl1, plcl)
     501    call add_array_r1(cv3a_compress_list, tnk1, tnk)
     502    call add_array_r1(cv3a_compress_list, qnk1, qnk)
     503    call add_array_r1(cv3a_compress_list, gznk1, gznk)
     504    call add_array_r1(cv3a_compress_list, hnk1, hnk)
     505    call add_array_r1(cv3a_compress_list, unk1, unk)
     506    call add_array_r1(cv3a_compress_list, vnk1, vnk)
     507    call add_array_r2(cv3a_compress_list, wghti1, wghti)
     508    call add_array_r1(cv3a_compress_list, pbase1, pbase)
     509    call add_array_r1(cv3a_compress_list, buoybase1, buoybase)
     510    call add_array_r2(cv3a_compress_list, th1, th)
     511    call add_array_r2(cv3a_compress_list, t1, t)
     512    call add_array_r2(cv3a_compress_list, q1, q)
     513    call add_array_r2(cv3a_compress_list, qs1, qs)
     514    call add_array_r2(cv3a_compress_list, t1_wake, t_wake)
     515    call add_array_r2(cv3a_compress_list, q1_wake, q_wake)
     516    call add_array_r2(cv3a_compress_list, qs1_wake, qs_wake)
     517    call add_array_r1(cv3a_compress_list, s1_wake, s_wake)
     518    call add_array_r2(cv3a_compress_list, u1, u)
     519    call add_array_r2(cv3a_compress_list, v1, v)
     520    call add_array_r2(cv3a_compress_list, gz1, gz)
     521    call add_array_r2(cv3a_compress_list, h1, h)
     522    call add_array_r2(cv3a_compress_list, th1_wake, th_wake)
     523    call add_array_r2(cv3a_compress_list, lv1, lv)
     524    call add_array_r2(cv3a_compress_list, lf1, lf)
     525    call add_array_r2(cv3a_compress_list, cpn1, cpn)
     526    call add_array_r2(cv3a_compress_list, p1, p)
     527    call add_array_r2(cv3a_compress_list, ph1, ph)
     528    call add_array_r2(cv3a_compress_list, tv1, tv)
     529    call add_array_r2(cv3a_compress_list, tp1, tp)
     530    call add_array_r2(cv3a_compress_list, tvp1, tvp)
     531    call add_array_r2(cv3a_compress_list, clw1, clw)
     532    call add_array_r2(cv3a_compress_list, h1_wake, h_wake)
     533    call add_array_r2(cv3a_compress_list, lv1_wake, lv_wake)
     534    call add_array_r2(cv3a_compress_list, lf1_wake, lf_wake)
     535    call add_array_r2(cv3a_compress_list, cpn1_wake, cpn_wake)
     536    call add_array_r2(cv3a_compress_list, tv1_wake, tv_wake)
     537    call add_array_r2(cv3a_compress_list, sig1, sig)
     538    call add_array_r1(cv3a_compress_list, sig1(:, nd), sig(:, nd))
     539    call add_array_r2(cv3a_compress_list, w01, w0)
     540    call add_array_r1(cv3a_compress_list, Ale1, Ale)
     541    call add_array_r1(cv3a_compress_list, Alp1, Alp)
     542    call add_array_r2(cv3a_compress_list, omega1, omega)
     543
     544    call cv3a_compress(len, (iflag1 == 0), cv3a_compress_list, compress_data)
     545    ncum = compress_data%ncum
     546
     547    IF (ncum > 0) THEN
    958548
    959549! -------------------------------------------------------------------
    … …  
    967557! -------------------------------------------------------------------
    968558
    969     IF (iflag_con==3) THEN
    970         if (prt_level >= 9) &
    971              PRINT *, 'cva_driver -> cv3_undilute2'
    972       CALL cv3_undilute2(nloc, ncum, nd, iflag, icb, icbs, nk, &        !na->nd
     559      call driver_log('cv3_undilute2')
     560      CALL cv3_undilute2(nloc, ncum, nd, iflag, icb, icbs, nk, &
    973561                         tnk, qnk, gznk, hnk, t, q, qs, gz, &
    974562                         p, ph, h, tv, lv, lf, pbase, buoybase, plcl, &
    975563                         inb, tp, tvp, clw, hp, ep, sigp, buoy, &
    976                          frac_a, frac_s, qpreca, qta)                        !!jygprl
    977     END IF
    978 
    979     IF (iflag_con==4) THEN
    980         if (prt_level >= 9) &
    981              PRINT *, 'cva_driver -> cv_undilute2'
    982       CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
    983                         tnk, qnk, gznk, t, q, qs, gz, &
    984                         p, dph, h, tv, lv, &
    985                         inb, inbis, tp, tvp, clw, hp, ep, sigp, frac_s)
    986     END IF
    987 
    988     ! epmax_cape
    989     ! on recalcule ep et hp   
    990         if (prt_level >= 9) &
    991              PRINT *, 'cva_driver -> cv3_epmax_cape'
    992     call cv3_epmax_fn_cape(nloc,ncum,nd &
    993                 , ep,hp,icb,inb,clw,nk,t,h,hnk,lv,lf,frac_s &
    994                 , pbase, p, ph, tv, buoy, sig, w0,iflag &
    995                 , epmax_diag)
     564                         frac_a, frac_s, qpreca, qta)
     565
     566! epmax_cape
     567! on recalcule ep et hp
     568      call driver_log('cv3_epmax_cape')
     569      call cv3_epmax_fn_cape(nloc, ncum, nd &
     570                             , ep, hp, icb, inb, clw, nk, t, h, hnk, lv, lf, frac_s &
     571                             , pbase, p, ph, tv, buoy, sig, w0, iflag &
     572                             , epmax_diag)
    996573
    997574! -------------------------------------------------------------------
    998575! --- MIXING(1)   (if iflag_mix .ge. 1)
    999576! -------------------------------------------------------------------
    1000     IF (iflag_con==3) THEN
    1001 !      IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
    1002 !        WRITE (*, *) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
    1003 !          '. Might as well stop here.'
    1004 !        STOP
    1005 !      END IF
    1006       IF (iflag_mix>=1) THEN
     577
     578      IF (iflag_mix >= 1) THEN
    1007579        CALL zilch(supmax, nloc*nd)
    1008         if (prt_level >= 9) &
    1009              PRINT *, 'cva_driver -> cv3p_mixing'
    1010         CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &           ! na->nd
    1011 !!                         ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
    1012                          ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qta, &      !!jygprl
     580        call driver_log('cv3p_mixing')
     581        CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &
     582                         ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qta, &
    1013583                         unk, vnk, hp, tv, tvp, ep, clw, sig, &
    1014584                         ment, qent, hent, uent, vent, nent, &
    1015585                         sigij, elij, supmax, ments, qents, traent)
    1016 ! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
    1017 
    1018586      ELSE
    1019587        CALL zilch(supmax, nloc*nd)
    1020588      END IF
    1021     END IF
     589
    1022590! -------------------------------------------------------------------
    1023591! --- CLOSURE
    1024592! -------------------------------------------------------------------
    1025593
    1026 
    1027     IF (iflag_con==3) THEN
    1028       IF (iflag_clos==0) THEN
    1029         if (prt_level >= 9) &
    1030              PRINT *, 'cva_driver -> cv3_closure'
    1031         CALL cv3_closure(nloc, ncum, nd, icb, inb, &           ! na->nd
     594      ptop2(:) = 0
     595      IF (iflag_clos == 0) THEN
     596        call driver_log('cv3_closure')
     597        CALL cv3_closure(nloc, ncum, nd, icb, inb, &
    1032598                         pbase, p, ph, tv, buoy, &
    1033599                         sig, w0, cape, m, iflag)
    … …  
    1036602      ok_inhib = iflag_mix == 2
    1037603
    1038       IF (iflag_clos==1) THEN
    1039         PRINT *, ' pas d appel cv3p_closure'
    1040 ! c        CALL cv3p_closure(nloc,ncum,nd,icb,inb              ! na->nd
    1041 ! c    :                       ,pbase,plcl,p,ph,tv,tvp,buoy
    1042 ! c    :                       ,supmax
    1043 ! c    o                       ,sig,w0,ptop2,cape,cin,m)
    1044       END IF   ! iflag_clos==1
    1045 
    1046       IF (iflag_clos==2) THEN
    1047         if (prt_level >= 9) &
    1048              PRINT *, 'cva_driver -> cv3p1_closure'
    1049         CALL cv3p1_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
     604      IF (iflag_clos == 1) PRINT *, ' pas d appel cv3p_closure'
     605
     606      IF (iflag_clos == 2) THEN
     607        call driver_log('cv3p1_closure')
     608        CALL cv3p1_closure(nloc, ncum, nd, icb, inb, &
    1050609                           pbase, plcl, p, ph, tv, tvp, buoy, &
    1051610                           supmax, ok_inhib, Ale, Alp, omega, &
    … …  
    1053612                           Plim1, plim2, asupmax, supmax0, &
    1054613                           asupmaxmin, cbmf, plfc, wbeff)
    1055         if (prt_level >= 10) &
    1056              PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
    1057       END IF   ! iflag_clos==2
    1058 
    1059       IF (iflag_clos==3) THEN
    1060         if (prt_level >= 9) &
    1061              PRINT *, 'cva_driver -> cv3p2_closure'
    1062         CALL cv3p2_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
     614        if (prt_level >= 10) PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
     615      END IF ! iflag_clos==2
     616
     617      IF (iflag_clos == 3) THEN
     618        call driver_log('cv3p2_closure')
     619        CALL cv3p2_closure(nloc, ncum, nd, icb, inb, &
    1063620                           pbase, plcl, p, ph, tv, tvp, buoy, &
    1064621                           supmax, ok_inhib, Ale, Alp, omega, &
    … …  
    1066623                           Plim1, plim2, asupmax, supmax0, &
    1067624                           asupmaxmin, cbmf, plfc, wbeff)
    1068         if (prt_level >= 10) &
    1069              PRINT *, 'cv3p2_closure-> plfc,wbeff ', plfc(1), wbeff(1)
    1070       END IF   ! iflag_clos==3
    1071     END IF ! iflag_con==3
    1072 
    1073     IF (iflag_con==4) THEN
    1074         if (prt_level >= 9) &
    1075              PRINT *, 'cva_driver -> cv_closure'
    1076       CALL cv_closure(nloc, ncum, nd, nk, icb, &
    1077                          tv, tvp, p, ph, dph, plcl, cpn, &
    1078                          iflag, cbmf)
    1079     END IF
    1080 
    1081 ! print *,'cv_closure-> cape ',cape(1)
     625        if (prt_level >= 10) PRINT *, 'cv3p2_closure-> plfc,wbeff ', plfc(1), wbeff(1)
     626      END IF ! iflag_clos==3
    1082627
    1083628! -------------------------------------------------------------------
    … …  
    1085630! -------------------------------------------------------------------
    1086631
    1087     IF (iflag_con==3) THEN
    1088       IF (iflag_mix==0) THEN
    1089         if (prt_level >= 9) &
    1090              PRINT *, 'cva_driver -> cv3_mixing'
     632      IF (iflag_mix == 0) THEN
     633        call driver_log('cv3_mixing')
    1091634        CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &             ! na->nd
    1092635                        ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qnk, &
    … …  
    1095638        CALL zilch(hent, nloc*nd*nd)
    1096639      ELSE
    1097 !!jyg:  Essais absurde pour voir
    1098 !!        mm(:,1) = 0.
    1099 !!        DO  i = 2,nd
    1100 !!          mm(:,i) = m(:,i)*(1.-qta(:,i-1))
    1101 !!        ENDDO
    1102         mm(:,:) = m(:,:)
     640        mm(:, :) = m(:, :)
    1103641        CALL cv3_mixscale(nloc, ncum, nd, ment, mm)
    1104         IF (debut) THEN
    1105           PRINT *, ' cv3_mixscale-> '
    1106         END IF !(debut) THEN
     642        IF (debut) PRINT *, ' cv3_mixscale-> '
    1107643      END IF
    1108     END IF
    1109 
    1110     IF (iflag_con==4) THEN
    1111         if (prt_level >= 9) &
    1112              PRINT *, 'cva_driver -> cv_mixing'
    1113       CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
    1114                      ph, t, q, qs, u, v, h, lv, qnk, &
    1115                      hp, tv, tvp, ep, clw, cbmf, &
    1116                      m, ment, qent, uent, vent, nent, sigij, elij)
    1117     END IF                                                                                         
    1118 
    1119     IF (debut) THEN
    1120       PRINT *, ' cv_mixing ->'
    1121     END IF !(debut) THEN
    1122 ! do i = 1,nd
    1123 ! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,nd)
    1124 ! enddo
     644
     645      IF (debut) PRINT *, ' cv_mixing ->'
    1125646
    1126647! -------------------------------------------------------------------
    1127648! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
    1128649! -------------------------------------------------------------------
    1129     IF (iflag_con==3) THEN
    1130       IF (debut) THEN
    1131         PRINT *, ' cva_driver -> cv3_unsat '
    1132       END IF !(debut) THEN
    1133 
    1134         if (prt_level >= 9) &
    1135              PRINT *, 'cva_driver -> cv3_unsat'
    1136       CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, &              ! na->nd
     650      IF (debut) PRINT *, ' cva_driver -> cv3_unsat '
     651
     652      call driver_log('cv3_unsat')
     653      CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, &
    1137654                     t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
    1138655                     th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
    1139                      ep, sigp, clw, frac_s, qpreca, frac_a, qta, &                    !!jygprl
     656                     ep, sigp, clw, frac_s, qpreca, frac_a, qta, &
    1140657                     m, ment, elij, delt, plcl, coef_clos, &
    1141658                     mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
    1142659                     faci, b, sigd, &
    1143 !!                     wdtrainA, wdtrainM)                                       ! RomP
    1144                      wdtrainA, wdtrainS, wdtrainM)                               !!jygprl
    1145 !
     660                     wdtrainA, wdtrainS, wdtrainM)
    1146661      IF (prt_level >= 10) THEN
    1147662        Print *, 'cva_driver after cv3_unsat:mp , water, ice, evap, fondue '
    1148         DO k = 1,nd
    1149         write (6, '(i4,5(1x,e13.6))'), &
    1150           k, mp(igout,k), water(igout,k), ice(igout,k), &
    1151            evap(igout,k), fondue(igout,k)
     663        DO k = 1, nd
     664          write (6, '(i4,5(1x,e13.6))'), &
     665            k, mp(igout, k), water(igout, k), ice(igout, k), &
     666            evap(igout, k), fondue(igout, k)
    1152667        ENDDO
    1153         Print *, 'cva_driver after cv3_unsat: wdtrainA, wdtrainS, wdtrainM '     !!jygprl
    1154         DO k = 1,nd
    1155         write (6, '(i4,3(1x,e13.6))'), &
    1156            k, wdtrainA(igout,k), wdtrainS(igout,k), wdtrainM(igout,k)            !!jygprl
     668        Print *, 'cva_driver after cv3_unsat: wdtrainA, wdtrainS, wdtrainM '
     669        DO k = 1, nd
     670          write (6, '(i4,3(1x,e13.6))'), &
     671            k, wdtrainA(igout, k), wdtrainS(igout, k), wdtrainM(igout, k)
    1157672        ENDDO
    1158673      ENDIF
    1159 !
    1160     END IF  !(iflag_con==3)
    1161 
    1162     IF (iflag_con==4) THEN
    1163         if (prt_level >= 9) &
    1164              PRINT *, 'cva_driver -> cv_unsat'
    1165       CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
    1166                      h, lv, ep, sigp, clw, m, ment, elij, &
    1167                      iflag, mp, qp, up, vp, wt, water, evap)
    1168     END IF
    1169 
    1170     IF (debut) THEN
    1171       PRINT *, 'cv_unsat-> '
    1172     END IF !(debut) THEN
    1173 
    1174 ! print *,'cv_unsat-> mp ',mp
    1175 ! print *,'cv_unsat-> water ',water
    1176 ! -------------------------------------------------------------------
    1177 ! --- YIELD
    1178 ! (tendencies, precipitation, variables of interface with other
    1179 ! processes, etc)
    1180 ! -------------------------------------------------------------------
    1181 
    1182     IF (iflag_con==3) THEN
    1183 
    1184         if (prt_level >= 9) &
    1185              PRINT *, 'cva_driver -> cv3_yield'
    1186       CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, &                      ! na->nd
     674
     675      IF (debut) PRINT *, 'cv_unsat-> '
     676! -------------------------------------------------------------------
     677! YIELD
     678! (tendencies, precipitation, variables of interface with other processes, etc)
     679! -------------------------------------------------------------------
     680
     681      call driver_log('cv3_yield')
     682      CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, &
    1187683                     icb, inb, delt, &
    1188684                     t, q, t_wake, q_wake, s_wake, u, v, tra, &
    … …  
    1193689                     nent, elij, traent, sig, &
    1194690                     tv, tvp, wghti, &
    1195                      iflag, precip, Vprecip, Vprecipi, ft, fq, fu, fv, ftra, &      ! jyg
     691                     iflag, precip, Vprecip, Vprecipi, ft, fq, fu, fv, ftra, &
    1196692                     cbmf, upwd, dnwd, dnwd0, ma, mip, &
    1197 !!                     tls, tps, &                            ! useless . jyg
    1198693                     qcondc, wd, &
    1199 !!                     ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
    1200                      ftd, fqd, qta, qtc, sigt, tau_cld_cv, coefw_cld_cv)         !!jygprl
    1201 !
    1202 !         Test conseravtion de l'eau
    1203 !
    1204       IF (debut) THEN
    1205         PRINT *, ' cv3_yield -> fqd(1) = ', fqd(igout, 1)
    1206       END IF !(debut) THEN
    1207 !   
     694                     ftd, fqd, qta, qtc, sigt, tau_cld_cv, coefw_cld_cv)
     695
     696      ! Test conseravtion de l'eau
     697      IF (debut) PRINT *, ' cv3_yield -> fqd(1) = ', fqd(igout, 1)
    1208698      IF (prt_level >= 10) THEN
    1209699        Print *, 'cva_driver after cv3_yield:ft(1) , ftd(1) ', &
    1210                     ft(igout,1), ftd(igout,1)
     700          ft(igout, 1), ftd(igout, 1)
    1211701        Print *, 'cva_driver after cv3_yield:fq(1) , fqd(1) ', &
    1212                     fq(igout,1), fqd(igout,1)
     702          fq(igout, 1), fqd(igout, 1)
    1213703      ENDIF
    1214 !   
    1215     END IF
    1216 
    1217     IF (iflag_con==4) THEN
    1218         if (prt_level >= 9) &
    1219              PRINT *, 'cva_driver -> cv_yield'
    1220       CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
    1221                      t, q, u, v, &
    1222                      gz, p, ph, h, hp, lv, cpn, &
    1223                      ep, clw, frac_s, m, mp, qp, up, vp, &
    1224                      wt, water, evap, &
    1225                      ment, qent, uent, vent, nent, elij, &
    1226                      tv, tvp, &
    1227                      iflag, wd, qprime, tprime, &
    1228                      precip, cbmf, ft, fq, fu, fv, ma, qcondc)
    1229     END IF
    1230 
    1231 !AC!
     704
    1232705!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    1233706!--- passive tracers
    1234707!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    1235708
    1236     IF (iflag_con==3) THEN
    1237 !RomP >>>
    1238         if (prt_level >= 9) &
    1239              PRINT *, 'cva_driver -> cv3_tracer'
     709      call driver_log('cv3_tracer')
    1240710      CALL cv3_tracer(nloc, len, ncum, nd, nd, &
    1241                      ment, sigij, da, phi, phi2, d1a, dam, &
    1242                      ep, vprecip, elij, clw, epmlmMm, eplaMm, &
    1243                      icb, inb)
    1244 !RomP <<<
    1245     END IF
    1246 
    1247 !AC!
     711                      ment, sigij, da, phi, phi2, d1a, dam, &
     712                      ep, vprecip, elij, clw, epmlmMm, eplaMm, &
     713                      icb, inb)
     714    END IF ! ncum>0
    1248715
    1249716! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    1250717! --- UNCOMPRESS THE FIELDS
    1251718! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    1252 
    1253 
    1254     IF (iflag_con==3) THEN
    1255       if (prt_level >= 9) &
    1256             PRINT *, 'cva_driver -> cv3a_uncompress'
    1257       call add_array_i1(cv3a_uncompress_list, iflag, iflag1)
    1258       call add_array_i1(cv3a_uncompress_list, icb, icb1)
    1259       call add_array_i1(cv3a_uncompress_list, inb, ktop1)
    1260       call add_array_r1(cv3a_uncompress_list, precip, precip1)
    1261       call add_array_r1(cv3a_uncompress_list, cbmf, cbmf1)
    1262       call add_array_r1(cv3a_uncompress_list, plcl, plcl1)
    1263       call add_array_r1(cv3a_uncompress_list, plfc, plfc1)
    1264       call add_array_r1(cv3a_uncompress_list, wbeff, wbeff1)
    1265       call add_array_r2(cv3a_uncompress_list, sig, sig1)
    1266       call add_array_r2(cv3a_uncompress_list, w0, w01)
    1267       call add_array_r1(cv3a_uncompress_list, ptop2, ptop21)
    1268       call add_array_r2(cv3a_uncompress_list, ft, ft1)
    1269       call add_array_r2(cv3a_uncompress_list, fq, fq1)
    1270       call add_array_r2(cv3a_uncompress_list, fu, fu1)
    1271       call add_array_r2(cv3a_uncompress_list, fv, fv1)
    1272       !call add_array_r3(cv3a_uncompress_list, ftra, ftra1)
    1273       call add_array_r1(cv3a_uncompress_list, sigd, sigd1)
    1274       call add_array_r2(cv3a_uncompress_list, ma, ma1)
    1275       call add_array_r2(cv3a_uncompress_list, mip, mip1)
    1276       call add_array_r2(cv3a_uncompress_list, vprecip, vprecip1)
    1277       call add_array_r2(cv3a_uncompress_list, vprecipi, vprecipi1)
    1278       call add_array_r2(cv3a_uncompress_list, upwd, upwd1)
    1279       call add_array_r2(cv3a_uncompress_list, dnwd, dnwd1)
    1280       call add_array_r2(cv3a_uncompress_list, dnwd0, dnwd01)
    1281       call add_array_r2(cv3a_uncompress_list, qcondc, qcondc1)
    1282       call add_array_r1(cv3a_uncompress_list, wd, wd1)
    1283       call add_array_r1(cv3a_uncompress_list, cape, cape1)
    1284       call add_array_r1(cv3a_uncompress_list, cin, cin1)
    1285       call add_array_r2(cv3a_uncompress_list, tvp, tvp1)
    1286       call add_array_r2(cv3a_uncompress_list, ftd, ftd1)
    1287       call add_array_r2(cv3a_uncompress_list, fqd, fqd1)
    1288       call add_array_r1(cv3a_uncompress_list, Plim1, Plim11)
    1289       call add_array_r1(cv3a_uncompress_list, plim2, plim21)
    1290       call add_array_r2(cv3a_uncompress_list, asupmax, asupmax1)
    1291       call add_array_r1(cv3a_uncompress_list, supmax0, supmax01)
    1292       call add_array_r1(cv3a_uncompress_list, asupmaxmin, asupmaxmin1)
    1293       call add_array_r2(cv3a_uncompress_list, da, da1)
    1294       call add_array_r3(cv3a_uncompress_list, phi, phi1)
    1295       call add_array_r2(cv3a_uncompress_list, mp, mp1)
    1296       call add_array_r3(cv3a_uncompress_list, phi2, phi21)
    1297       call add_array_r2(cv3a_uncompress_list, d1a, d1a1)
    1298       call add_array_r2(cv3a_uncompress_list, dam, dam1)
    1299       call add_array_r3(cv3a_uncompress_list, sigij, sigij1)
    1300       call add_array_r2(cv3a_uncompress_list, qta, qta1)
    1301       call add_array_r2(cv3a_uncompress_list, clw, clw1)
    1302       call add_array_r3(cv3a_uncompress_list, elij, elij1)
    1303       call add_array_r2(cv3a_uncompress_list, evap, evap1)
    1304       call add_array_r2(cv3a_uncompress_list, ep, ep1)
    1305       call add_array_r3(cv3a_uncompress_list, epmlmMm, epmlmMm1)
    1306       call add_array_r2(cv3a_uncompress_list, eplaMm, eplaMm1)
    1307       call add_array_r2(cv3a_uncompress_list, wdtrainA, wdtrainA1)
    1308       call add_array_r2(cv3a_uncompress_list, wdtrainS, wdtrainS1)
    1309       call add_array_r2(cv3a_uncompress_list, wdtrainM, wdtrainM1)
    1310       call add_array_r2(cv3a_uncompress_list, qtc, qtc1)
    1311       call add_array_r2(cv3a_uncompress_list, sigt, sigt1)
    1312       call add_array_r1(cv3a_uncompress_list, epmax_diag, epmax_diag1)
    1313       call add_array_r1(cv3a_uncompress_list, sig(:,nd), sig1(:,nd))
    1314       call cv3a_uncompress(len, compress_data, cv3a_uncompress_list)
    1315       ! CALL cv3a_uncompress_old(nloc, len, ncum, nd, ntra, idcum, compress, &
    1316       !                      iflag, icb, inb, &
    1317       !                      precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
    1318       !                      ft, fq, fu, fv, ftra, &
    1319       !                      sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
    1320       !                      qcondc, wd, cape, cin, &
    1321       !                      tvp, &
    1322       !                      ftd, fqd, &
    1323       !                      Plim1, plim2, asupmax, supmax0, &
    1324       !                      asupmaxmin, &
    1325       !                      da, phi, mp, phi2, d1a, dam, sigij, &         ! RomP
    1326       !                      qta, clw, elij, evap, ep, epmlmMm, eplaMm, &  ! RomP
    1327       !                      wdtrainA, wdtrainS, wdtrainM, &                         ! RomP
    1328       !                      qtc, sigt, epmax_diag, & ! epmax_cape
    1329       !                      iflag1, kbas1, ktop1, &
    1330       !                      precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
    1331       !                      ft1, fq1, fu1, fv1, ftra1, &
    1332       !                      sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
    1333       !                      qcondc1, wd1, cape1, cin1, &
    1334       !                      tvp1, &
    1335       !                      ftd1, fqd1, &
    1336       !                      Plim11, plim21, asupmax1, supmax01, &
    1337       !                      asupmaxmin1, &
    1338       !                      da1, phi1, mp1, phi21, d1a1, dam1, sigij1,  &       ! RomP
    1339       !                      qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
    1340       !                      wdtrainA1, wdtrainS1, wdtrainM1,                  & ! RomP
    1341       !                      qtc1, sigt1, epmax_diag1) ! epmax_cape
    1342 !   
    1343       IF (prt_level >= 10) THEN
    1344         Print *, 'cva_driver after cv3_uncompress:ft1(1) , ftd1(1) ', &
    1345                     ft1(igout,1), ftd1(igout,1)
    1346         Print *, 'cva_driver after cv3_uncompress:fq1(1) , fqd1(1) ', &
    1347                     fq1(igout,1), fqd1(igout,1)
    1348       ENDIF
    1349 !   
     719    call driver_log('cv3a_uncompress')
     720    call add_array_i1(cv3a_uncompress_list, iflag, iflag1, init=.false.)
     721    call add_array_i1(cv3a_uncompress_list, icb, kbas1)
     722    call add_array_i1(cv3a_uncompress_list, inb, ktop1)
     723    call add_array_r1(cv3a_uncompress_list, precip, precip1)
     724    call add_array_r1(cv3a_uncompress_list, cbmf, cbmf1)
     725    call add_array_r1(cv3a_uncompress_list, plcl, plcl1, init=.false.)
     726    call add_array_r1(cv3a_uncompress_list, plfc, plfc1)
     727    call add_array_r1(cv3a_uncompress_list, wbeff, wbeff1)
     728    call add_array_r2(cv3a_uncompress_list, sig, sig1)
     729    call add_array_r2(cv3a_uncompress_list, w0, w01)
     730    call add_array_r1(cv3a_uncompress_list, ptop2, ptop21)
     731    call add_array_r2(cv3a_uncompress_list, ft, ft1)
     732    call add_array_r2(cv3a_uncompress_list, fq, fq1)
     733    call add_array_r2(cv3a_uncompress_list, fu, fu1)
     734    call add_array_r2(cv3a_uncompress_list, fv, fv1)
     735    call add_array_r1(cv3a_uncompress_list, sigd, sigd1)
     736    call add_array_r2(cv3a_uncompress_list, ma, ma1)
     737    call add_array_r2(cv3a_uncompress_list, mip, mip1)
     738    call add_array_r2(cv3a_uncompress_list, vprecip, vprecip1)
     739    call add_array_r2(cv3a_uncompress_list, vprecipi, vprecipi1)
     740    call add_array_r2(cv3a_uncompress_list, upwd, upwd1)
     741    call add_array_r2(cv3a_uncompress_list, dnwd, dnwd1)
     742    call add_array_r2(cv3a_uncompress_list, dnwd0, dnwd01)
     743    call add_array_r2(cv3a_uncompress_list, qcondc, qcondc1)
     744    call add_array_r1(cv3a_uncompress_list, wd, wd1)
     745    cape1(:) = -1.
     746    call add_array_r1(cv3a_uncompress_list, cape, cape1, init=.false.)
     747    cin1(:) = -100000.
     748    call add_array_r1(cv3a_uncompress_list, cin, cin1, init=.false.)
     749    call add_array_r2(cv3a_uncompress_list, tvp, tvp1, init=.false.)
     750    call add_array_r2(cv3a_uncompress_list, ftd, ftd1)
     751    call add_array_r2(cv3a_uncompress_list, fqd, fqd1)
     752    call add_array_r1(cv3a_uncompress_list, Plim1, Plim11)
     753    call add_array_r1(cv3a_uncompress_list, plim2, plim21)
     754    call add_array_r2(cv3a_uncompress_list, asupmax, asupmax1)
     755    call add_array_r1(cv3a_uncompress_list, supmax0, supmax01)
     756    call add_array_r1(cv3a_uncompress_list, asupmaxmin, asupmaxmin1)
     757    call add_array_r2(cv3a_uncompress_list, da, da1)
     758    call add_array_r3(cv3a_uncompress_list, phi, phi1)
     759    call add_array_r2(cv3a_uncompress_list, mp, mp1)
     760    call add_array_r3(cv3a_uncompress_list, phi2, phi21)
     761    call add_array_r2(cv3a_uncompress_list, d1a, d1a1)
     762    call add_array_r2(cv3a_uncompress_list, dam, dam1)
     763    call add_array_r3(cv3a_uncompress_list, sigij, sigij1)
     764    call add_array_r2(cv3a_uncompress_list, qta, qta1)
     765    call add_array_r2(cv3a_uncompress_list, clw, clw1, init=.false.)
     766    call add_array_r3(cv3a_uncompress_list, elij, elij1)
     767    call add_array_r2(cv3a_uncompress_list, evap, evap1)
     768    call add_array_r2(cv3a_uncompress_list, ep, ep1)
     769    call add_array_r3(cv3a_uncompress_list, epmlmMm, epmlmMm1)
     770    call add_array_r2(cv3a_uncompress_list, eplaMm, eplaMm1)
     771    call add_array_r2(cv3a_uncompress_list, wdtrainA, wdtrainA1)
     772    call add_array_r2(cv3a_uncompress_list, wdtrainS, wdtrainS1)
     773    call add_array_r2(cv3a_uncompress_list, wdtrainM, wdtrainM1)
     774    call add_array_r2(cv3a_uncompress_list, qtc, qtc1)
     775    call add_array_r2(cv3a_uncompress_list, sigt, sigt1)
     776    call add_array_r1(cv3a_uncompress_list, epmax_diag, epmax_diag1)
     777    call add_array_r1(cv3a_uncompress_list, sig(:, nd), sig1(:, nd))
     778    call cv3a_uncompress(len, compress_data, cv3a_uncompress_list)
     779
     780    IF (prt_level >= 10) THEN
     781      Print *, 'cva_driver after cv3_uncompress:ft1(1) , ftd1(1) ', &
     782        ft1(igout, 1), ftd1(igout, 1)
     783      Print *, 'cva_driver after cv3_uncompress:fq1(1) , fqd1(1) ', &
     784        fq1(igout, 1), fqd1(igout, 1)
     785    ENDIF
     786    IF (debut) THEN
     787      PRINT *, ' cv_uncompress -> '
     788      debut = .FALSE.
    1350789    END IF
    1351790
    1352     IF (iflag_con==4) THEN
    1353         if (prt_level >= 9) &
    1354              PRINT *, 'cva_driver -> cv_uncompress'
    1355       CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
    1356                            iflag, &
    1357                            precip, cbmf, &
    1358                            ft, fq, fu, fv, &
    1359                            ma, qcondc, &
    1360                            iflag1, &
    1361                            precip1,cbmf1, &
    1362                            ft1, fq1, fu1, fv1, &
    1363                            ma1, qcondc1)
    1364     END IF
    1365 
    1366   END IF ! ncum>0
    1367 
    1368 !
    1369 ! In order take into account the possibility of changing the compression,
    1370 ! reset m, sig and w0 to zero for non-convective points.
    1371   DO k = 1,nd-1
    1372         sig1(:, k) = sig1(:, k)*coef_convective(:)
    1373         w01(:, k)  = w01(:, k)*coef_convective(:)
    1374   ENDDO
    1375 
    1376   IF (debut) THEN
    1377     PRINT *, ' cv_uncompress -> '
    1378     debut = .FALSE.
    1379   END IF  !(debut) THEN
    1380 
    1381 
    1382   RETURN
    1383 END SUBROUTINE cv3a_driver
    1384 
    1385 END MODULE
     791    ftra1(:,:,:) = 0
     792
     793  END SUBROUTINE
     794
     795  subroutine driver_log(message)
     796    use print_control_mod, only: prt_level
     797    character(*) :: message
     798    if (prt_level >= 9) PRINT *, 'cva_driver ->', message
     799  end subroutine
     800end module

  • LMDZ6/branches/Optimisation_LMDZ/libf/phylmd/cva_driver.F90

    r3757 r3758  
    127127    call cv3a_driver(len, nd, ndp1, ntra, nloc, k_upper, &
    128128                iflag_con, iflag_mix, iflag_ice_thermo, iflag_clos, ok_conserv_q, &
    129                 delt, comp_threshold, &
     129                delt, &
    130130                t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
    131                 u1, v1, tra1, &
     131                u1, v1, &
    132132                p1, ph1, &
    133133                Ale1, Alp1, omega1, &
    … …  
    143143                ftd1, fqd1, &
    144144                Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
    145                 lalim_conv1, &
    146145                da1, phi1, mp1, phi21, d1a1, dam1, sigij1, wghti1, &
    147146                qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &
Note: See TracChangeset for help on using the changeset viewer.