trunk/phylmd/concvl.f

module concvl_m

  IMPLICIT NONE

contains

  SUBROUTINE concvl(dtime, paprs, play, t, q, u, v, sig1, w01, d_t, d_q, d_u, &
       d_v, rain, snow_con, kbas, itop_con, upwd, dnwd, dnwd0, ma, cape, &
       iflag, qcondc, wd, pmflxr, da, phi, mp)

    ! From phylmd/concvl.F, version 1.3, 2005/04/15 12:36:17
    ! Author: Z. X. Li (LMD/CNRS)
    ! Date: 1993 August 18
    ! Objet : schéma de convection d'Emanuel (1991), interface
    ! (driver commun aux versions 3 et 4)

    use cv_driver_m, only: cv_driver
    USE dimphy, ONLY: klev, klon
    USE fcttre, ONLY: foeew
    USE suphec_m, ONLY: retv, rtt
    USE yoethf_m, ONLY: r2es

    REAL, INTENT (IN):: dtime ! pas d'integration (s)
    REAL, INTENT (IN):: paprs(klon, klev + 1)
    REAL, INTENT (IN):: play(klon, klev)
    REAL, intent(in):: t(klon, klev)
    real, intent(in):: q(klon, klev) ! vapeur d'eau (en kg / kg)
    real, INTENT (IN):: u(klon, klev), v(klon, klev)
    REAL, intent(inout):: sig1(klon, klev), w01(klon, klev)
    REAL, intent(out):: d_t(klon, klev)
    REAL, intent(out):: d_q(klon, klev) ! increment de la vapeur d'eau
    REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
    REAL, intent(out):: rain(klon) ! pluie (mm / s)
    REAL, intent(out):: snow_con(klon) ! neige (mm / s)
    INTEGER, intent(out):: kbas(klon)
    integer itop_con(klon)

    REAL, intent(out):: upwd(klon, klev)
    ! saturated updraft mass flux (kg / m2 / s)

    real, intent(out):: dnwd(klon, klev)
    ! saturated downdraft mass flux (kg / m2 / s)

    real, intent(out):: dnwd0(klon, klev)
    ! unsaturated downdraft mass flux (kg / m2 / s)

    REAL ma(klon, klev)
    real cape(klon) ! output (J / kg)
    INTEGER iflag(klon)
    REAL qcondc(klon, klev)
    REAL wd(klon)
    REAL pmflxr(klon, klev + 1)
    REAL, intent(inout):: da(klon, klev), phi(klon, klev, klev), mp(klon, klev)

    ! Local:
    REAL zx_qs, cor
    INTEGER i, k
    REAL qs(klon, klev)
    REAL, save:: cbmf(klon)
    INTEGER:: ifrst = 0

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

    snow_con = 0.

    IF (ifrst == 0) THEN
       ifrst = 1
       cbmf = 0.
    END IF

    DO k = 1, klev
       DO i = 1, klon
          zx_qs = min(0.5, r2es * foeew(t(i, k), rtt >= t(i, k)) / play(i, k))
          cor = 1. / (1. - retv * zx_qs)
          qs(i, k) = zx_qs * cor
       END DO
    END DO

    CALL cv_driver(t, q, qs, u, v, play / 100., paprs / 100., iflag, d_t, &
         d_q, d_u, d_v, rain, pmflxr, cbmf, sig1, w01, kbas, itop_con, dtime, &
         ma, upwd, dnwd, dnwd0, qcondc, wd, cape, da, phi, mp)

    rain = rain / 86400.
    d_t = dtime * d_t
    d_q = dtime * d_q
    d_u = dtime * d_u
    d_v = dtime * d_v

  END SUBROUTINE concvl

