/[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 186 by guez, Mon Mar 21 15:36:26 2016 UTC revision 195 by guez, Wed May 18 17:56:44 2016 UTC
# Line 4  module cv30_feed_m Line 4  module cv30_feed_m
4    
5  contains  contains
6    
7    SUBROUTINE cv30_feed(len, nd, t, q, qs, p, ph, gz, nk, icb, icbmax, iflag, &    SUBROUTINE cv30_feed(t1, q1, qs1, p1, ph1, gz1, nk1, icb1, icbmax, iflag1, &
8         tnk, qnk, gznk, plcl)         tnk1, qnk1, gznk1, plcl1)
9    
10      ! Purpose: convective feed      ! Purpose: convective feed
11    
     ! Main differences with cv_feed:  
     ! - ph added in input  
     ! - here, nk(i) = minorig  
     ! - icb defined differently (plcl compared with ph instead of p)  
   
12      use cv30_param_m, only: minorig, nl      use cv30_param_m, only: minorig, nl
13        USE dimphy, ONLY: klev, klon
14        use numer_rec_95, only: locate
15    
16      integer, intent(in):: len, nd      real, intent(in):: t1(:, :) ! (klon, klev)
17      real, intent(in):: t(len, nd)      real, intent(in):: q1(:, :), qs1(:, :), p1(:, :) ! (klon, klev)
18      real, intent(in):: q(len, nd), qs(len, nd), p(len, nd)      real, intent(in):: ph1(:, :) ! (klon, klev+1)
19      real, intent(in):: ph(len, nd+1)      real, intent(in):: gz1(:, :) ! (klon, klev)
     real, intent(in):: gz(len, nd)  
20    
21      ! outputs:      ! outputs:
22      integer, intent(out):: nk(len), icb(len), icbmax      integer, intent(out):: nk1(:), icb1(:) ! (klon)
23      integer, intent(inout):: iflag(len)      integer, intent(out):: icbmax
24      real tnk(len), qnk(len), gznk(len)      integer, intent(inout):: iflag1(klon)
25      real, intent(out):: plcl(len)      real tnk1(klon), qnk1(klon), gznk1(klon)
26        real, intent(out):: plcl1(klon)
27    
28      ! Local:      ! Local:
29      integer i, k      integer i
30      real pnk(len), qsnk(len), rh(len), chi(len)      real pnk(klon), qsnk(klon), rh(klon), chi(klon)
31      real, parameter:: A = 1669., B = 122.      real, parameter:: A = 1669., B = 122.
32    
33      !--------------------------------------------------------------------      !--------------------------------------------------------------------
34    
35      plcl = 0.      plcl1 = 0.
36    
37      ! Origin level of ascending parcels      ! Origin level of ascending parcels
38        nk1 = minorig
     do i = 1, len  
        nk(i) = minorig  
     end do  
39    
40      ! Check whether parcel level temperature and specific humidity      ! Check whether parcel level temperature and specific humidity
41      ! are reasonable      ! are reasonable
42    
43      do i = 1, len      do i = 1, klon
44         if ((t(i, nk(i)) < 250. .or. q(i, nk(i)) <= 0.) .and. iflag(i) == 0) &         if (t1(i, nk1(i)) < 250. .or. q1(i, nk1(i)) <= 0.) iflag1(i) = 7
             iflag(i) = 7  
45      end do      end do
46    
47      ! Calculate lifted condensation level of air at parcel origin level      ! Calculate lifted condensation level of air at parcel origin level
48      ! (within 0.2% of formula of Bolton, Mon. Wea. Rev., 1980)      ! (within 0.2 % of formula of Bolton, Mon. Wea. Rev., 1980)
49    
50      do i = 1, len      do i = 1, klon
51         if (iflag(i) /= 7) then         if (iflag1(i) /= 7) then
52            tnk(i) = t(i, nk(i))            tnk1(i) = t1(i, nk1(i))
53            qnk(i) = q(i, nk(i))            qnk1(i) = q1(i, nk1(i))
54            gznk(i) = gz(i, nk(i))            gznk1(i) = gz1(i, nk1(i))
55            pnk(i) = p(i, nk(i))            pnk(i) = p1(i, nk1(i))
56            qsnk(i) = qs(i, nk(i))            qsnk(i) = qs1(i, nk1(i))
57    
58            rh(i) = qnk(i)/qsnk(i)            rh(i) = qnk1(i) / qsnk(i)
59            chi(i) = tnk(i)/(A-B*rh(i)-tnk(i))            chi(i) = tnk1(i) / (A - B*rh(i) - tnk1(i))
60            plcl(i) = pnk(i)*(rh(i)**chi(i))            plcl1(i) = pnk(i)*(rh(i)**chi(i))
61            if ((plcl(i) < 200. .or. plcl(i) >= 2000.) .and. iflag(i) == 0) &            if ((plcl1(i) < 200. .or. plcl1(i) >= 2000.) .and. iflag1(i) == 0) &
62                 iflag(i) = 8                 iflag1(i) = 8
63         endif         endif
64      end do      end do
65    
66      ! Calculate first level above lcl (= icb)      ! Calculate first level above lcl (= icb1)
   
     do i = 1, len  
        icb(i) = nl - 1  
     end do  
   
     ! La modification consiste \`a comparer plcl \`a ph et non \`a p:  
     ! icb est d\'efini par : ph(icb) < plcl < ph(icb - 1)  
     do k = 3, nl-1 ! modification pour que icb soit supérieur ou égal à 2  
        do i = 1, len  
           if (ph(i, k) < plcl(i)) icb(i) = min(icb(i), k)  
        end do  
     end do  
67    
68      do i = 1, len      do i = 1, klon
69         if ((icb(i) == nl - 1).and.(iflag(i) == 0)) iflag(i) = 9         if (plcl1(i) <= ph1(i, nl - 2)) then
70              ! Distinguish this case just so that icb1 = nl - 2, not nl =
71              ! 3, for plcl1 exactly == ph1(i, nl - 2). Maybe not useful.
72              icb1(i) = nl - 2
73           else
74              icb1(i) = locate(- ph1(i, 3:nl - 2), - plcl1(i), my_lbound = 3)
75              ! {2 <= icb1(i) <= nl - 3}
76              ! {ph1(i, icb1(i) + 1) < plcl1(i) <= ph1(i, icb1(i))}
77           end if
78      end do      end do
79    
80      do i = 1, len      do i = 1, klon
81         icb(i) = icb(i)-1 ! icb >= 2         if ((icb1(i) == nl - 2).and.(iflag1(i) == 0)) iflag1(i) = 9
82      end do      end do
83    
84      ! Compute icbmax      ! Compute icbmax
85    
86      icbmax = 2      icbmax = 2
87    
88      do i = 1, len      do i = 1, klon
89         if (iflag(i) < 7) icbmax = max(icbmax, icb(i))         if (iflag1(i) < 7) icbmax = max(icbmax, icb1(i))
90      end do      end do
91    
92    end SUBROUTINE cv30_feed    end SUBROUTINE cv30_feed
Legend:
Removed from v.186  
changed lines
  Added in v.195
  ViewVC Help
Powered by ViewVC 1.1.21