phylmd/CV30_routines/cv30_feed.f

module cv3_feed_m

  implicit none

contains

  SUBROUTINE cv3_feed(len, nd, t, q, qs, p, ph, hm, gz, nk, icb, icbmax, &
       iflag, tnk, qnk, gznk, plcl)

    ! Purpose: CONVECTIVE FEED

    ! Main differences with cv_feed:
    ! - ph added in input
    ! - here, nk(i)=minorig
    ! - icb defined differently (plcl compared with ph instead of p)

    ! Main differences with convect3:
    ! - we do not compute dplcldt and dplcldr of CLIFT anymore
    ! - values iflag different (but tests identical)
    ! - A, B explicitely defined (!)

    use cv3_param_m

    ! inputs:
    integer, intent(in):: len, nd
    real, intent(in):: t(len, nd)
    real, intent(in):: q(len, nd), qs(len, nd), p(len, nd)
    real hm(len, nd), gz(len, nd)
    real, intent(in):: ph(len, nd+1)

    ! outputs:
    integer iflag(len)
    integer, intent(out):: nk(len), icb(len), icbmax
    real tnk(len), qnk(len), gznk(len), plcl(len)

    ! local variables:
    integer i, k
    integer ihmin(len)
    real work(len)
    real pnk(len), qsnk(len), rh(len), chi(len)
    real A, B ! convect3

    !--------------------------------------------------------------------

    plcl=0.0

    ! --- Origin level of ascending parcels for convect3:

    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

    ! --- Calculate lifted condensation level of air at parcel origin level
    ! --- (Within 0.2% of formula of Bolton, MON. WEA. REV., 1980)

    A = 1669.0 ! convect3
    B = 122.0 ! convect3

    do i=1, len
       if (iflag(i).ne.7) then
          tnk(i)=t(i, nk(i))
          qnk(i)=q(i, nk(i))
          gznk(i)=gz(i, nk(i))
          pnk(i)=p(i, nk(i))
          qsnk(i)=qs(i, nk(i))

          rh(i)=qnk(i)/qsnk(i)
          chi(i)=tnk(i)/(A-B*rh(i)-tnk(i)) ! convect3
          plcl(i)=pnk(i)*(rh(i)**chi(i))
          if ((plcl(i) < 200. .or. plcl(i) >= 2000.) .and. iflag(i) == 0) &
               iflag(i) = 8
       endif
    end do

    ! --- Calculate first level above lcl (=icb)

    do i=1, len
       icb(i)=nlm
    end do

    ! la modification consiste a comparer plcl a ph et non a p:
    ! icb est defini 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

    do i=1, len
       if((icb(i) == nlm).and.(iflag(i) == 0))iflag(i)=9
    end do

    do i=1, len
       icb(i) = icb(i)-1 ! icb sup ou egal a 2
    end do

    ! Compute icbmax.

    icbmax=2
    do i=1, len
       if (iflag(i) < 7) icbmax=max(icbmax, icb(i)) ! sb Jun7th02
    end do

  end SUBROUTINE cv3_feed

end module cv3_feed_m
1	guez	103	module cv3_feed_m
2	guez	47
3	guez	103	implicit none
4	guez	47
5	guez	103	contains
6	guez	47
7	guez	103	SUBROUTINE cv3_feed(len, nd, t, q, qs, p, ph, hm, gz, nk, icb, icbmax, &
8			iflag, tnk, qnk, gznk, plcl)
9	guez	47
10	guez	103	! Purpose: CONVECTIVE FEED
11	guez	47
12	guez	103	! Main differences with cv_feed:
13			! - ph added in input
14			! - here, nk(i)=minorig
15			! - icb defined differently (plcl compared with ph instead of p)
16	guez	47
17	guez	103	! Main differences with convect3:
18			! - we do not compute dplcldt and dplcldr of CLIFT anymore
19			! - values iflag different (but tests identical)
20			! - A, B explicitely defined (!)
21	guez	47
22	guez	103	use cv3_param_m
23	guez	47
24	guez	103	! inputs:
25			integer, intent(in):: len, nd
26			real, intent(in):: t(len, nd)
27			real, intent(in):: q(len, nd), qs(len, nd), p(len, nd)
28			real hm(len, nd), gz(len, nd)
29			real, intent(in):: ph(len, nd+1)
30	guez	47
31	guez	103	! outputs:
32			integer iflag(len)
33			integer, intent(out):: nk(len), icb(len), icbmax
34			real tnk(len), qnk(len), gznk(len), plcl(len)
35	guez	47
36	guez	103	! local variables:
37			integer i, k
38			integer ihmin(len)
39			real work(len)
40			real pnk(len), qsnk(len), rh(len), chi(len)
41			real A, B ! convect3
42	guez	47
43	guez	103	!--------------------------------------------------------------------
44	guez	47
45	guez	103	plcl=0.0
46	guez	47
47	guez	103	! --- Origin level of ascending parcels for convect3:
48	guez	47
49	guez	103	do i=1, len
50			nk(i)=minorig
51			end do
52	guez	47
53	guez	103	! --- Check whether parcel level temperature and specific humidity
54			! --- are reasonable
55	guez	47
56	guez	103	do i=1, len
57			if ((t(i, nk(i)) < 250. .or. q(i, nk(i)) <= 0.) .and. iflag(i) == 0) &
58			iflag(i)=7
59			end do
60	guez	47
61	guez	103	! --- Calculate lifted condensation level of air at parcel origin level
62			! --- (Within 0.2% of formula of Bolton, MON. WEA. REV., 1980)
63	guez	47
64	guez	103	A = 1669.0 ! convect3
65			B = 122.0 ! convect3
66
67			do i=1, len
68			if (iflag(i).ne.7) then
69			tnk(i)=t(i, nk(i))
70			qnk(i)=q(i, nk(i))
71			gznk(i)=gz(i, nk(i))
72			pnk(i)=p(i, nk(i))
73			qsnk(i)=qs(i, nk(i))
74
75			rh(i)=qnk(i)/qsnk(i)
76			chi(i)=tnk(i)/(A-B*rh(i)-tnk(i)) ! convect3
77			plcl(i)=pnk(i)(rh(i)*chi(i))
78			if ((plcl(i) < 200. .or. plcl(i) >= 2000.) .and. iflag(i) == 0) &
79			iflag(i) = 8
80			endif
81			end do
82
83			! --- Calculate first level above lcl (=icb)
84
85			do i=1, len
86	guez	47	icb(i)=nlm
87	guez	103	end do
88	guez	47
89	guez	103	! la modification consiste a comparer plcl a ph et non a p:
90			! icb est defini par : ph(icb) < plcl < ph(icb - 1)
91			do k=3, nl-1 ! modification pour que icb soit supérieur ou égal à 2
92			do i=1, len
93			if(ph(i, k) < plcl(i)) icb(i) = min(icb(i), k)
94			end do
95			end do
96	guez	47
97	guez	103	do i=1, len
98			if((icb(i) == nlm).and.(iflag(i) == 0))iflag(i)=9
99			end do
100
101			do i=1, len
102			icb(i) = icb(i)-1 ! icb sup ou egal a 2
103			end do
104
105			! Compute icbmax.
106
107			icbmax=2
108			do i=1, len
109			if (iflag(i) < 7) icbmax=max(icbmax, icb(i)) ! sb Jun7th02
110			end do
111
112			end SUBROUTINE cv3_feed
113
114			end module cv3_feed_m