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

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