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)

    use cv3_param_m, only: minorig, nl, nlm

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

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

    ! Local:
    integer i, k
    real pnk(len), qsnk(len), rh(len), chi(len)
    real, parameter:: A = 1669., B = 122.

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

    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

    ! Calculate lifted condensation level of air at parcel origin level
    ! (within 0.2% of formula of Bolton, Mon. Wea. Rev., 1980)

    do i = 1, len
       if (iflag(i) /= 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))
          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 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

    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 >= 2
    end do

    ! Compute icbmax

    icbmax = 2

    do i = 1, len
       if (iflag(i) < 7) icbmax = max(icbmax, icb(i))
    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	180	! Purpose: convective feed
11	guez	47
12	guez	103	! Main differences with cv_feed:
13			! - ph added in input
14	guez	180	! - here, nk(i) = minorig
15	guez	103	! - icb defined differently (plcl compared with ph instead of p)
16	guez	47
17	guez	180	use cv3_param_m, only: minorig, nl, nlm
18	guez	47
19	guez	103	integer, intent(in):: len, nd
20			real, intent(in):: t(len, nd)
21			real, intent(in):: q(len, nd), qs(len, nd), p(len, nd)
22			real, intent(in):: ph(len, nd+1)
23	guez	180	real, intent(in):: gz(len, nd)
24	guez	47
25	guez	103	! outputs:
26			integer, intent(out):: nk(len), icb(len), icbmax
27	guez	180	integer, intent(inout):: iflag(len)
28			real tnk(len), qnk(len), gznk(len)
29			real, intent(out):: plcl(len)
30	guez	47
31	guez	180	! Local:
32	guez	103	integer i, k
33			real pnk(len), qsnk(len), rh(len), chi(len)
34	guez	180	real, parameter:: A = 1669., B = 122.
35	guez	47
36	guez	103	!--------------------------------------------------------------------
37	guez	47
38	guez	180	plcl = 0.
39	guez	47
40	guez	180	! Origin level of ascending parcels
41	guez	47
42	guez	180	do i = 1, len
43			nk(i) = minorig
44	guez	103	end do
45	guez	47
46	guez	180	! Check whether parcel level temperature and specific humidity
47			! are reasonable
48	guez	47
49	guez	180	do i = 1, len
50	guez	103	if ((t(i, nk(i)) < 250. .or. q(i, nk(i)) <= 0.) .and. iflag(i) == 0) &
51	guez	180	iflag(i) = 7
52	guez	103	end do
53	guez	47
54	guez	180	! Calculate lifted condensation level of air at parcel origin level
55			! (within 0.2% of formula of Bolton, Mon. Wea. Rev., 1980)
56	guez	47
57	guez	180	do i = 1, len
58			if (iflag(i) /= 7) then
59			tnk(i) = t(i, nk(i))
60			qnk(i) = q(i, nk(i))
61			gznk(i) = gz(i, nk(i))
62			pnk(i) = p(i, nk(i))
63			qsnk(i) = qs(i, nk(i))
64	guez	103
65	guez	180	rh(i) = qnk(i)/qsnk(i)
66			chi(i) = tnk(i)/(A-B*rh(i)-tnk(i))
67			plcl(i) = pnk(i)(rh(i)*chi(i))
68	guez	103	if ((plcl(i) < 200. .or. plcl(i) >= 2000.) .and. iflag(i) == 0) &
69			iflag(i) = 8
70			endif
71			end do
72
73	guez	180	! Calculate first level above lcl (= icb)
74	guez	103
75	guez	180	do i = 1, len
76			icb(i) = nlm
77	guez	103	end do
78	guez	47
79	guez	180	! La modification consiste \`a comparer plcl \`a ph et non \`a p:
80			! icb est d\'efini par : ph(icb) < plcl < ph(icb - 1)
81			do k = 3, nl-1 ! modification pour que icb soit supérieur ou égal à 2
82			do i = 1, len
83			if (ph(i, k) < plcl(i)) icb(i) = min(icb(i), k)
84	guez	103	end do
85			end do
86	guez	47
87	guez	180	do i = 1, len
88			if ((icb(i) == nlm).and.(iflag(i) == 0)) iflag(i) = 9
89	guez	103	end do
90
91	guez	180	do i = 1, len
92			icb(i) = icb(i)-1 ! icb >= 2
93	guez	103	end do
94
95	guez	180	! Compute icbmax
96	guez	103
97	guez	180	icbmax = 2
98
99			do i = 1, len
100			if (iflag(i) < 7) icbmax = max(icbmax, icb(i))
101	guez	103	end do
102
103			end SUBROUTINE cv3_feed
104
105			end module cv3_feed_m