/[lmdze]/trunk/Sources/phylmd/CV30_routines/cv30_yield.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/CV30_routines/cv30_yield.f

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

revision 198 by guez, Tue May 31 16:17:35 2016 UTC revision 200 by guez, Thu Jun 2 15:40:30 2016 UTC
# Line 21  contains Line 21  contains
21      ! inputs:      ! inputs:
22      integer, intent(in):: icb(:), inb(:) ! (ncum)      integer, intent(in):: icb(:), inb(:) ! (ncum)
23      real, intent(in):: delt      real, intent(in):: delt
24      real t(klon, klev), rr(klon, klev), u(klon, klev), v(klon, klev)      real, intent(in):: t(klon, klev), rr(klon, klev)
25        real, intent(in):: u(klon, klev), v(klon, klev)
26      real gz(klon, klev)      real gz(klon, klev)
27      real p(klon, klev)      real p(klon, klev)
28      real ph(klon, klev + 1), h(klon, klev), hp(klon, klev)      real ph(klon, klev + 1), h(klon, klev), hp(klon, klev)
# Line 42  contains Line 43  contains
43      real sig(klon, klev)      real sig(klon, klev)
44      real tv(klon, klev), tvp(klon, klev)      real tv(klon, klev), tvp(klon, klev)
45    
     integer, intent(out):: iflag(:) ! (ncum)  
   
46      ! outputs:      ! outputs:
47        integer, intent(out):: iflag(:) ! (ncum)
48      real precip(klon)      real precip(klon)
49      real VPrecip(klon, klev + 1)      real VPrecip(klon, klev + 1)
50      real ft(klon, klev), fr(klon, klev), fu(klon, klev), fv(klon, klev)      real ft(klon, klev), fr(klon, klev), fu(klon, klev), fv(klon, klev)
# Line 58  contains Line 58  contains
58      ! Local:      ! Local:
59      real, parameter:: delta = 0.01 ! interface cloud parameterization      real, parameter:: delta = 0.01 ! interface cloud parameterization
60      integer ncum      integer ncum
61      integer i, k, il, n, j, num1      integer i, k, il, n, j
62      real rat, awat, delti      real awat, delti
63      real ax, bx, cx, dx      real ax, bx, cx, dx
64      real cpinv, rdcp, dpinv      real cpinv, rdcp, dpinv
65      real lvcp(klon, klev)      real lvcp(klon, klev)
# Line 102  contains Line 102  contains
102         enddo         enddo
103      enddo      enddo
104    
105      ! calculate surface precipitation in mm / day      ! calculate surface precipitation in mm / day
106    
107      do il = 1, ncum      do il = 1, ncum
108         if (ep(il, inb(il)) >= 1e-4) precip(il) = wt(il, 1) * sigd &         if (ep(il, inb(il)) >= 1e-4) precip(il) = wt(il, 1) * sigd &
# Line 119  contains Line 119  contains
119         end do         end do
120      end do      end do
121    
122      ! calculate tendencies of lowest level potential temperature      ! calculate tendencies of lowest level potential temperature
123      ! and mixing ratio      ! and mixing ratio
124    
125      do il = 1, ncum      do il = 1, ncum
126         work(il) = 1.0 / (ph(il, 1) - ph(il, 2))         work(il) = 1.0 / (ph(il, 1) - ph(il, 2))
# Line 134  contains Line 134  contains
134      enddo      enddo
135    
136      do il = 1, ncum      do il = 1, ncum
        ! Consist vect:  
137         if (0.01 * rg * work(il) * am(il) >= delti) iflag(il) = 1         if (0.01 * rg * work(il) * am(il) >= delti) iflag(il) = 1
138    
139         ft(il, 1) = 0.01 * rg * work(il) * am(il) * (t(il, 2) - t(il, 1) &         ft(il, 1) = 0.01 * rg * work(il) * am(il) * (t(il, 2) - t(il, 1) &
140              + (gz(il, 2) - gz(il, 1)) / cpn(il, 1))              + (gz(il, 2) - gz(il, 1)) / cpn(il, 1)) - 0.5 * lvcp(il, 1) &
141                * sigd * (evap(il, 1) + evap(il, 2)) - 0.009 * rg * sigd &
142         ft(il, 1) = ft(il, 1) - 0.5 * lvcp(il, 1) * sigd * (evap(il, 1) &              * mp(il, 2) * t(il, 1) * b(il, 1) * work(il) + 0.01 * sigd &
143              + evap(il, 2))              * wt(il, 1) * (cl - cpd) * water(il, 2) * (t(il, 2) - t(il, 1)) &
144                * work(il) / cpn(il, 1)
        ft(il, 1) = ft(il, 1) - 0.009 * rg * sigd * mp(il, 2) &  
             * t(il, 1) * b(il, 1) * work(il)  
   
        ft(il, 1) = ft(il, 1) + 0.01 * sigd * wt(il, 1) * (cl - cpd) &  
             * water(il, 2) * (t(il, 2) - t(il, 1)) * work(il) / cpn(il, 1)  
