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, kbas, ktop, upwd, dnwd, dnwd0, ma, cape, iflag, &
       qcondc, wd, pmflxr, pmflxs, 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 clesphys2, only: iflag_con
    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(klon) ! neige (mm/s)
    INTEGER kbas(klon), ktop(klon)

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

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

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

    REAL ma(klon, klev), cape(klon)
    ! Cape----output-R-CAPE (J/kg)

    INTEGER iflag(klon)
    REAL qcondc(klon, klev)
    REAL wd(klon)
    REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
    REAL, intent(inout):: da(klon, klev), phi(klon, klev, klev), mp(klon, klev)

    ! Local:

    REAL em_ph(klon, klev+1), em_p(klon, klev)
    REAL zx_t, zx_qs, zcor
    INTEGER i, k
    REAL qs(klon, klev)
    REAL, save:: cbmf(klon)
    INTEGER:: ifrst = 0

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

    snow = 0

    IF (ifrst==0) THEN
       ifrst = 1
       DO i = 1, klon
          cbmf(i) = 0.
       END DO
    END IF

    DO k = 1, klev + 1
       DO i = 1, klon
          em_ph(i, k) = paprs(i, k)/100.0
          pmflxs(i, k) = 0.
       END DO
    END DO

    DO k = 1, klev
       DO i = 1, klon
          em_p(i, k) = play(i, k)/100.0
       END DO
    END DO


    IF (iflag_con==4) THEN
       DO k = 1, klev
          DO i = 1, klon
             zx_t = t(i, k)
             zx_qs = min(0.5, r2es*foeew(zx_t, rtt >= zx_t)/em_p(i, k)/100.0)
             zcor = 1./(1.-retv*zx_qs)
             qs(i, k) = zx_qs*zcor
          END DO
       END DO
    ELSE
       ! iflag_con=3 (modification de puristes qui fait la
       ! diff\'erence pour la convergence numerique)
       DO k = 1, klev
          DO i = 1, klon
             zx_t = t(i, k)
             zx_qs = r2es*foeew(zx_t, rtt >= zx_t)/em_p(i, k)/100.0
             zx_qs = min(0.5, zx_qs)
             zcor = 1./(1.-retv*zx_qs)
             zx_qs = zx_qs*zcor
             qs(i, k) = zx_qs
          END DO
       END DO
    END IF

    CALL cv_driver(t, q, qs, u, v, em_p, em_ph, iflag, d_t, d_q, d_u, d_v, &
         rain, pmflxr, cbmf, sig1, w01, kbas, ktop, dtime, ma, upwd, dnwd, &
         dnwd0, qcondc, wd, cape, da, phi, mp)

    DO i = 1, klon
       rain(i) = rain(i)/86400.
    END DO

    DO k = 1, klev
       DO i = 1, klon
          d_t(i, k) = dtime*d_t(i, k)
          d_q(i, k) = dtime*d_q(i, k)
          d_u(i, k) = dtime*d_u(i, k)
          d_v(i, k) = dtime*d_v(i, k)
       END DO
    END DO

  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			d_v, rain, snow, kbas, ktop, upwd, dnwd, dnwd0, ma, cape, iflag, &
9			qcondc, wd, pmflxr, pmflxs, da, phi, mp)
10	guez	13
11	guez	47	! 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	69	use clesphys2, only: iflag_con
18	guez	52	use cv_driver_m, only: cv_driver
19	guez	69	USE dimphy, ONLY: klev, klon
20			USE fcttre, ONLY: foeew
21			USE suphec_m, ONLY: retv, rtt
22			USE yoethf_m, ONLY: r2es
23	guez	13
24	guez	69	REAL, INTENT (IN):: dtime ! pas d'integration (s)
25			REAL, INTENT (IN):: paprs(klon, klev+1)
26	guez	72	REAL, INTENT (IN):: play(klon, klev)
27	guez	52	REAL, intent(in):: t(klon, klev)
28	guez	103	real, intent(in):: q(klon, klev) ! vapeur d'eau (en kg/kg)
29	guez	91	real, INTENT (IN):: u(klon, klev), v(klon, klev)
30	guez	72	REAL, intent(inout):: sig1(klon, klev), w01(klon, klev)
31	guez	103	REAL, intent(out):: d_t(klon, klev)
32			REAL, intent(out):: d_q(klon, klev) ! increment de la vapeur d'eau
33			REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
34			REAL, intent(out):: rain(klon) ! pluie (mm/s)
35			REAL, intent(out):: snow(klon) ! neige (mm/s)
36	guez	47	INTEGER kbas(klon), ktop(klon)
37	guez	62
38			REAL, intent(out):: upwd(klon, klev)
39			! saturated updraft mass flux (kg/m**2/s)
40
41			real, intent(out):: dnwd(klon, klev)
42			! saturated downdraft mass flux (kg/m**2/s)
43
44			real, intent(out):: dnwd0(klon, klev)
45			! unsaturated downdraft mass flux (kg/m**2/s)
46
47	guez	97	REAL ma(klon, klev), cape(klon)
48	guez	62	! Cape----output-R-CAPE (J/kg)
49	guez	97
50	guez	47	INTEGER iflag(klon)
51			REAL qcondc(klon, klev)
52			REAL wd(klon)
53	guez	97	REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
54	guez	99	REAL, intent(inout):: da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
55	guez	13
56	guez	97	! Local:
57
58			REAL em_ph(klon, klev+1), em_p(klon, klev)
59	guez	103	REAL zx_t, zx_qs, zcor
60	guez	97	INTEGER i, k
61	guez	47	REAL qs(klon, klev)
62	guez	62	REAL, save:: cbmf(klon)
63			INTEGER:: ifrst = 0
64	guez	13
65	guez	47	!-----------------------------------------------------------------
66	guez	13
67	guez	62	snow = 0
68	guez	13
69	guez	47	IF (ifrst==0) THEN
70			ifrst = 1
71			DO i = 1, klon
72			cbmf(i) = 0.
73			END DO
74			END IF
75	guez	13
76	guez	47	DO k = 1, klev + 1
77			DO i = 1, klon
78			em_ph(i, k) = paprs(i, k)/100.0
79			pmflxs(i, k) = 0.
80			END DO
81			END DO
82	guez	13
83	guez	47	DO k = 1, klev
84			DO i = 1, klon
85	guez	72	em_p(i, k) = play(i, k)/100.0
86	guez	47	END DO
87			END DO
88	guez	3
89
90	guez	47	IF (iflag_con==4) THEN
91			DO k = 1, klev
92			DO i = 1, klon
93			zx_t = t(i, k)
94	guez	103	zx_qs = min(0.5, r2es*foeew(zx_t, rtt >= zx_t)/em_p(i, k)/100.0)
95	guez	47	zcor = 1./(1.-retv*zx_qs)
96			qs(i, k) = zx_qs*zcor
97			END DO
98			END DO
99			ELSE
100	guez	177	! iflag_con=3 (modification de puristes qui fait la
101			! diff\'erence pour la convergence numerique)
102	guez	47	DO k = 1, klev
103			DO i = 1, klon
104			zx_t = t(i, k)
105	guez	103	zx_qs = r2es*foeew(zx_t, rtt >= zx_t)/em_p(i, k)/100.0
106	guez	47	zx_qs = min(0.5, zx_qs)
107			zcor = 1./(1.-retv*zx_qs)
108			zx_qs = zx_qs*zcor
109			qs(i, k) = zx_qs
110			END DO
111			END DO
112			END IF
113	guez	3
114	guez	177	CALL cv_driver(t, q, qs, u, v, em_p, em_ph, iflag, d_t, d_q, d_u, d_v, &
115			rain, pmflxr, cbmf, sig1, w01, kbas, ktop, dtime, ma, upwd, dnwd, &
116			dnwd0, qcondc, wd, cape, da, phi, mp)
117	guez	3
118	guez	47	DO i = 1, klon
119			rain(i) = rain(i)/86400.
120			END DO
121
122			DO k = 1, klev
123			DO i = 1, klon
124			d_t(i, k) = dtime*d_t(i, k)
125			d_q(i, k) = dtime*d_q(i, k)
126			d_u(i, k) = dtime*d_u(i, k)
127			d_v(i, k) = dtime*d_v(i, k)
128			END DO
129			END DO
130
131			END SUBROUTINE concvl
132
133			end module concvl_m