/[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 198 by guez, Tue May 31 16:17:35 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  
     integer nk1(klon)  
111      integer icbs1(klon)      integer icbs1(klon)
112      real plcl1(klon)      real plcl1(klon)
113      real tnk1(klon)      real tnk1(klon)
# Line 130  contains Line 128  contains
128      integer ncum      integer ncum
129    
130      ! Compressed fields:      ! Compressed fields:
131      integer idcum(klon)      integer, allocatable:: idcum(:), iflag(:) ! (ncum)
     integer iflag(klon), nk(klon)  
132      integer, allocatable:: icb(:) ! (ncum)      integer, allocatable:: icb(:) ! (ncum)
133      integer nent(klon, klev)      integer nent(klon, klev)
134      integer icbs(klon)      integer icbs(klon)
135      integer inb(klon)      integer inb(klon)
136      real plcl(klon), tnk(klon), qnk(klon), gznk(klon)      real, allocatable:: plcl(:) ! (ncum)
137        real tnk(klon), qnk(klon), gznk(klon)
138      real t(klon, klev), q(klon, klev), qs(klon, klev)      real t(klon, klev), q(klon, klev), qs(klon, klev)
139      real u(klon, klev), v(klon, klev)      real u(klon, klev), v(klon, klev)
140      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 167  contains
167      !-------------------------------------------------------------------      !-------------------------------------------------------------------
168    
169      ! SET CONSTANTS AND PARAMETERS      ! SET CONSTANTS AND PARAMETERS
   
     ! set thermodynamical constants:  
170      CALL cv_thermo      CALL cv_thermo
   
171      CALL cv30_param      CALL cv30_param
172    
173      ! INITIALIZE OUTPUT ARRAYS AND PARAMETERS      ! INITIALIZE OUTPUT ARRAYS AND PARAMETERS
# Line 198  contains Line 193  contains
193      end do      end do
194    
195      precip1 = 0.      precip1 = 0.
     iflag1 = 0  
196      cape1 = 0.      cape1 = 0.
197      VPrecip1(:, klev + 1) = 0.      VPrecip1(:, klev + 1) = 0.
198    
# Line 207  contains Line 201  contains
201         sig1(il, klev) = min(sig1(il, klev), 12.1)         sig1(il, klev) = min(sig1(il, klev), 12.1)
202      enddo      enddo
203    
204      CALL cv30_prelim(klon, klev, klev + 1, t1, q1, p1, ph1, lv1, cpn1, tv1, &      CALL cv30_prelim(t1, q1, p1, ph1, lv1, cpn1, tv1, gz1, h1, hm1, th1)
205           gz1, h1, hm1, th1)      CALL cv30_feed(t1, q1, qs1, p1, ph1, gz1, icb1, iflag1, tnk1, qnk1, &
206      CALL cv30_feed(t1, q1, qs1, p1, ph1, gz1, nk1, icb1, icbmax, iflag1, &           gznk1, plcl1)
207           tnk1, qnk1, gznk1, plcl1)      CALL cv30_undilute1(t1, q1, qs1, gz1, plcl1, p1, icb1, tp1, tvp1, clw1, &
208      CALL cv30_undilute1(t1, q1, qs1, gz1, plcl1, p1, nk1, icb1, tp1, tvp1, &           icbs1)
          clw1, icbs1)  
209      CALL cv30_trigger(icb1, plcl1, p1, th1, tv1, tvp1, pbase1, buoybase1, &      CALL cv30_trigger(icb1, plcl1, p1, th1, tv1, tvp1, pbase1, buoybase1, &
210           iflag1, sig1, w01)           iflag1, sig1, w01)
211    
212      ! 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  
213    
214      IF (ncum > 0) THEN      IF (ncum > 0) THEN
215         allocate(b(ncum, nl - 1), evap(ncum, nl), icb(ncum))         ! Moist convective adjustment is necessary
216         CALL cv30_compress(ncum, iflag1, nk1, icb1, icbs1, plcl1, tnk1, qnk1, &         allocate(idcum(ncum), plcl(ncum))
217              gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, gz1, th1, h1, lv1, &         allocate(b(ncum, nl - 1), evap(ncum, nl), icb(ncum), iflag(ncum))
218              cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, iflag, nk, icb, &         idcum = pack((/(i, i = 1, klon)/), iflag1 == 0)
219              icbs, plcl, tnk, qnk, gznk, pbase, buoybase, t, q, qs, u, v, gz, &         CALL cv30_compress(iflag1, icb1, icbs1, plcl1, tnk1, qnk1, gznk1, &
220              th, h, lv, cpn, p, ph, tv, tp, tvp, clw, sig, w0)              pbase1, buoybase1, t1, q1, qs1, u1, v1, gz1, th1, h1, lv1, cpn1, &
221         CALL cv30_undilute2(icb, icbs(:ncum), nk, tnk, qnk, gznk, t, qs, gz, &              p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, icb, icbs, plcl, tnk, &
222              p, h, tv, lv, pbase, buoybase, plcl, inb(:ncum), tp, tvp, clw, &              qnk, gznk, pbase, buoybase, t, q, qs, u, v, gz, th, h, lv, cpn, &
223              hp, ep, buoy)              p, ph, tv, tp, tvp, clw, sig, w0)
224         CALL cv30_closure(icb, inb(:ncum), pbase, p, ph, tv, buoy, sig, w0, &         CALL cv30_undilute2(icb, icbs(:ncum), tnk, qnk, gznk, t, qs, gz, p, h, &
225              cape, m)              tv, lv, pbase(:ncum), buoybase(:ncum), plcl, inb(:ncum), tp, tvp, &
226         CALL cv30_mixing(icb, nk(:ncum), inb(:ncum), t, q, qs, u, v, h, lv, &              clw, hp, ep, buoy)
227              hp, ep, clw, m, sig, ment, qent, uent, vent, nent, sij, elij, &         CALL cv30_closure(icb, inb(:ncum), pbase, p, ph(:ncum, :), tv, buoy, &
228              ments, qents)              sig, w0, cape, m)
229           CALL cv30_mixing(icb, inb(:ncum), t, q, qs, u, v, h, lv, hp, ep, clw, &
230                m, sig, ment, qent, uent, vent, nent, sij, elij, ments, qents)
231         CALL cv30_unsat(icb, inb(:ncum), t(:ncum, :nl), q(:ncum, :nl), &         CALL cv30_unsat(icb, inb(:ncum), t(:ncum, :nl), q(:ncum, :nl), &
232              qs(:ncum, :nl), gz, u, v, p, ph, th(:ncum, :nl - 1), tv, lv, cpn, &              qs(:ncum, :nl), gz, u(:ncum, :nl), v(:ncum, :nl), p, &
233              ep(:ncum, :), clw(:ncum, :), m(:ncum, :), ment(:ncum, :, :), &              ph(:ncum, :), th(:ncum, :nl - 1), tv, lv(:ncum, :), &
234              elij(:ncum, :, :), dtphys, plcl, mp, qp(:ncum, :nl), &              cpn(:ncum, :nl), ep(:ncum, :), clw(:ncum, :), m(:ncum, :), &
235              up(:ncum, :nl), vp(:ncum, :nl), wt(:ncum, :nl), &              ment(:ncum, :, :), elij(:ncum, :, :), dtphys, plcl, mp, &
236                qp(:ncum, :nl), up(:ncum, :nl), vp(:ncum, :nl), wt(:ncum, :nl), &
237              water(:ncum, :nl), evap, b)              water(:ncum, :nl), evap, b)
238         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, &
239              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 241  contains
241              vent, nent, elij, sig, tv, tvp, iflag, precip, VPrecip, ft, fq, &              vent, nent, elij, sig, tv, tvp, iflag, precip, VPrecip, ft, fq, &
242              fu, fv, upwd, dnwd, dnwd0, ma, mike, tls, tps, qcondc)              fu, fv, upwd, dnwd, dnwd0, ma, mike, tls, tps, qcondc)
243         CALL cv30_tracer(klon, ncum, klev, ment, sij, da, phi)         CALL cv30_tracer(klon, ncum, klev, ment, sij, da, phi)
244           CALL cv30_uncompress(idcum, iflag, precip, VPrecip, sig, w0, ft, fq, &
245         ! UNCOMPRESS THE FIELDS              fu, fv, inb, Ma, upwd, dnwd, dnwd0, qcondc, cape, da, phi, mp, &
246         iflag1 = 42 ! for non convective points              iflag1, precip1, VPrecip1, sig1, w01, ft1, fq1, fu1, fv1, inb1, &
247         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)  
248      ENDIF      ENDIF
249    
250    end SUBROUTINE cv_driver    end SUBROUTINE cv_driver
Legend:
Removed from v.195  
changed lines
  Added in v.198
  ViewVC Help
Powered by ViewVC 1.1.21