/[lmdze]/trunk/Sources/phylmd/cv_driver.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/cv_driver.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 195 by guez, Wed May 18 17:56:44 2016 UTC revision 196 by guez, Mon May 23 13:50:39 2016 UTC
# Line 46  contains Line 46  contains
46      ! value of PH should be greater than (i.e. at a lower level than)      ! value of PH should be greater than (i.e. at a lower level than)
47      ! the first value of the array P1.      ! the first value of the array P1.
48    
49      integer, intent(out):: iflag1(klon)      integer, intent(out):: iflag1(:) ! (klon)
50      ! Flag for Emanuel conditions.      ! Flag for Emanuel conditions.
51    
52      ! 0: Moist convection occurs.      ! 0: Moist convection occurs.
# Line 108  contains Line 108  contains
108    
109      real da(klon, klev), phi(klon, klev, klev), mp(klon, klev)      real da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
110      integer i, k, il      integer i, k, il
     integer icbmax  
111      integer nk1(klon)      integer nk1(klon)
112      integer icbs1(klon)      integer icbs1(klon)
113      real plcl1(klon)      real plcl1(klon)
# Line 130  contains Line 129  contains
129      integer ncum      integer ncum
130    
131      ! Compressed fields:      ! Compressed fields:
132      integer idcum(klon)      integer, allocatable:: idcum(:), iflag(:) ! (ncum)
133      integer iflag(klon), nk(klon)      integer nk(klon)
134      integer, allocatable:: icb(:) ! (ncum)      integer, allocatable:: icb(:) ! (ncum)
135      integer nent(klon, klev)      integer nent(klon, klev)
136      integer icbs(klon)      integer icbs(klon)
137      integer inb(klon)      integer inb(klon)
138      real plcl(klon), tnk(klon), qnk(klon), gznk(klon)      real, allocatable:: plcl(:) ! (ncum)
139        real tnk(klon), qnk(klon), gznk(klon)
140      real t(klon, klev), q(klon, klev), qs(klon, klev)      real t(klon, klev), q(klon, klev), qs(klon, klev)
141      real u(klon, klev), v(klon, klev)      real u(klon, klev), v(klon, klev)
142      real gz(klon, klev), h(klon, klev), lv(klon, klev), cpn(klon, klev)      real gz(klon, klev), h(klon, klev), lv(klon, klev), cpn(klon, klev)
# Line 169  contains Line 169  contains
169      !-------------------------------------------------------------------      !-------------------------------------------------------------------
170    
171      ! SET CONSTANTS AND PARAMETERS      ! SET CONSTANTS AND PARAMETERS
   
     ! set thermodynamical constants:  
172      CALL cv_thermo      CALL cv_thermo
   
173      CALL cv30_param      CALL cv30_param
174    
175      ! INITIALIZE OUTPUT ARRAYS AND PARAMETERS      ! INITIALIZE OUTPUT ARRAYS AND PARAMETERS
# Line 198  contains Line 195  contains
195      end do      end do
196    
197      precip1 = 0.      precip1 = 0.
     iflag1 = 0  
198      cape1 = 0.      cape1 = 0.
199      VPrecip1(:, klev + 1) = 0.      VPrecip1(:, klev + 1) = 0.
200    
# Line 209  contains Line 205  contains
205    
206      CALL cv30_prelim(klon, klev, klev + 1, t1, q1, p1, ph1, lv1, cpn1, tv1, &      CALL cv30_prelim(klon, klev, klev + 1, t1, q1, p1, ph1, lv1, cpn1, tv1, &
207           gz1, h1, hm1, th1)           gz1, h1, hm1, th1)
208      CALL cv30_feed(t1, q1, qs1, p1, ph1, gz1, nk1, icb1, icbmax, iflag1, &      CALL cv30_feed(t1, q1, qs1, p1, ph1, gz1, nk1, icb1, iflag1, tnk1, qnk1, &
209           tnk1, qnk1, gznk1, plcl1)           gznk1, plcl1)
210      CALL cv30_undilute1(t1, q1, qs1, gz1, plcl1, p1, nk1, icb1, tp1, tvp1, &      CALL cv30_undilute1(t1, q1, qs1, gz1, plcl1, p1, nk1, icb1, tp1, tvp1, &
211           clw1, icbs1)           clw1, icbs1)
212      CALL cv30_trigger(icb1, plcl1, p1, th1, tv1, tvp1, pbase1, buoybase1, &      CALL cv30_trigger(icb1, plcl1, p1, th1, tv1, tvp1, pbase1, buoybase1, &
213           iflag1, sig1, w01)           iflag1, sig1, w01)
214    
215      ! Moist convective adjustment is necessary      ncum = count(iflag1 == 0)
   
     ncum = 0  
     do i = 1, klon  
        if (iflag1(i) == 0) then  
           ncum = ncum + 1  
           idcum(ncum) = i  
        endif  
     end do  
