phylmd/CV30_routines/cv30_feed.f

module cv3_feed_m

  implicit none

contains

  SUBROUTINE cv3_feed(len, nd, t, q, qs, p, ph, 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 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
    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	145	SUBROUTINE cv3_feed(len, nd, t, q, qs, p, ph, gz, nk, icb, icbmax, iflag, &
8			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	guez	145	real gz(len, nd)
29	guez	103	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			real pnk(len), qsnk(len), rh(len), chi(len)
39			real A, B ! convect3
40	guez	47
41	guez	103	!--------------------------------------------------------------------
42	guez	47
43	guez	103	plcl=0.0
44	guez	47
45	guez	103	! --- Origin level of ascending parcels for convect3:
46	guez	47
47	guez	103	do i=1, len
48			nk(i)=minorig
49			end do
50	guez	47
51	guez	103	! --- Check whether parcel level temperature and specific humidity
52			! --- are reasonable
53	guez	47
54	guez	103	do i=1, len
55			if ((t(i, nk(i)) < 250. .or. q(i, nk(i)) <= 0.) .and. iflag(i) == 0) &
56			iflag(i)=7
57			end do
58	guez	47
59	guez	103	! --- Calculate lifted condensation level of air at parcel origin level
60			! --- (Within 0.2% of formula of Bolton, MON. WEA. REV., 1980)
61	guez	47
62	guez	103	A = 1669.0 ! convect3
63			B = 122.0 ! convect3
64
65			do i=1, len
66			if (iflag(i).ne.7) then
67			tnk(i)=t(i, nk(i))
68			qnk(i)=q(i, nk(i))
69			gznk(i)=gz(i, nk(i))
70			pnk(i)=p(i, nk(i))
71			qsnk(i)=qs(i, nk(i))
72
73			rh(i)=qnk(i)/qsnk(i)
74			chi(i)=tnk(i)/(A-B*rh(i)-tnk(i)) ! convect3
75			plcl(i)=pnk(i)(rh(i)*chi(i))
76			if ((plcl(i) < 200. .or. plcl(i) >= 2000.) .and. iflag(i) == 0) &
77			iflag(i) = 8
78			endif
79			end do
80
81			! --- Calculate first level above lcl (=icb)
82
83			do i=1, len
84	guez	47	icb(i)=nlm
85	guez	103	end do
86	guez	47
87	guez	103	! la modification consiste a comparer plcl a ph et non a p:
88			! icb est defini par : ph(icb) < plcl < ph(icb - 1)
89			do k=3, nl-1 ! modification pour que icb soit supérieur ou égal à 2
90			do i=1, len
91			if(ph(i, k) < plcl(i)) icb(i) = min(icb(i), k)
92			end do
93			end do
94	guez	47
95	guez	103	do i=1, len
96			if((icb(i) == nlm).and.(iflag(i) == 0))iflag(i)=9
97			end do
98
99			do i=1, len
100			icb(i) = icb(i)-1 ! icb sup ou egal a 2
101			end do
102
103			! Compute icbmax.
104
105			icbmax=2
106			do i=1, len
107			if (iflag(i) < 7) icbmax=max(icbmax, icb(i)) ! sb Jun7th02
108			end do
109
110			end SUBROUTINE cv3_feed
111
112			end module cv3_feed_m