libf/phylmd/concvl.f90

SUBROUTINE concvl(iflag_con, dtime, paprs, pplay, t, q, u, v, tra,&
     ntra, work1, work2, d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas,&
     ktop, upwd, dnwd, dnwdbis, ma, cape, tvp, iflag, pbase, bbase,&
     dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs,&
     da, phi, mp)

  ! From phylmd/concvl.F, v 1.3 2005/04/15 12:36:17
  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
  ! Objet: schema de convection de Emanuel (1991) interface

  USE dimens_m
  USE dimphy
  USE yomcst
  USE yoethf
  USE fcttre

  IMPLICIT NONE

  ! Arguments:
  ! dtime--input-R-pas d'integration (s)
  ! s-------input-R-la valeur "s" pour chaque couche
  ! sigs----input-R-la valeur "sigma" de chaque couche
  ! sig-----input-R-la valeur de "sigma" pour chaque niveau
  ! psolpa--input-R-la pression au sol (en Pa)
  ! pskapa--input-R-exponentiel kappa de psolpa
  ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
  ! q-------input-R-vapeur d'eau (en kg/kg)

  ! work*: input et output: deux variables de travail,
  !                            on peut les mettre a 0 au debut
  ! ALE-----input-R-energie disponible pour soulevement

  ! d_h-----output-R-increment de l'enthalpie potentielle (h)
  ! d_q-----output-R-increment de la vapeur d'eau
  ! rain----output-R-la pluie (mm/s)
  ! snow----output-R-la neige (mm/s)
  ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)
  ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
  ! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
  ! Cape----output-R-CAPE (J/kg)
  ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
  !                  adiabatiquement a partir du niveau 1 (K)
  ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ;
  !  Pa)
  ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de
  !  la glace

  INTEGER ntrac
  PARAMETER (ntrac=nqmx-2)

  INTEGER, INTENT (IN) :: iflag_con

  REAL, INTENT (IN) :: dtime
  REAL, INTENT (IN) :: paprs(klon, klev+1)
  REAL, INTENT (IN) :: pplay(klon, klev)
  REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev)
  REAL, INTENT (IN):: tra(klon, klev, ntrac)
  INTEGER ntra
  REAL work1(klon, klev), work2(klon, klev)
  REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)

  REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon,&
       klev)
  REAL d_tra(klon, klev, ntrac)
  REAL rain(klon), snow(klon)

  INTEGER kbas(klon), ktop(klon)
  REAL em_ph(klon, klev+1), em_p(klon, klev)
  REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
  REAL ma(klon, klev), cape(klon), tvp(klon, klev)
  REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
  INTEGER iflag(klon)
  REAL pbase(klon), bbase(klon)
  REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
  REAL dplcldt(klon), dplcldr(klon)
  REAL qcondc(klon, klev)
  REAL wd(klon)

  REAL zx_t, zdelta, zx_qs, zcor

  INTEGER i, k, itra
  REAL qs(klon, klev)
  REAL cbmf(klon)
  SAVE cbmf
  INTEGER ifrst
  SAVE ifrst
  DATA 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) = pplay(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)
           zdelta = max(0., sign(1., rtt-zx_t))
           zx_qs = min(0.5, r2es*foeew(zx_t, zdelta)/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)
           zdelta = max(0., sign(1., rtt-zx_t))
           zx_qs = r2es*foeew(zx_t, zdelta)/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

  ! Main driver for convection:
  !             iflag_con = 3  -> equivalent to convect3
  !             iflag_con = 4  -> equivalent to convect1/2

  CALL cv_driver(klon, klev, klev+1, ntra, iflag_con, t, q, qs, u, v,&
       tra, em_p, em_ph, iflag, d_t, d_q, d_u, d_v, d_tra, rain,&
       pmflxr, cbmf, work1, work2, kbas, ktop, dtime, ma, upwd, dnwd,&
       dnwdbis, 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
  DO itra = 1, ntra
     DO k = 1, klev
        DO i = 1, klon
           d_tra(i, k, itra) = dtime*d_tra(i, k, itra)
        END DO
     END DO
  END DO
  ! les traceurs ne sont pas mis dans cette version de convect4:
  IF (iflag_con==4) THEN
     DO itra = 1, ntra
        DO k = 1, klev
           DO i = 1, klon
              d_tra(i, k, itra) = 0.
           END DO
        END DO
     END DO
  END IF

END SUBROUTINE concvl
1	SUBROUTINE concvl(iflag_con, dtime, paprs, pplay, t, q, u, v, tra,&
2	ntra, work1, work2, d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas,&
3	ktop, upwd, dnwd, dnwdbis, ma, cape, tvp, iflag, pbase, bbase,&
4	dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs,&
5	da, phi, mp)
6
7	! From phylmd/concvl.F, v 1.3 2005/04/15 12:36:17
8	! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
9	! Objet: schema de convection de Emanuel (1991) interface
10
11	USE dimens_m
12	USE dimphy
13	USE yomcst
14	USE yoethf
15	USE fcttre
16
17	IMPLICIT NONE
18
19	! Arguments:
20	! dtime--input-R-pas d'integration (s)
21	! s-------input-R-la valeur "s" pour chaque couche
22	! sigs----input-R-la valeur "sigma" de chaque couche
23	! sig-----input-R-la valeur de "sigma" pour chaque niveau
24	! psolpa--input-R-la pression au sol (en Pa)
25	! pskapa--input-R-exponentiel kappa de psolpa
26	! h-------input-R-enthalpie potentielle (CpT/P*kappa)
27	! q-------input-R-vapeur d'eau (en kg/kg)
28
29	! work*: input et output: deux variables de travail,
30	! on peut les mettre a 0 au debut
31	! ALE-----input-R-energie disponible pour soulevement
32
33	! d_h-----output-R-increment de l'enthalpie potentielle (h)
34	! d_q-----output-R-increment de la vapeur d'eau
35	! rain----output-R-la pluie (mm/s)
36	! snow----output-R-la neige (mm/s)
37	! upwd----output-R-saturated updraft mass flux (kg/m**2/s)
38	! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
39	! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
40	! Cape----output-R-CAPE (J/kg)
41	! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
42	! adiabatiquement a partir du niveau 1 (K)
43	! deltapb-output-R-distance entre LCL et base de la colonne (<0 ;
44	! Pa)
45	! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de
46	! la glace
47
48	INTEGER ntrac
49	PARAMETER (ntrac=nqmx-2)
50
51	INTEGER, INTENT (IN) :: iflag_con
52
53	REAL, INTENT (IN) :: dtime
54	REAL, INTENT (IN) :: paprs(klon, klev+1)
55	REAL, INTENT (IN) :: pplay(klon, klev)
56	REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev)
57	REAL, INTENT (IN):: tra(klon, klev, ntrac)
58	INTEGER ntra
59	REAL work1(klon, klev), work2(klon, klev)
60	REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
61
62	REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon,&
63	klev)
64	REAL d_tra(klon, klev, ntrac)
65	REAL rain(klon), snow(klon)
66
67	INTEGER kbas(klon), ktop(klon)
68	REAL em_ph(klon, klev+1), em_p(klon, klev)
69	REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
70	REAL ma(klon, klev), cape(klon), tvp(klon, klev)
71	REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
72	INTEGER iflag(klon)
73	REAL pbase(klon), bbase(klon)
74	REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
75	REAL dplcldt(klon), dplcldr(klon)
76	REAL qcondc(klon, klev)
77	REAL wd(klon)
78
79	REAL zx_t, zdelta, zx_qs, zcor
80
81	INTEGER i, k, itra
82	REAL qs(klon, klev)
83	REAL cbmf(klon)
84	SAVE cbmf
85	INTEGER ifrst
86	SAVE ifrst
87	DATA ifrst/0/
88
89	!-----------------------------------------------------------------
90
91	snow(:) = 0
92
93	IF (ifrst==0) THEN
94	ifrst = 1
95	DO i = 1, klon
96	cbmf(i) = 0.
97	END DO
98	END IF
99
100	DO k = 1, klev + 1
101	DO i = 1, klon
102	em_ph(i, k) = paprs(i, k)/100.0
103	pmflxs(i, k) = 0.
104	END DO
105	END DO
106
107	DO k = 1, klev
108	DO i = 1, klon
109	em_p(i, k) = pplay(i, k)/100.0
110	END DO
111	END DO
112
113
114	IF (iflag_con==4) THEN
115	DO k = 1, klev
116	DO i = 1, klon
117	zx_t = t(i, k)
118	zdelta = max(0., sign(1., rtt-zx_t))
119	zx_qs = min(0.5, r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0)
120	zcor = 1./(1.-retv*zx_qs)
121	qs(i, k) = zx_qs*zcor
122	END DO
123	END DO
124	ELSE
125	! iflag_con=3 (modif de puristes qui fait la diffce pour la
126	! convergence numerique)
127	DO k = 1, klev
128	DO i = 1, klon
129	zx_t = t(i, k)
130	zdelta = max(0., sign(1., rtt-zx_t))
131	zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
132	zx_qs = min(0.5, zx_qs)
133	zcor = 1./(1.-retv*zx_qs)
134	zx_qs = zx_qs*zcor
135	qs(i, k) = zx_qs
136	END DO
137	END DO
138	END IF
139
140	! Main driver for convection:
141	! iflag_con = 3 -> equivalent to convect3
142	! iflag_con = 4 -> equivalent to convect1/2
143
144	CALL cv_driver(klon, klev, klev+1, ntra, iflag_con, t, q, qs, u, v,&
145	tra, em_p, em_ph, iflag, d_t, d_q, d_u, d_v, d_tra, rain,&
146	pmflxr, cbmf, work1, work2, kbas, ktop, dtime, ma, upwd, dnwd,&
147	dnwdbis, qcondc, wd, cape, da, phi, mp)
148
149	DO i = 1, klon
150	rain(i) = rain(i)/86400.
151	END DO
152
153	DO k = 1, klev
154	DO i = 1, klon
155	d_t(i, k) = dtime*d_t(i, k)
156	d_q(i, k) = dtime*d_q(i, k)
157	d_u(i, k) = dtime*d_u(i, k)
158	d_v(i, k) = dtime*d_v(i, k)
159	END DO
160	END DO
161	DO itra = 1, ntra
162	DO k = 1, klev
163	DO i = 1, klon
164	d_tra(i, k, itra) = dtime*d_tra(i, k, itra)
165	END DO
166	END DO
167	END DO
168	! les traceurs ne sont pas mis dans cette version de convect4:
169	IF (iflag_con==4) THEN
170	DO itra = 1, ntra
171	DO k = 1, klev
172	DO i = 1, klon
173	d_tra(i, k, itra) = 0.
174	END DO
175	END DO
176	END DO
177	END IF
178
179	END SUBROUTINE concvl