--- trunk/libf/phylmd/cv_driver.f90 2011/09/23 12:28:01 52 +++ trunk/libf/phylmd/cv_driver.f90 2013/07/23 13:00:07 72 @@ -4,25 +4,41 @@ contains - SUBROUTINE cv_driver(len, nd, ndp1, ntra, iflag_con, t1, q1, qs1, u1, v1, & - tra1, p1, ph1, iflag1, ft1, fq1, fu1, fv1, ftra1, precip1, VPrecip1, & - cbmf1, sig1, w01, icb1, inb1, delt, Ma1, upwd1, dnwd1, dnwd01, & - qcondc1, wd1, cape1, da1, phi1, mp1) + SUBROUTINE cv_driver(len, nd, ndp1, ntra, t1, q1, qs1, u1, v1, tra1, p1, & + ph1, iflag1, ft1, fq1, fu1, fv1, ftra1, precip1, VPrecip1, cbmf1, & + sig1, w01, icb1, inb1, delt, Ma1, upwd1, dnwd1, dnwd01, qcondc1, wd1, & + cape1, da1, phi1, mp1) ! From LMDZ4/libf/phylmd/cv_driver.F, version 1.3 2005/04/15 12:36:17 - use dimens_m - use dimphy - ! + ! Main driver for convection + + ! S. Bony, Mar 2002: + + ! Several modules corresponding to different physical processes + + ! Several versions of convect may be used: + ! - iflag_con=3: version lmd (previously named convect3) + ! - iflag_con=4: version 4.3b (vect. version, previously convect1/2) + + ! Plus tard : + ! - iflag_con=5: version lmd with ice (previously named convectg) + + ! S. Bony, Oct 2002: + ! Vectorization of convect3 (ie version lmd) + + use clesphys2, only: iflag_con + use cv3_param_m, only: cv3_param + USE dimphy, ONLY: klev, klon + ! PARAMETERS: ! Name Type Usage Description ! ---------- ---------- ------- ---------------------------- - ! + ! len Integer Input first (i) dimension ! nd Integer Input vertical (k) dimension ! ndp1 Integer Input nd + 1 ! ntra Integer Input number of tracors - ! iflag_con Integer Input version of convect (3/4) ! t1 Real Input temperature ! q1 Real Input specific hum ! qs1 Real Input sat specific hum @@ -40,41 +56,22 @@ ! precip1 Real Output precipitation ! VPrecip1 Real Output vertical profile of precipitations ! cbmf1 Real Output cloud base mass flux - ! sig1 Real In/Out section adiabatic updraft - ! w01 Real In/Out vertical velocity within adiab updraft ! delt Real Input time step ! Ma1 Real Output mass flux adiabatic updraft - ! upwd1 Real Output total upward mass flux (adiab+mixed) - ! dnwd1 Real Output saturated downward mass flux (mixed) - ! dnwd01 Real Output unsaturated downward mass flux ! qcondc1 Real Output in-cld mixing ratio of condensed water ! wd1 Real Output downdraft velocity scale for sfc fluxes ! cape1 Real Output CAPE - ! - ! S. Bony, Mar 2002: - ! * Several modules corresponding to different physical processes - ! * Several versions of convect may be used: - ! - iflag_con=3: version lmd (previously named convect3) - ! - iflag_con=4: version 4.3b (vect. version, previously convect1/2) - ! + tard: - iflag_con=5: version lmd with ice (previously named convectg) - ! S. Bony, Oct 2002: - ! * Vectorization of convect3 (ie version lmd) - ! - !..............................END PROLOGUE............................. - ! - ! integer len integer nd integer ndp1 - integer noff - integer, intent(in):: iflag_con - integer ntra + integer, intent(in):: ntra real, intent(in):: t1(len, nd) real q1(len, nd) real qs1(len, nd) real u1(len, nd) real v1(len, nd) + real, intent(in):: tra1(len, nd, ntra) real p1(len, nd) real ph1(len, ndp1) integer iflag1(len) @@ -82,77 +79,81 @@ real fq1(len, nd) real fu1(len, nd) real fv1(len, nd) + real ftra1(len, nd, ntra) real precip1(len) - real cbmf1(len) real VPrecip1(len, nd+1) + real cbmf1(len) + real, intent(inout):: sig1(klon, klev) ! section adiabatic updraft + + real, intent(inout):: w01(klon, klev) + ! vertical velocity within adiabatic updraft + + integer icb1(klon) + integer inb1(klon) + real, intent(in):: delt real Ma1(len, nd) - real upwd1(len, nd) - real dnwd1(len, nd) - real dnwd01(len, nd) + real, intent(out):: upwd1(len, nd) ! total upward mass flux (adiab+mixed) + real, intent(out):: dnwd1(len, nd) ! saturated downward mass flux (mixed) + real, intent(out):: dnwd01(len, nd) ! unsaturated downward mass flux real qcondc1(len, nd) ! cld real wd1(len) ! gust real cape1(len) real da1(len, nd), phi1(len, nd, nd), mp1(len, nd) - real da(len, nd), phi(len, nd, nd), mp(len, nd) - real, intent(in):: tra1(len, nd, ntra) - real ftra1(len, nd, ntra) - - real, intent(in):: delt !------------------------------------------------------------------- ! --- ARGUMENTS !------------------------------------------------------------------- ! --- On input: - ! + ! t: Array of absolute temperature (K) of dimension ND, with first ! index corresponding to lowest model level. Note that this array ! will be altered by the subroutine if dry convective adjustment ! occurs and if IPBL is not equal to 0. - ! + ! q: Array of specific humidity (gm/gm) of dimension ND, with first ! index corresponding to lowest model level. Must be defined ! at same grid levels as T. Note that this array will be altered ! if dry convective adjustment occurs and if IPBL is not equal to 0. - ! + ! qs: Array of saturation specific humidity of dimension ND, with first ! index corresponding to lowest model level. Must be defined ! at same grid levels as T. Note that this array will be altered ! if dry convective adjustment occurs and if IPBL is not equal to 0. - ! + ! u: Array of zonal wind velocity (m/s) of dimension ND, witth first ! index corresponding with the lowest model level. Defined at ! same levels as T. Note that this array will be altered if ! dry convective adjustment occurs and if IPBL is not equal to 0. - ! + ! v: Same as u but for meridional velocity. - ! + ! tra: Array of passive tracer mixing ratio, of dimensions (ND, NTRA), ! where NTRA is the number of different tracers. If no ! convective tracer transport is needed, define a dummy ! input array of dimension (ND, 1). Tracers are defined at ! same vertical levels as T. Note that this array will be altered ! if dry convective adjustment occurs and if IPBL is not equal to 0. - ! + ! p: Array of pressure (mb) of dimension ND, with first ! index corresponding to lowest model level. Must be defined ! at same grid levels as T. - ! + ! ph: Array of pressure (mb) of dimension ND+1, with first index ! corresponding to lowest level. These pressures are defined at ! levels intermediate between those of P, T, Q and QS. The first ! value of PH should be greater than (i.e. at a lower level than) ! the first value of the array P. - ! + ! nl: The maximum number of levels to which convection can penetrate, plus 1. ! NL MUST be less than or equal to ND-1. - ! + ! delt: The model time step (sec) between calls to CONVECT - ! + !---------------------------------------------------------------------------- ! --- On Output: - ! + ! iflag: An output integer whose value denotes the following: ! VALUE INTERPRETATION ! ----- -------------- @@ -171,54 +172,54 @@ ! level is above the 200 mb level. ! 9 No moist convection: cloud base is higher ! then the level NL-1. - ! + ! ft: Array of temperature tendency (K/s) of dimension ND, defined at same ! grid levels as T, Q, QS and P. - ! + ! fq: Array of specific humidity tendencies ((gm/gm)/s) of dimension ND, ! defined at same grid levels as T, Q, QS and P. - ! + ! fu: Array of forcing of zonal velocity (m/s^2) of dimension ND, ! defined at same grid levels as T. - ! + ! fv: Same as FU, but for forcing of meridional velocity. - ! + ! ftra: Array of forcing of tracer content, in tracer mixing ratio per ! second, defined at same levels as T. Dimensioned (ND, NTRA). - ! + ! precip: Scalar convective precipitation rate (mm/day). - ! + ! VPrecip: Vertical profile of convective precipitation (kg/m2/s). - ! + ! wd: A convective downdraft velocity scale. For use in surface ! flux parameterizations. See convect.ps file for details. - ! + ! tprime: A convective downdraft temperature perturbation scale (K). ! For use in surface flux parameterizations. See convect.ps ! file for details. - ! + ! qprime: A convective downdraft specific humidity ! perturbation scale (gm/gm). ! For use in surface flux parameterizations. See convect.ps ! file for details. - ! + ! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST ! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT ! ITS NEXT CALL. That is, the value of CBMF must be "remembered" ! by the calling program between calls to CONVECT. - ! + ! det: Array of detrainment mass flux of dimension ND. - ! + !------------------------------------------------------------------- - ! + ! Local arrays - ! + + integer noff + real da(len, nd), phi(len, nd, nd), mp(len, nd) integer i, k, n, il, j integer icbmax integer nk1(klon) - integer icb1(klon) - integer inb1(klon) integer icbs1(klon) real plcl1(klon) @@ -239,14 +240,12 @@ real tp1(klon, klev) real tvp1(klon, klev) real clw1(klon, klev) - real sig1(klon, klev) - real w01(klon, klev) real th1(klon, klev) - ! + integer ncum - ! + ! (local) compressed fields: - ! + integer nloc parameter (nloc=klon) ! pour l'instant @@ -299,10 +298,10 @@ ! -- set thermodynamical constants: ! (common cvthermo) - CALL cv_thermo(iflag_con) + CALL cv_thermo ! -- set convect parameters - ! + ! includes microphysical parameters and parameters that ! control the rate of approach to quasi-equilibrium) ! (common cvparam) @@ -358,8 +357,8 @@ if (iflag_con.eq.3) then do il=1, len - sig1(il, nd)=sig1(il, nd)+1. - sig1(il, nd)=amin1(sig1(il, nd), 12.1) + sig1(il, nd)=sig1(il, nd) + 1. + sig1(il, nd) = min(sig1(il, nd), 12.1) enddo endif @@ -413,8 +412,8 @@ !------------------------------------------------------------------- if (iflag_con.eq.3) then - CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1 & - , pbase1, buoybase1, iflag1, sig1, w01) ! nd->na + CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, pbase1, & + buoybase1, iflag1, sig1, w01) ! nd->na endif if (iflag_con.eq.4) then @@ -443,19 +442,12 @@ !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ if (iflag_con.eq.3) then - CALL cv3_compress( len, nloc, ncum, nd, ntra & - , iflag1, nk1, icb1, icbs1 & - , plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1 & - , t1, q1, qs1, u1, v1, gz1, th1 & - , tra1 & - , h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1 & - , sig1, w01 & - , iflag, nk, icb, icbs & - , plcl, tnk, qnk, gznk, pbase, buoybase & - , t, q, qs, u, v, gz, th & - , tra & - , h, lv, cpn, p, ph, tv, tp, tvp, clw & - , sig, w0 ) + CALL cv3_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, & + icbs1, plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1, t1, q1, & + qs1, u1, v1, gz1, th1, tra1, h1, lv1, cpn1, p1, ph1, tv1, tp1, & + tvp1, clw1, sig1, w01, iflag, nk, icb, icbs, plcl, tnk, qnk, & + gznk, pbase, buoybase, t, q, qs, u, v, gz, th, tra, h, lv, & + cpn, p, ph, tv, tp, tvp, clw, sig, w0) endif if (iflag_con.eq.4) then @@ -591,7 +583,7 @@ do i=1, len iflag1(i)=42 end do - ! + if (iflag_con.eq.3) then CALL cv3_uncompress(nloc, len, ncum, nd, ntra, idcum & , iflag &