145    
146         !jyg1 Correction pour mieux conserver l'eau (conformite avec CONVECT4.3)         !jyg1 Correction pour mieux conserver l'eau (conformite avec CONVECT4.3)
147         ! (sb: pour l'instant, on ne fait que le chgt concernant rg, pas evap)         ! (sb: pour l'instant, on ne fait que le chgt concernant rg, pas evap)
# Line 162  contains Line 156  contains
156              * (up(il, 2) - u(il, 1)) + am(il) * (u(il, 2) - u(il, 1)))              * (up(il, 2) - u(il, 1)) + am(il) * (u(il, 2) - u(il, 1)))
157         fv(il, 1) = fv(il, 1) + 0.01 * rg * work(il) * (mp(il, 2) &         fv(il, 1) = fv(il, 1) + 0.01 * rg * work(il) * (mp(il, 2) &
158              * (vp(il, 2) - v(il, 1)) + am(il) * (v(il, 2) - v(il, 1)))              * (vp(il, 2) - v(il, 1)) + am(il) * (v(il, 2) - v(il, 1)))
159      enddo ! il      enddo
160    
161      do j = 2, nl      do j = 2, nl
162         do il = 1, ncum         do il = 1, ncum
# Line 177  contains Line 171  contains
171         enddo         enddo
172      enddo      enddo
173    
174      ! calculate tendencies of potential temperature and mixing ratio      ! calculate tendencies of potential temperature and mixing ratio
175      ! at levels above the lowest level      ! at levels above the lowest level
176    
177      ! first find the net saturated updraft and downdraft mass fluxes      ! first find the net saturated updraft and downdraft mass fluxes
178      ! through each level      ! through each level
179    
180      loop_i: do i = 2, nl - 1      loop_i: do i = 2, nl - 1
181         num1 = 0         if (any(inb >= i)) then
   
        do il = 1, ncum  
           if (i <= inb(il)) num1 = num1 + 1  
        enddo  
   
        if (num1 > 0) then  
182            amp1(:ncum) = 0.            amp1(:ncum) = 0.
183            ad(:ncum) = 0.            ad(:ncum) = 0.
184    
# Line 227  contains Line 215  contains
215                  dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))                  dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))
216                  cpinv = 1.0 / cpn(il, i)                  cpinv = 1.0 / cpn(il, i)
217    
                 ! Vecto:  
218                  if (0.01 * rg * dpinv * amp1(il) >= delti) iflag(il) = 1                  if (0.01 * rg * dpinv * amp1(il) >= delti) iflag(il) = 1
219    
220                  ft(il, i) = 0.01 * rg * dpinv * (amp1(il) * (t(il, i + 1) &                  ft(il, i) = 0.01 * rg * dpinv * (amp1(il) * (t(il, i + 1) &
221                       - t(il, i) + (gz(il, i + 1) - gz(il, i)) * cpinv) &                       - t(il, i) + (gz(il, i + 1) - gz(il, i)) * cpinv) &
222                       - ad(il) * (t(il, i) - t(il, i - 1) + (gz(il, i) &                       - ad(il) * (t(il, i) - t(il, i - 1) + (gz(il, i) &
223                       - gz(il, i - 1)) * cpinv)) - 0.5 * sigd * lvcp(il, i) &                       - gz(il, i - 1)) * cpinv)) - 0.5 * sigd * lvcp(il, i) &
224                       * (evap(il, i) + evap(il, i + 1))                       * (evap(il, i) + evap(il, i + 1)) - 0.009 * rg * sigd &
225                  rat = cpn(il, i - 1) * cpinv                       * (mp(il, i + 1) * t(il, i) * b(il, i) - mp(il, i) &
226                  ft(il, i) = ft(il, i) - 0.009 * rg * sigd * (mp(il, i + 1) &                       * t(il, i - 1) * cpn(il, i - 1) * cpinv * b(il, i - 1)) &
227                       * t(il, i) * b(il, i) - mp(il, i) * t(il, i - 1) * rat &                       * dpinv + 0.01 * rg * dpinv * ment(il, i, i) &
                      * b(il, i - 1)) * dpinv  
                 ft(il, i) = ft(il, i) + 0.01 * rg * dpinv * ment(il, i, i) &  
