1 | |
---|
2 | ! $Header$ |
---|
3 | |
---|
4 | SUBROUTINE conemav(dtime, paprs, pplay, t, q, u, v, tra, ntra, work1, work2, & |
---|
5 | d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, ktop, upwd, dnwd, dnwdbis, & |
---|
6 | ma, cape, tvp, iflag, pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr) |
---|
7 | |
---|
8 | |
---|
9 | USE dimphy |
---|
10 | USE infotrac_phy, ONLY: nbtr |
---|
11 | USE yomcst_mod_h |
---|
12 | USE yoethf_mod_h |
---|
13 | IMPLICIT NONE |
---|
14 | ! ====================================================================== |
---|
15 | ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818 |
---|
16 | ! Objet: schema de convection de Emanuel (1991) interface |
---|
17 | ! ====================================================================== |
---|
18 | ! Arguments: |
---|
19 | ! dtime--input-R-pas d'integration (s) |
---|
20 | ! s-------input-R-la valeur "s" pour chaque couche |
---|
21 | ! sigs----input-R-la valeur "sigma" de chaque couche |
---|
22 | ! sig-----input-R-la valeur de "sigma" pour chaque niveau |
---|
23 | ! psolpa--input-R-la pression au sol (en Pa) |
---|
24 | ! pskapa--input-R-exponentiel kappa de psolpa |
---|
25 | ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa) |
---|
26 | ! q-------input-R-vapeur d'eau (en kg/kg) |
---|
27 | |
---|
28 | ! work*: input et output: deux variables de travail, |
---|
29 | ! on peut les mettre a 0 au debut |
---|
30 | ! ALE-----input-R-energie disponible pour soulevement |
---|
31 | |
---|
32 | ! d_h-----output-R-increment de l'enthalpie potentielle (h) |
---|
33 | ! d_q-----output-R-increment de la vapeur d'eau |
---|
34 | ! rain----output-R-la pluie (mm/s) |
---|
35 | ! snow----output-R-la neige (mm/s) |
---|
36 | ! upwd----output-R-saturated updraft mass flux (kg/m**2/s) |
---|
37 | ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s) |
---|
38 | ! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s) |
---|
39 | ! Cape----output-R-CAPE (J/kg) |
---|
40 | ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee |
---|
41 | ! adiabatiquement a partir du niveau 1 (K) |
---|
42 | ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa) |
---|
43 | ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace |
---|
44 | ! ====================================================================== |
---|
45 | |
---|
46 | |
---|
47 | REAL dtime, paprs(klon, klev+1), pplay(klon, klev) |
---|
48 | REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev) |
---|
49 | REAL tra(klon, klev, nbtr) |
---|
50 | INTEGER ntra |
---|
51 | REAL work1(klon, klev), work2(klon, klev) |
---|
52 | |
---|
53 | REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, klev) |
---|
54 | REAL d_tra(klon, klev, nbtr) |
---|
55 | REAL rain(klon), snow(klon) |
---|
56 | |
---|
57 | INTEGER kbas(klon), ktop(klon) |
---|
58 | REAL em_ph(klon, klev+1), em_p(klon, klev) |
---|
59 | REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev) |
---|
60 | REAL ma(klon, klev), cape(klon), tvp(klon, klev) |
---|
61 | INTEGER iflag(klon) |
---|
62 | REAL rflag(klon) |
---|
63 | REAL pbase(klon), bbase(klon) |
---|
64 | REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev) |
---|
65 | REAL dplcldt(klon), dplcldr(klon) |
---|
66 | |
---|
67 | REAL zx_t, zdelta, zx_qs, zcor |
---|
68 | |
---|
69 | INTEGER noff, minorig |
---|
70 | INTEGER i, k, itra |
---|
71 | REAL qs(klon, klev) |
---|
72 | REAL, ALLOCATABLE, SAVE :: cbmf(:) |
---|
73 | !$OMP THREADPRIVATE(cbmf) |
---|
74 | INTEGER ifrst |
---|
75 | SAVE ifrst |
---|
76 | DATA ifrst/0/ |
---|
77 | !$OMP THREADPRIVATE(ifrst) |
---|
78 | include "FCTTRE.h" |
---|
79 | |
---|
80 | |
---|
81 | IF (ifrst==0) THEN |
---|
82 | ifrst = 1 |
---|
83 | ALLOCATE (cbmf(klon)) |
---|
84 | DO i = 1, klon |
---|
85 | cbmf(i) = 0. |
---|
86 | END DO |
---|
87 | END IF |
---|
88 | |
---|
89 | DO k = 1, klev + 1 |
---|
90 | DO i = 1, klon |
---|
91 | em_ph(i, k) = paprs(i, k)/100.0 |
---|
92 | END DO |
---|
93 | END DO |
---|
94 | |
---|
95 | DO k = 1, klev |
---|
96 | DO i = 1, klon |
---|
97 | em_p(i, k) = pplay(i, k)/100.0 |
---|
98 | END DO |
---|
99 | END DO |
---|
100 | |
---|
101 | |
---|
102 | DO k = 1, klev |
---|
103 | DO i = 1, klon |
---|
104 | zx_t = t(i, k) |
---|
105 | zdelta = max(0., sign(1.,rtt-zx_t)) |
---|
106 | zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0) |
---|
107 | zcor = 1./(1.-retv*zx_qs) |
---|
108 | qs(i, k) = zx_qs*zcor |
---|
109 | END DO |
---|
110 | END DO |
---|
111 | |
---|
112 | noff = 2 |
---|
113 | minorig = 2 |
---|
114 | CALL convect1(klon, klev, klev+1, noff, minorig, t, q, qs, u, v, em_p, & |
---|
115 | em_ph, iflag, d_t, d_q, d_u, d_v, rain, cbmf, dtime, ma) |
---|
116 | |
---|
117 | DO i = 1, klon |
---|
118 | rain(i) = rain(i)/86400. |
---|
119 | rflag(i) = iflag(i) |
---|
120 | END DO |
---|
121 | ! call dump2d(iim,jjm-1,rflag(2:klon-1),'FLAG CONVECTION ') |
---|
122 | ! if (klon.eq.1) then |
---|
123 | ! print*,'IFLAG ',iflag |
---|
124 | ! else |
---|
125 | ! write(*,'(96i1)') (iflag(i),i=2,klon-1) |
---|
126 | ! endif |
---|
127 | DO k = 1, klev |
---|
128 | DO i = 1, klon |
---|
129 | d_t(i, k) = dtime*d_t(i, k) |
---|
130 | d_q(i, k) = dtime*d_q(i, k) |
---|
131 | d_u(i, k) = dtime*d_u(i, k) |
---|
132 | d_v(i, k) = dtime*d_v(i, k) |
---|
133 | END DO |
---|
134 | DO itra = 1, ntra |
---|
135 | DO i = 1, klon |
---|
136 | d_tra(i, k, itra) = 0. |
---|
137 | END DO |
---|
138 | END DO |
---|
139 | END DO |
---|
140 | |
---|
141 | |
---|
142 | |
---|
143 | |
---|
144 | RETURN |
---|
145 | END SUBROUTINE conemav |
---|
146 | |
---|