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

Diff of /trunk/Sources/phylmd/CV30_routines/cv30_feed.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 200 by guez, Thu Jun 2 15:40:30 2016 UTC
# Line 4  module cv30_feed_m Line 4  module cv30_feed_m
4    
5  contains  contains
6    
7    SUBROUTINE cv30_feed(t1, q1, qs1, p1, ph1, gz1, nk1, icb1, icbmax, iflag1, &    SUBROUTINE cv30_feed(t1, q1, qs1, p1, ph1, gz1, icb1, iflag1, tnk1, qnk1, &
8         tnk1, qnk1, gznk1, plcl1)         gznk1, plcl1)
9    
10      ! Purpose: convective feed      ! Purpose: convective feed
11        ! Assuming origin level of ascending parcels is minorig.
12    
13      use cv30_param_m, only: minorig, nl      use cv30_param_m, only: minorig, nl
14      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
# Line 19  contains Line 20  contains
20      real, intent(in):: gz1(:, :) ! (klon, klev)      real, intent(in):: gz1(:, :) ! (klon, klev)
21    
22      ! outputs:      ! outputs:
23      integer, intent(out):: nk1(:), icb1(:) ! (klon)  
24      integer, intent(out):: icbmax      integer, intent(out):: icb1(:) ! (klon)
25      integer, intent(inout):: iflag1(klon)      ! first level above lcl, 2 <= icb1 <= nl - 2
26      real tnk1(klon), qnk1(klon), gznk1(klon)  
27      real, intent(out):: plcl1(klon)      integer, intent(out):: iflag1(:) ! (klon)
28        real tnk1(:), qnk1(:), gznk1(:) ! (klon)
29        real, intent(out):: plcl1(:) ! (klon)
30    
31      ! Local:      ! Local:
32      integer i      integer i
33      real pnk(klon), qsnk(klon), rh(klon), chi(klon)      real rh(klon)
34      real, parameter:: A = 1669., B = 122.      real, parameter:: A = 1669., B = 122.
35    
36      !--------------------------------------------------------------------      !--------------------------------------------------------------------
37    
     plcl1 = 0.  
   
     ! Origin level of ascending parcels  
     nk1 = minorig  
   
     ! Check whether parcel level temperature and specific humidity  
     ! are reasonable  
   
     do i = 1, klon  
        if (t1(i, nk1(i)) < 250. .or. q1(i, nk1(i)) <= 0.) iflag1(i) = 7  
     end do  
   
38      ! Calculate lifted condensation level of air at parcel origin level      ! Calculate lifted condensation level of air at parcel origin level
39      ! (within 0.2 % of formula of Bolton, Mon. Wea. Rev., 1980)      ! (within 0.2 % of formula of Bolton, Mon. Wea. Rev., 1980)
40        where (t1(:, minorig) >= 250. .and. q1(:, minorig) > 0.)
41           ! Parcel level temperature and specific humidity are reasonable.
42           tnk1 = t1(:, minorig)
43           qnk1 = q1(:, minorig)
44           gznk1 = gz1(:, minorig)
45    
46           rh = qnk1 / qs1(:, minorig)
47           plcl1 = p1(:, minorig) * rh**(tnk1 / (A - B * rh - tnk1))
48           iflag1 = 0
49        elsewhere
50           plcl1 = 0.
51           iflag1 = 7
52        end where
53    
54      do i = 1, klon      where (iflag1 == 0 .and. (plcl1 < 200. .or. plcl1 >= 2000.)) iflag1 = 8
        if (iflag1(i) /= 7) then  
           tnk1(i) = t1(i, nk1(i))  
           qnk1(i) = q1(i, nk1(i))  
           gznk1(i) = gz1(i, nk1(i))  
           pnk(i) = p1(i, nk1(i))  
           qsnk(i) = qs1(i, nk1(i))  
   
           rh(i) = qnk1(i) / qsnk(i)  
           chi(i) = tnk1(i) / (A - B*rh(i) - tnk1(i))  
           plcl1(i) = pnk(i)*(rh(i)**chi(i))  
           if ((plcl1(i) < 200. .or. plcl1(i) >= 2000.) .and. iflag1(i) == 0) &  
                iflag1(i) = 8  
        endif  
     end do  
   
     ! Calculate first level above lcl (= icb1)  
55    
56        ! Compute icb1:
57      do i = 1, klon      do i = 1, klon
58         if (plcl1(i) <= ph1(i, nl - 2)) then         if (plcl1(i) <= ph1(i, nl - 2)) then
59            ! Distinguish this case just so that icb1 = nl - 2, not nl =            ! Distinguish this case just so that icb1 = nl - 2, not nl =
# Line 73  contains Line 62  contains
62         else         else
63            icb1(i) = locate(- ph1(i, 3:nl - 2), - plcl1(i), my_lbound = 3)            icb1(i) = locate(- ph1(i, 3:nl - 2), - plcl1(i), my_lbound = 3)
64            ! {2 <= icb1(i) <= nl - 3}            ! {2 <= icb1(i) <= nl - 3}
65            ! {ph1(i, icb1(i) + 1) < plcl1(i) <= ph1(i, icb1(i))}            ! {ph1(i, icb1(i) + 1) < plcl1(i)}
66              ! {plcl1(i) <= ph1(i, icb1(i)) or icb1(i) == 2}
67         end if         end if
68      end do      end do
69    
70      do i = 1, klon      where (icb1 == nl - 2 .and. iflag1 == 0) iflag1 = 9
        if ((icb1(i) == nl - 2).and.(iflag1(i) == 0)) iflag1(i) = 9  
     end do  
   
     ! Compute icbmax  
   
     icbmax = 2  
71    
72      do i = 1, klon      ! {(2 <= icb1(i) <= nl - 3 and ph1(i, icb1(i) + 1) < plcl1(i) and
73         if (iflag1(i) < 7) icbmax = max(icbmax, icb1(i))      ! (plcl1(i) <= ph1(i, icb1(i)) or icb1(i) == 2)) or iflag1(i) /=
74      end do      ! 0}
75    
76    end SUBROUTINE cv30_feed    end SUBROUTINE cv30_feed
77    
Legend:
Removed from v.195  
changed lines
  Added in v.200
  ViewVC Help
Powered by ViewVC 1.1.21