end module concvl_m
1	guez	47	module concvl_m
2	guez	3
3	guez	47	IMPLICIT NONE
4	guez	3
5	guez	47	contains
6	guez	13
7	guez	97	SUBROUTINE concvl(dtime, paprs, play, t, q, u, v, sig1, w01, d_t, d_q, d_u, &
8	guez	180	d_v, rain, snow_con, kbas, itop_con, upwd, dnwd, dnwd0, ma, cape, &
9			iflag, qcondc, wd, pmflxr, da, phi, mp)
10	guez	13
11	guez	180	! From phylmd/concvl.F, version 1.3, 2005/04/15 12:36:17
12	guez	62	! Author: Z. X. Li (LMD/CNRS)
13	guez	103	! Date: 1993 August 18
14	guez	62	! Objet : schéma de convection d'Emanuel (1991), interface
15	guez	69	! (driver commun aux versions 3 et 4)
16	guez	13
17	guez	52	use cv_driver_m, only: cv_driver
18	guez	69	USE dimphy, ONLY: klev, klon
19			USE fcttre, ONLY: foeew
20			USE suphec_m, ONLY: retv, rtt
21			USE yoethf_m, ONLY: r2es
22	guez	13
23	guez	69	REAL, INTENT (IN):: dtime ! pas d'integration (s)
24	guez	180	REAL, INTENT (IN):: paprs(klon, klev + 1)
25	guez	72	REAL, INTENT (IN):: play(klon, klev)
26	guez	52	REAL, intent(in):: t(klon, klev)
27	guez	180	real, intent(in):: q(klon, klev) ! vapeur d'eau (en kg / kg)
28	guez	91	real, INTENT (IN):: u(klon, klev), v(klon, klev)
29	guez	72	REAL, intent(inout):: sig1(klon, klev), w01(klon, klev)
30	guez	103	REAL, intent(out):: d_t(klon, klev)
31			REAL, intent(out):: d_q(klon, klev) ! increment de la vapeur d'eau
32			REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
33	guez	180	REAL, intent(out):: rain(klon) ! pluie (mm / s)
34			REAL, intent(out):: snow_con(klon) ! neige (mm / s)
35			INTEGER, intent(out):: kbas(klon)
36			integer itop_con(klon)
37	guez	62
38			REAL, intent(out):: upwd(klon, klev)
39	guez	180	! saturated updraft mass flux (kg / m2 / s)
40	guez	62
41			real, intent(out):: dnwd(klon, klev)
42	guez	180	! saturated downdraft mass flux (kg / m2 / s)
43	guez	62
44			real, intent(out):: dnwd0(klon, klev)
45	guez	180	! unsaturated downdraft mass flux (kg / m2 / s)
46	guez	62
47	guez	180	REAL ma(klon, klev)
48			real cape(klon) ! output (J / kg)
49	guez	47	INTEGER iflag(klon)
50			REAL qcondc(klon, klev)
51			REAL wd(klon)
52	guez	180	REAL pmflxr(klon, klev + 1)
53	guez	99	REAL, intent(inout):: da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
54	guez	13
55	guez	97	! Local:
56	guez	180	REAL zx_qs, cor
57	guez	97	INTEGER i, k
58	guez	47	REAL qs(klon, klev)
59	guez	62	REAL, save:: cbmf(klon)
60			INTEGER:: ifrst = 0
61	guez	13
62	guez	47	!-----------------------------------------------------------------
63	guez	13
64	guez	180	snow_con = 0.
65	guez	13
66	guez	180	IF (ifrst == 0) THEN
67	guez	47	ifrst = 1
68	guez	180	cbmf = 0.
69	guez	47	END IF
70	guez	13
71	guez	47	DO k = 1, klev
72			DO i = 1, klon
73	guez	180	zx_qs = min(0.5, r2es * foeew(t(i, k), rtt >= t(i, k)) / play(i, k))
74			cor = 1. / (1. - retv * zx_qs)
75			qs(i, k) = zx_qs * cor
76	guez	47	END DO
77			END DO
78	guez	3
79	guez	180	CALL cv_driver(t, q, qs, u, v, play / 100., paprs / 100., iflag, d_t, &
80			d_q, d_u, d_v, rain, pmflxr, cbmf, sig1, w01, kbas, itop_con, dtime, &
81			ma, upwd, dnwd, dnwd0, qcondc, wd, cape, da, phi, mp)
82	guez	3
83	guez	180	rain = rain / 86400.
84			d_t = dtime * d_t
85			d_q = dtime * d_q
86			d_u = dtime * d_u
87			d_v = dtime * d_v
88	guez	3
89	guez	47	END SUBROUTINE concvl
90
91			end module concvl_m