phylmd/CV3_routines/cv3_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	module cv3_feed_m
2
3	implicit none
4
5	contains
6
7	SUBROUTINE cv3_feed(len, nd, t, q, qs, p, ph, gz, nk, icb, icbmax, iflag, &
8	tnk, qnk, gznk, plcl)
9
10	! Purpose: CONVECTIVE FEED
11
12	! 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
17	! 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
22	use cv3_param_m
23
24	! 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 gz(len, nd)
29	real, intent(in):: ph(len, nd+1)
30
31	! 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
36	! local variables:
37	integer i, k
38	real pnk(len), qsnk(len), rh(len), chi(len)
39	real A, B ! convect3
40
41	!--------------------------------------------------------------------
42
43	plcl=0.0
44
45	! --- Origin level of ascending parcels for convect3:
46
47	do i=1, len
48	nk(i)=minorig
49	end do
50
51	! --- Check whether parcel level temperature and specific humidity
52	! --- are reasonable
53
54	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
59	! --- Calculate lifted condensation level of air at parcel origin level
60	! --- (Within 0.2% of formula of Bolton, MON. WEA. REV., 1980)
61
62	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	icb(i)=nlm
85	end do
86
87	! 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
95	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