228                       * (hp(il, i) - h(il, i) + t(il, i) * (cpv - cpd) &                       * (hp(il, i) - h(il, i) + t(il, i) * (cpv - cpd) &
229                       * (rr(il, i) - qent(il, i, i))) * cpinv                       * (rr(il, i) - qent(il, i, i))) * cpinv + 0.01 * sigd &
230                         * wt(il, i) * (cl - cpd) * water(il, i + 1) &
231                  ft(il, i) = ft(il, i) + 0.01 * sigd * wt(il, i) * (cl - cpd) &                       * (t(il, i + 1) - t(il, i)) * dpinv * cpinv
                      * water(il, i + 1) * (t(il, i + 1) - t(il, i)) * dpinv &  
                      * cpinv  
   
232                  fr(il, i) = 0.01 * rg * dpinv * (amp1(il) * (rr(il, i + 1) &                  fr(il, i) = 0.01 * rg * dpinv * (amp1(il) * (rr(il, i + 1) &
233                       - rr(il, i)) - ad(il) * (rr(il, i) - rr(il, i - 1)))                       - rr(il, i)) - ad(il) * (rr(il, i) - rr(il, i - 1)))
234                  fu(il, i) = fu(il, i) + 0.01 * rg * dpinv * (amp1(il) &                  fu(il, i) = fu(il, i) + 0.01 * rg * dpinv * (amp1(il) &
# Line 346  contains Line 328  contains
328         end if         end if
329      end do loop_i      end do loop_i
330    
331      ! move the detrainment at level inb down to level inb - 1      ! move the detrainment at level inb down to level inb - 1
332      ! in such a way as to preserve the vertically      ! in such a way as to preserve the vertically
333      ! integrated enthalpy and water tendencies      ! integrated enthalpy and water tendencies
334    
335      do il = 1, ncum      do il = 1, ncum
336         ax = 0.1 * ment(il, inb(il), inb(il)) * (hp(il, inb(il)) &         ax = 0.1 * ment(il, inb(il), inb(il)) * (hp(il, inb(il)) &
# Line 383  contains Line 365  contains
365    
366      end do      end do
367    
368      ! homoginize tendencies below cloud base      ! homoginize tendencies below cloud base
369    
370      do il = 1, ncum      do il = 1, ncum
371         asum(il) = 0.0         asum(il) = 0.0
# Line 415  contains Line 397  contains
397         enddo         enddo
398      enddo      enddo
399    
400      ! reset counter and return      ! reset counter and return
401    
402      do il = 1, ncum      do il = 1, ncum
403         sig(il, klev) = 2.0         sig(il, klev) = 2.0
# Line 481  contains Line 463  contains
463         enddo         enddo
464      enddo      enddo
465    
466      !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc      ! D\'etermination de la variation de flux ascendant entre
467      ! determination de la variation de flux ascendant entre      ! deux niveaux non dilu\'es mike
     ! deux niveau non dilue mike  
     !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc  
468    
469      do i = 1, nl      do i = 1, nl
470         do il = 1, ncum         do il = 1, ncum
# Line 526  contains Line 506  contains
506         enddo         enddo
507      enddo      enddo
508    
509      !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc      ! icb repr\'esente le niveau o\`u se trouve la base du nuage, et
510      ! icb represente de niveau ou se trouve la      ! inb le sommet du nuage
     ! base du nuage, et inb le top du nuage  
     !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc  
511    
512      do i = 1, klev      do i = 1, klev
513         DO il = 1, ncum         DO il = 1, ncum
# Line 540  contains Line 518  contains
518         end DO         end DO
519      enddo      enddo
520    
521      ! diagnose the in-cloud mixing ratio      ! Diagnose the in-cloud mixing ratio of condensed water
     ! of condensed water  
     !  
522    
523      do i = 1, klev      do i = 1, klev
524         do il = 1, ncum         do il = 1, ncum
Legend:
Removed from v.198  
changed lines
  Added in v.200
  ViewVC Help
Powered by ViewVC 1.1.21