phylmd/CV30_routines/cv30_feed.f

module cv30_feed_m

  implicit none

contains

  SUBROUTINE cv30_feed(t1, q1, qs1, p1, ph1, gz1, nk1, icb1, icbmax, iflag1, &
       tnk1, qnk1, gznk1, plcl1)

    ! Purpose: convective feed

    use cv30_param_m, only: minorig, nl
    USE dimphy, ONLY: klev, klon
    use numer_rec_95, only: locate

    real, intent(in):: t1(:, :) ! (klon, klev)
    real, intent(in):: q1(:, :), qs1(:, :), p1(:, :) ! (klon, klev)
    real, intent(in):: ph1(:, :) ! (klon, klev+1)
    real, intent(in):: gz1(:, :) ! (klon, klev)

    ! outputs:
    integer, intent(out):: nk1(:), icb1(:) ! (klon)
    integer, intent(out):: icbmax
    integer, intent(inout):: iflag1(klon)
    real tnk1(klon), qnk1(klon), gznk1(klon)
    real, intent(out):: plcl1(klon)

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

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

    plcl1 = 0.

    ! Origin level of ascending parcels
    nk1 = minorig

    ! Check whether parcel level temperature and specific humidity
    ! are reasonable

    do i = 1, klon
       if (t1(i, nk1(i)) < 250. .or. q1(i, nk1(i)) <= 0.) iflag1(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, klon
       if (iflag1(i) /= 7) then
          tnk1(i) = t1(i, nk1(i))
          qnk1(i) = q1(i, nk1(i))
          gznk1(i) = gz1(i, nk1(i))
          pnk(i) = p1(i, nk1(i))
          qsnk(i) = qs1(i, nk1(i))

          rh(i) = qnk1(i) / qsnk(i)
          chi(i) = tnk1(i) / (A - B*rh(i) - tnk1(i))
          plcl1(i) = pnk(i)*(rh(i)**chi(i))
          if ((plcl1(i) < 200. .or. plcl1(i) >= 2000.) .and. iflag1(i) == 0) &
               iflag1(i) = 8
       endif
    end do

    ! Calculate first level above lcl (= icb1)

    do i = 1, klon
       if (plcl1(i) <= ph1(i, nl - 2)) then
          ! Distinguish this case just so that icb1 = nl - 2, not nl =
          ! 3, for plcl1 exactly == ph1(i, nl - 2). Maybe not useful.
          icb1(i) = nl - 2
       else
          icb1(i) = locate(- ph1(i, 3:nl - 2), - plcl1(i), my_lbound = 3)
          ! {2 <= icb1(i) <= nl - 3}
          ! {ph1(i, icb1(i) + 1) < plcl1(i) <= ph1(i, icb1(i))}
       end if
    end do

    do i = 1, klon
       if ((icb1(i) == nl - 2).and.(iflag1(i) == 0)) iflag1(i) = 9
    end do

    ! Compute icbmax

    icbmax = 2

    do i = 1, klon
       if (iflag1(i) < 7) icbmax = max(icbmax, icb1(i))
    end do

  end SUBROUTINE cv30_feed

end module cv30_feed_m
1	guez	185	module cv30_feed_m
2	guez	47
3	guez	103	implicit none
4	guez	47
5	guez	103	contains
6	guez	47
7	guez	195	SUBROUTINE cv30_feed(t1, q1, qs1, p1, ph1, gz1, nk1, icb1, icbmax, iflag1, &
8			tnk1, qnk1, gznk1, plcl1)
9	guez	47
10	guez	180	! Purpose: convective feed
11	guez	47
12	guez	186	use cv30_param_m, only: minorig, nl
13	guez	195	USE dimphy, ONLY: klev, klon
14			use numer_rec_95, only: locate
15	guez	47
16	guez	195	real, intent(in):: t1(:, :) ! (klon, klev)
17			real, intent(in):: q1(:, :), qs1(:, :), p1(:, :) ! (klon, klev)
18			real, intent(in):: ph1(:, :) ! (klon, klev+1)
19			real, intent(in):: gz1(:, :) ! (klon, klev)
20	guez	47
21	guez	103	! outputs:
22	guez	195	integer, intent(out):: nk1(:), icb1(:) ! (klon)
23			integer, intent(out):: icbmax
24			integer, intent(inout):: iflag1(klon)
25			real tnk1(klon), qnk1(klon), gznk1(klon)
26			real, intent(out):: plcl1(klon)
27	guez	47
28	guez	180	! Local:
29	guez	195	integer i
30			real pnk(klon), qsnk(klon), rh(klon), chi(klon)
31	guez	180	real, parameter:: A = 1669., B = 122.
32	guez	47
33	guez	103	!--------------------------------------------------------------------
34	guez	47
35	guez	195	plcl1 = 0.
36	guez	47
37	guez	180	! Origin level of ascending parcels
38	guez	195	nk1 = minorig
39	guez	47
40	guez	180	! Check whether parcel level temperature and specific humidity
41			! are reasonable
42	guez	47
43	guez	195	do i = 1, klon
44			if (t1(i, nk1(i)) < 250. .or. q1(i, nk1(i)) <= 0.) iflag1(i) = 7
45	guez	103	end do
46	guez	47
47	guez	180	! Calculate lifted condensation level of air at parcel origin level
48	guez	195	! (within 0.2 % of formula of Bolton, Mon. Wea. Rev., 1980)
49	guez	47
50	guez	195	do i = 1, klon
51			if (iflag1(i) /= 7) then
52			tnk1(i) = t1(i, nk1(i))
53			qnk1(i) = q1(i, nk1(i))
54			gznk1(i) = gz1(i, nk1(i))
55			pnk(i) = p1(i, nk1(i))
56			qsnk(i) = qs1(i, nk1(i))
57	guez	103
58	guez	195	rh(i) = qnk1(i) / qsnk(i)
59			chi(i) = tnk1(i) / (A - B*rh(i) - tnk1(i))
60			plcl1(i) = pnk(i)(rh(i)*chi(i))
61			if ((plcl1(i) < 200. .or. plcl1(i) >= 2000.) .and. iflag1(i) == 0) &
62			iflag1(i) = 8
63	guez	103	endif
64			end do
65
66	guez	195	! Calculate first level above lcl (= icb1)
67	guez	103
68	guez	195	do i = 1, klon
69			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	guez	103	end do
79	guez	47
80	guez	195	do i = 1, klon
81			if ((icb1(i) == nl - 2).and.(iflag1(i) == 0)) iflag1(i) = 9
82	guez	103	end do
83	guez	47
84	guez	180	! Compute icbmax
85	guez	103
86	guez	180	icbmax = 2
87
88	guez	195	do i = 1, klon
89			if (iflag1(i) < 7) icbmax = max(icbmax, icb1(i))
90	guez	103	end do
91
92	guez	185	end SUBROUTINE cv30_feed
93	guez	103
94	guez	185	end module cv30_feed_m