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