216    
217      IF (ncum > 0) THEN      IF (ncum > 0) THEN
218         allocate(b(ncum, nl - 1), evap(ncum, nl), icb(ncum))         ! Moist convective adjustment is necessary
219         CALL cv30_compress(ncum, iflag1, nk1, icb1, icbs1, plcl1, tnk1, qnk1, &         allocate(idcum(ncum), plcl(ncum))
220              gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, gz1, th1, h1, lv1, &         allocate(b(ncum, nl - 1), evap(ncum, nl), icb(ncum), iflag(ncum))
221              cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, iflag, nk, icb, &         idcum = pack((/(i, i = 1, klon)/), iflag1 == 0)
222              icbs, plcl, tnk, qnk, gznk, pbase, buoybase, t, q, qs, u, v, gz, &         CALL cv30_compress(iflag1, nk1, icb1, icbs1, plcl1, tnk1, qnk1, gznk1, &
223              th, h, lv, cpn, p, ph, tv, tp, tvp, clw, sig, w0)              pbase1, buoybase1, t1, q1, qs1, u1, v1, gz1, th1, h1, lv1, cpn1, &
224                p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, nk, icb, icbs, plcl, &
225                tnk, qnk, gznk, pbase, buoybase, t, q, qs, u, v, gz, th, h, lv, &
226                cpn, p, ph, tv, tp, tvp, clw, sig, w0)
227         CALL cv30_undilute2(icb, icbs(:ncum), nk, tnk, qnk, gznk, t, qs, gz, &         CALL cv30_undilute2(icb, icbs(:ncum), nk, tnk, qnk, gznk, t, qs, gz, &
228              p, h, tv, lv, pbase, buoybase, plcl, inb(:ncum), tp, tvp, clw, &              p, h, tv, lv, pbase(:ncum), buoybase(:ncum), plcl, inb(:ncum), &
229              hp, ep, buoy)              tp, tvp, clw, hp, ep, buoy)
230         CALL cv30_closure(icb, inb(:ncum), pbase, p, ph, tv, buoy, sig, w0, &         CALL cv30_closure(icb, inb(:ncum), pbase, p, ph(:ncum, :), tv, buoy, &
231              cape, m)              sig, w0, cape, m)
232         CALL cv30_mixing(icb, nk(:ncum), inb(:ncum), t, q, qs, u, v, h, lv, &         CALL cv30_mixing(icb, nk(:ncum), inb(:ncum), t, q, qs, u, v, h, lv, &
233              hp, ep, clw, m, sig, ment, qent, uent, vent, nent, sij, elij, &              hp, ep, clw, m, sig, ment, qent, uent, vent, nent, sij, elij, &
234              ments, qents)              ments, qents)
235         CALL cv30_unsat(icb, inb(:ncum), t(:ncum, :nl), q(:ncum, :nl), &         CALL cv30_unsat(icb, inb(:ncum), t(:ncum, :nl), q(:ncum, :nl), &
236              qs(:ncum, :nl), gz, u, v, p, ph, th(:ncum, :nl - 1), tv, lv, cpn, &              qs(:ncum, :nl), gz, u, v, p, ph(:ncum, :), th(:ncum, :nl - 1), &
237              ep(:ncum, :), clw(:ncum, :), m(:ncum, :), ment(:ncum, :, :), &              tv, lv, cpn, ep(:ncum, :), clw(:ncum, :), m(:ncum, :), &
238              elij(:ncum, :, :), dtphys, plcl, mp, qp(:ncum, :nl), &              ment(:ncum, :, :), elij(:ncum, :, :), dtphys, plcl, mp, &
239              up(:ncum, :nl), vp(:ncum, :nl), wt(:ncum, :nl), &              qp(:ncum, :nl), up(:ncum, :nl), vp(:ncum, :nl), wt(:ncum, :nl), &
240              water(:ncum, :nl), evap, b)              water(:ncum, :nl), evap, b)
241         CALL cv30_yield(icb, inb(:ncum), dtphys, t, q, u, v, gz, p, ph, h, hp, &         CALL cv30_yield(icb, inb(:ncum), dtphys, t, q, u, v, gz, p, ph, h, hp, &
242              lv, cpn, th, ep, clw, m, tp, mp, qp, up, vp(:ncum, 2:nl), &              lv, cpn, th, ep, clw, m, tp, mp, qp, up, vp(:ncum, 2:nl), &
# Line 253  contains Line 244  contains
244              vent, nent, elij, sig, tv, tvp, iflag, precip, VPrecip, ft, fq, &              vent, nent, elij, sig, tv, tvp, iflag, precip, VPrecip, ft, fq, &
245              fu, fv, upwd, dnwd, dnwd0, ma, mike, tls, tps, qcondc)              fu, fv, upwd, dnwd, dnwd0, ma, mike, tls, tps, qcondc)
246         CALL cv30_tracer(klon, ncum, klev, ment, sij, da, phi)         CALL cv30_tracer(klon, ncum, klev, ment, sij, da, phi)
247           CALL cv30_uncompress(idcum, iflag, precip, VPrecip, sig, w0, ft, fq, &
248         ! UNCOMPRESS THE FIELDS              fu, fv, inb, Ma, upwd, dnwd, dnwd0, qcondc, cape, da, phi, mp, &
249         iflag1 = 42 ! for non convective points              iflag1, precip1, VPrecip1, sig1, w01, ft1, fq1, fu1, fv1, inb1, &
250         CALL cv30_uncompress(idcum(:ncum), iflag, precip, VPrecip, sig, w0, &              Ma1, upwd1, dnwd1, dnwd01, qcondc1, cape1, da1, phi1, mp1)
             ft, fq, fu, fv, inb, Ma, upwd, dnwd, dnwd0, qcondc, cape, &  
             da, phi, mp, iflag1, precip1, VPrecip1, sig1, w01, ft1, fq1, &  
             fu1, fv1, inb1, Ma1, upwd1, dnwd1, dnwd01, qcondc1, cape1, da1, &  
             phi1, mp1)  
251      ENDIF      ENDIF
252    
253    end SUBROUTINE cv_driver    end SUBROUTINE cv_driver
Legend:
Removed from v.195  
changed lines
  Added in v.196
  ViewVC Help
Powered by ViewVC 1.1.21