--- trunk/phylmd/cv_driver.f90 2013/11/15 18:45:49 76 +++ trunk/phylmd/cv_driver.f 2014/07/02 18:39:15 99 @@ -4,85 +4,62 @@ contains - 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 + SUBROUTINE cv_driver(len, nd, t1, q1, qs1, u1, v1, p1, ph1, iflag1, ft1, & + fq1, fu1, fv1, 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 ! Main driver for convection - - ! S. Bony, Mar 2002: + ! Author: S. Bony, March 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) + ! - iflag_con = 3: version lmd + ! - iflag_con = 4: version 4.3b use clesphys2, only: iflag_con + use cv3_compress_m, only: cv3_compress + use cv3_mixing_m, only: cv3_mixing use cv3_param_m, only: cv3_param + use cv3_prelim_m, only: cv3_prelim + use cv3_tracer_m, only: cv3_tracer + use cv3_uncompress_m, only: cv3_uncompress + use cv3_unsat_m, only: cv3_unsat + use cv3_yield_m, only: cv3_yield + use cv_uncompress_m, only: cv_uncompress 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 - ! t1 Real Input temperature - ! q1 Real Input specific hum + integer, intent(in):: len ! first dimension + integer, intent(in):: nd ! vertical dimension + real, intent(in):: t1(len, nd) ! temperature + real q1(len, nd) ! Input specific hum + real qs1(len, nd) ! qs1 Real Input sat specific hum + real, intent(in):: u1(len, nd) ! u1 Real Input u-wind + real, intent(in):: v1(len, nd) ! v1 Real Input v-wind - ! tra1 Real Input tracors + real p1(len, nd) ! p1 Real Input full level pressure + real ph1(len, nd + 1) ! ph1 Real Input half level pressure - ! iflag1 Integer Output flag for Emanuel conditions - ! ft1 Real Output temp tend - ! fq1 Real Output spec hum tend - ! fu1 Real Output u-wind tend - ! fv1 Real Output v-wind tend - ! ftra1 Real Output tracor tend - ! precip1 Real Output precipitation - ! VPrecip1 Real Output vertical profile of precipitations - ! cbmf1 Real Output cloud base mass flux - ! delt Real Input time step - ! Ma1 Real Output mass flux adiabatic updraft - ! qcondc1 Real Output in-cld mixing ratio of condensed water - ! wd1 Real Output downdraft velocity scale for sfc fluxes - ! cape1 Real Output CAPE - - integer len - integer nd - integer ndp1 - 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) + ! iflag1 Integer Output flag for Emanuel conditions real ft1(len, nd) + ! ft1 Real Output temp tend real fq1(len, nd) + ! fq1 Real Output spec hum tend real fu1(len, nd) + ! fu1 Real Output u-wind tend real fv1(len, nd) - real ftra1(len, nd, ntra) + ! fv1 Real Output v-wind tend real precip1(len) + ! precip1 Real Output precipitation real VPrecip1(len, nd+1) + ! VPrecip1 Real Output vertical profile of precipitations real cbmf1(len) + ! cbmf1 Real Output cloud base mass flux real, intent(inout):: sig1(klon, klev) ! section adiabatic updraft real, intent(inout):: w01(klon, klev) @@ -91,16 +68,21 @@ integer icb1(klon) integer inb1(klon) real, intent(in):: delt + ! delt Real Input time step real Ma1(len, nd) + ! Ma1 Real Output mass flux adiabatic updraft 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 + ! qcondc1 Real Output in-cld mixing ratio of condensed water real wd1(len) ! gust + ! wd1 Real Output downdraft velocity scale for sfc fluxes real cape1(len) + ! cape1 Real Output CAPE - real da1(len, nd), phi1(len, nd, nd), mp1(len, nd) + real, intent(inout):: da1(len, nd), phi1(len, nd, nd), mp1(len, nd) !------------------------------------------------------------------- ! --- ARGUMENTS @@ -129,13 +111,6 @@ ! 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. @@ -184,9 +159,6 @@ ! 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). @@ -214,10 +186,9 @@ ! Local arrays - integer noff real da(len, nd), phi(len, nd, nd), mp(len, nd) - integer i, k, n, il, j + integer i, k, il integer icbmax integer nk1(klon) integer icbs1(klon) @@ -226,8 +197,6 @@ real tnk1(klon) real qnk1(klon) real gznk1(klon) - real pnk1(klon) - real qsnk1(klon) real pbase1(klon) real buoybase1(klon) @@ -247,7 +216,7 @@ ! (local) compressed fields: integer nloc - parameter (nloc=klon) ! pour l'instant + parameter (nloc = klon) ! pour l'instant integer idcum(nloc) integer iflag(nloc), nk(nloc), icb(nloc) @@ -281,8 +250,6 @@ real tps(nloc, klev), qprime(nloc), tprime(nloc) real precip(nloc) real VPrecip(nloc, klev+1) - real tra(nloc, klev, ntra), trap(nloc, klev, ntra) - real ftra(nloc, klev, ntra), traent(nloc, klev, klev, ntra) real qcondc(nloc, klev) ! cld real wd(nloc) ! gust @@ -318,47 +285,39 @@ ! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS !--------------------------------------------------------------------- - do k=1, nd - do i=1, len - ft1(i, k)=0.0 - fq1(i, k)=0.0 - fu1(i, k)=0.0 - fv1(i, k)=0.0 - tvp1(i, k)=0.0 - tp1(i, k)=0.0 - clw1(i, k)=0.0 + do k = 1, nd + do i = 1, len + ft1(i, k) = 0.0 + fq1(i, k) = 0.0 + fu1(i, k) = 0.0 + fv1(i, k) = 0.0 + tvp1(i, k) = 0.0 + tp1(i, k) = 0.0 + clw1(i, k) = 0.0 !ym - clw(i, k)=0.0 - gz1(i, k) = 0. + clw(i, k) = 0.0 + gz1(i, k) = 0. VPrecip1(i, k) = 0. - Ma1(i, k)=0.0 - upwd1(i, k)=0.0 - dnwd1(i, k)=0.0 - dnwd01(i, k)=0.0 - qcondc1(i, k)=0.0 + Ma1(i, k) = 0.0 + upwd1(i, k) = 0.0 + dnwd1(i, k) = 0.0 + dnwd01(i, k) = 0.0 + qcondc1(i, k) = 0.0 end do end do - do j=1, ntra - do k=1, nd - do i=1, len - ftra1(i, k, j)=0.0 - end do - end do - end do - - do i=1, len - precip1(i)=0.0 - iflag1(i)=0 - wd1(i)=0.0 - cape1(i)=0.0 - VPrecip1(i, nd+1)=0.0 + do i = 1, len + precip1(i) = 0.0 + iflag1(i) = 0 + wd1(i) = 0.0 + cape1(i) = 0.0 + VPrecip1(i, nd+1) = 0.0 end do if (iflag_con.eq.3) then - do il=1, len - sig1(il, nd)=sig1(il, nd) + 1. - sig1(il, nd) = min(sig1(il, nd), 12.1) + do il = 1, len + sig1(il, nd) = sig1(il, nd) + 1. + sig1(il, nd) = min(sig1(il, nd), 12.1) enddo endif @@ -367,12 +326,12 @@ !-------------------------------------------------------------------- if (iflag_con.eq.3) then - CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, lv1, cpn1, tv1, gz1, & - h1, hm1, th1)! nd->na + CALL cv3_prelim(len, nd, nd + 1, t1, q1, p1, ph1, lv1, cpn1, tv1, gz1, & + h1, hm1, th1) endif if (iflag_con.eq.4) then - CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1 & + CALL cv_prelim(len, nd, nd + 1, t1, q1, p1, ph1 & , lv1, cpn1, tv1, gz1, h1, hm1) endif @@ -420,20 +379,16 @@ CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1) endif - !===================================================================== ! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY - !===================================================================== - ncum=0 - do i=1, len + ncum = 0 + do i = 1, len if(iflag1(i).eq.0)then - ncum=ncum+1 - idcum(ncum)=i + ncum = ncum+1 + idcum(ncum) = i endif end do - ! print*, 'klon, ncum = ', len, ncum - IF (ncum.gt.0) THEN !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ @@ -442,12 +397,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, iflag1, nk1, icb1, icbs1, & + plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1, t1, q1, qs1, u1, & + v1, gz1, th1, 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, h, lv, cpn, p, ph, tv, tp, & + tvp, clw, sig, w0) endif if (iflag_con.eq.4) then @@ -507,10 +462,9 @@ !------------------------------------------------------------------- if (iflag_con.eq.3) then - CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb & - , ph, t, q, qs, u, v, tra, h, lv, qnk & - , hp, tv, tvp, ep, clw, m, sig & - , ment, qent, uent, vent, nent, sij, elij, ments, qents, traent)! na->nd + CALL cv3_mixing(nloc, ncum, nd, nd, icb, nk, inb, ph, t, q, & + qs, u, v, h, lv, qnk, hp, tv, tvp, ep, clw, m, sig, ment, & + qent, uent, vent, nent, sij, elij, ments, qents) endif if (iflag_con.eq.4) then @@ -525,11 +479,11 @@ !------------------------------------------------------------------- if (iflag_con.eq.3) then - CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb & - , t, q, qs, gz, u, v, tra, p, ph & + CALL cv3_unsat(nloc, ncum, nd, nd, icb, inb & + , t, q, qs, gz, u, v, p, ph & , th, tv, lv, cpn, ep, sigp, clw & , m, ment, elij, delt, plcl & - , mp, qp, up, vp, trap, wt, water, evap, b)! na->nd + , mp, qp, up, vp, wt, water, evap, b)! na->nd endif if (iflag_con.eq.4) then @@ -545,14 +499,14 @@ !------------------------------------------------------------------- if (iflag_con.eq.3) then - CALL cv3_yield(nloc, ncum, nd, nd, ntra & + CALL cv3_yield(nloc, ncum, nd, nd & , icb, inb, delt & - , t, q, u, v, tra, gz, p, ph, h, hp, lv, cpn, th & - , ep, clw, m, tp, mp, qp, up, vp, trap & + , t, q, u, v, gz, p, ph, h, hp, lv, cpn, th & + , ep, clw, m, tp, mp, qp, up, vp & , wt, water, evap, b & - , ment, qent, uent, vent, nent, elij, traent, sig & + , ment, qent, uent, vent, nent, elij, sig & , tv, tvp & - , iflag, precip, VPrecip, ft, fq, fu, fv, ftra & + , iflag, precip, VPrecip, ft, fq, fu, fv & , upwd, dnwd, dnwd0, ma, mike, tls, tps, qcondc, wd)! na->nd endif @@ -579,25 +533,17 @@ !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ! --- UNCOMPRESS THE FIELDS !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - ! set iflag1 =42 for non convective points - do i=1, len - iflag1(i)=42 + ! set iflag1 = 42 for non convective points + 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 & - , precip, VPrecip, sig, w0 & - , ft, fq, fu, fv, ftra & - , inb & - , Ma, upwd, dnwd, dnwd0, qcondc, wd, cape & - , da, phi, mp & - , iflag1 & - , precip1, VPrecip1, sig1, w01 & - , ft1, fq1, fu1, fv1, ftra1 & - , inb1 & - , Ma1, upwd1, dnwd1, dnwd01, qcondc1, wd1, cape1 & - , da1, phi1, mp1) + CALL cv3_uncompress(nloc, len, ncum, nd, idcum, iflag, precip, & + VPrecip, sig, w0, ft, fq, fu, fv, inb, Ma, upwd, dnwd, dnwd0, & + qcondc, wd, cape, da, phi, mp, iflag1, precip1, VPrecip1, & + sig1, w01, ft1, fq1, fu1, fv1, inb1, Ma1, upwd1, dnwd1, & + dnwd01, qcondc1, wd1, cape1, da1, phi1, mp1) endif if (iflag_con.eq.4) then