Directory: | ./ |
---|---|
File: | phys/cv3_enthalpmix.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 72 | 76 | 94.7% |
Branches: | 55 | 64 | 85.9% |
Line | Branch | Exec | Source |
---|---|---|---|
1 | 11227036 | SUBROUTINE cv3_enthalpmix(len, nd, iflag, plim1, plim2, p, ph, & | |
2 | t, q, u, v, w, & | ||
3 | 1680 | wi, nk, tmix, thmix, qmix, qsmix, umix, vmix, plcl) | |
4 | ! ************************************************************** | ||
5 | ! * | ||
6 | ! CV3_ENTHALPMIX Brassage adiabatique d'une couche d'epaisseur * | ||
7 | ! arbitraire. * | ||
8 | ! * | ||
9 | ! written by : Grandpeix Jean-Yves, 28/12/2001, 13.14.24 * | ||
10 | ! modified by : Filiberti M-A 06/2005 vectorisation * | ||
11 | ! ************************************************************** | ||
12 | |||
13 | IMPLICIT NONE | ||
14 | ! ============================================================== | ||
15 | |||
16 | ! vertmix : determines theta, t, q, qs, u and v of the mixture generated by | ||
17 | ! adiabatic mixing of air between plim1 and plim2 with weighting w. | ||
18 | ! If plim1 and plim2 fall within the same model layer, then theta, ... v | ||
19 | ! are those of that layer. | ||
20 | ! A minimum value (dpmin) is imposed upon plim1-plim2 | ||
21 | |||
22 | ! =============================================================== | ||
23 | |||
24 | include "cvthermo.h" | ||
25 | include "YOETHF.h" | ||
26 | include "YOMCST.h" | ||
27 | include "FCTTRE.h" | ||
28 | !inputs: | ||
29 | INTEGER, INTENT (IN) :: nd, len | ||
30 | INTEGER, DIMENSION (len), INTENT (IN) :: nk | ||
31 | REAL, DIMENSION (len), INTENT (IN) :: plim1, plim2 | ||
32 | REAL, DIMENSION (len,nd), INTENT (IN) :: t, q | ||
33 | REAL, DIMENSION (len,nd), INTENT (IN) :: u, v | ||
34 | REAL, DIMENSION (nd), INTENT (IN) :: w | ||
35 | REAL, DIMENSION (len,nd), INTENT (IN) :: p | ||
36 | REAL, DIMENSION (len,nd+1), INTENT (IN) :: ph | ||
37 | !input/output: | ||
38 | INTEGER, DIMENSION (len), INTENT (INOUT) :: iflag | ||
39 | !outputs: | ||
40 | REAL, DIMENSION (len), INTENT (OUT) :: tmix, thmix, qmix | ||
41 | REAL, DIMENSION (len), INTENT (OUT) :: umix, vmix | ||
42 | REAL, DIMENSION (len), INTENT (OUT) :: qsmix | ||
43 | REAL, DIMENSION (len), INTENT (OUT) :: plcl | ||
44 | REAL, DIMENSION (len,nd), INTENT (OUT) :: wi | ||
45 | !internal variables : | ||
46 | INTEGER i, j | ||
47 | INTEGER niflag7 | ||
48 | 3360 | INTEGER, DIMENSION(len) :: j1, j2 | |
49 | REAL :: a, b | ||
50 | REAL :: cpn | ||
51 | REAL :: x, y, p0, p0m1, zdelta, zcor | ||
52 | REAL, SAVE :: dpmin=1. | ||
53 | !$OMP THREADPRIVATE(dpmin) | ||
54 | 3360 | REAL, DIMENSION(len) :: plim2p ! = min(plim2(:),plim1(:)-dpmin) | |
55 | 3360 | REAL, DIMENSION(len) :: akm ! mixture enthalpy | |
56 | 3360 | REAL, DIMENSION(len) :: dpw, coef | |
57 | 3360 | REAL, DIMENSION(len) :: rdcp, a2, b2, pnk | |
58 | 3360 | REAL, DIMENSION(len) :: rh, chi | |
59 | 3360 | REAL, DIMENSION(len) :: eqwght | |
60 | 3360 | REAL, DIMENSION(len,nd) :: p1, p2 | |
61 | |||
62 | |||
63 | !! print *,' ->cv3_vertmix, plim1,plim2 ', plim1,plim2 !jyg | ||
64 |
2/2✓ Branch 0 taken 1669920 times.
✓ Branch 1 taken 1680 times.
|
1671600 | plim2p(:) = min(plim2(:),plim1(:)-dpmin) |
65 |
2/2✓ Branch 0 taken 1669920 times.
✓ Branch 1 taken 1680 times.
|
1671600 | j1(:)=nd |
66 |
2/2✓ Branch 0 taken 1669920 times.
✓ Branch 1 taken 1680 times.
|
1671600 | j2(:) = 0 |
67 |
2/2✓ Branch 0 taken 65520 times.
✓ Branch 1 taken 1680 times.
|
67200 | DO j = 1, nd |
68 |
2/2✓ Branch 0 taken 65126880 times.
✓ Branch 1 taken 65520 times.
|
65194080 | DO i = 1, len |
69 |
2/2✓ Branch 0 taken 1669920 times.
✓ Branch 1 taken 63456960 times.
|
65126880 | IF (plim1(i)<=ph(i,j)) j1(i) = j |
70 | !!! IF (plim2p(i)>=ph(i,j+1) .AND. plim2p(i)<ph(i,j)) j2(i) = j | ||
71 |
2/2✓ Branch 0 taken 3942758 times.
✓ Branch 1 taken 61184122 times.
|
65192400 | IF (plim2p(i)< ph(i,j)) j2(i) = j |
72 | END DO | ||
73 | END DO | ||
74 | |||
75 |
2/2✓ Branch 0 taken 65520 times.
✓ Branch 1 taken 1680 times.
|
67200 | DO j = 1, nd |
76 |
2/2✓ Branch 0 taken 65126880 times.
✓ Branch 1 taken 65520 times.
|
65194080 | DO i = 1, len |
77 | 65192400 | wi(i, j) = 0. | |
78 | END DO | ||
79 | END DO | ||
80 |
2/2✓ Branch 0 taken 1669920 times.
✓ Branch 1 taken 1680 times.
|
1671600 | DO i = 1, len |
81 | 1669920 | akm(i) = 0. | |
82 | 1669920 | qmix(i) = 0. | |
83 | 1669920 | umix(i) = 0. | |
84 | 1669920 | vmix(i) = 0. | |
85 | 1669920 | dpw(i) = 0. | |
86 | 1669920 | a2(i) = 0.0 | |
87 | 1669920 | b2(i) = 0. | |
88 | 1671600 | pnk(i) = p(i, nk(i)) | |
89 | END DO | ||
90 |
2/2✓ Branch 0 taken 1669920 times.
✓ Branch 1 taken 1680 times.
|
1671600 | eqwght(:) = 0. |
91 | |||
92 | p0 = 1000. | ||
93 | p0m1 = 1./p0 | ||
94 | |||
95 |
2/2✓ Branch 0 taken 1669920 times.
✓ Branch 1 taken 1680 times.
|
1671600 | DO i = 1, len |
96 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1669920 times.
|
1671600 | IF (j2(i) < j1(i)) THEN |
97 | ✗ | coef(i) = 1. | |
98 | ✗ | eqwght(i) = 1. | |
99 | ELSE | ||
100 | 1669920 | coef(i) = 1./(plim1(i)-plim2p(i)) | |
101 | ENDIF | ||
102 | END DO | ||
103 | |||
104 | !! print *,'cv3_vertmix, j1,j2,coef ', j1,j2,coef !jyg | ||
105 | |||
106 |
2/2✓ Branch 0 taken 65520 times.
✓ Branch 1 taken 1680 times.
|
67200 | DO j = 1, nd |
107 |
2/2✓ Branch 0 taken 65126880 times.
✓ Branch 1 taken 65520 times.
|
65194080 | DO i = 1, len |
108 |
3/4✓ Branch 0 taken 65126880 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 3942758 times.
✓ Branch 3 taken 61184122 times.
|
65192400 | IF (j>=j1(i) .AND. j<=j2(i)) THEN |
109 | 3942758 | p1(i, j) = min(ph(i,j), plim1(i)) | |
110 | 3942758 | p2(i, j) = max(ph(i,j+1), plim2p(i)) | |
111 | ! CRtest:couplage thermiques: deja normalise | ||
112 | ! wi(i,j) = w(j) | ||
113 | ! print*,'wi',wi(i,j) | ||
114 | 3942758 | wi(i, j) = w(j)*(p1(i,j)-p2(i,j))*coef(i)+eqwght(i) | |
115 | 3942758 | dpw(i) = dpw(i) + wi(i, j) | |
116 | |||
117 | !! print *,'cv3_vertmix, j, wi(1,j),dpw ', j, wi(1,j),dpw !jyg | ||
118 | |||
119 | END IF | ||
120 | END DO | ||
121 | END DO | ||
122 | |||
123 | ! CR:print | ||
124 | ! do i=1,len | ||
125 | ! print*,'plim',plim1(i),plim2p(i) | ||
126 | ! enddo | ||
127 |
2/2✓ Branch 0 taken 65520 times.
✓ Branch 1 taken 1680 times.
|
67200 | DO j = 1, nd |
128 |
2/2✓ Branch 0 taken 65126880 times.
✓ Branch 1 taken 65520 times.
|
65194080 | DO i = 1, len |
129 |
3/4✓ Branch 0 taken 65126880 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 3942758 times.
✓ Branch 3 taken 61184122 times.
|
65192400 | IF (j>=j1(i) .AND. j<=j2(i)) THEN |
130 | 3942758 | wi(i, j) = wi(i, j)/dpw(i) | |
131 | 3942758 | akm(i) = akm(i) + (cpd*(1.-q(i,j))+q(i,j)*cpv)*t(i, j)*wi(i, j) | |
132 | 3942758 | qmix(i) = qmix(i) + q(i, j)*wi(i, j) | |
133 | 3942758 | umix(i) = umix(i) + u(i, j)*wi(i, j) | |
134 | 3942758 | vmix(i) = vmix(i) + v(i, j)*wi(i, j) | |
135 | END IF | ||
136 | END DO | ||
137 | END DO | ||
138 | |||
139 |
2/2✓ Branch 0 taken 1669920 times.
✓ Branch 1 taken 1680 times.
|
1671600 | DO i = 1, len |
140 | 1671600 | rdcp(i) = (rrd*(1.-qmix(i))+qmix(i)*rrv)/(cpd*(1.-qmix(i))+qmix(i)*cpv) | |
141 | END DO | ||
142 | |||
143 | |||
144 | !! print *,'cv3_vertmix, rdcp ', rdcp !jyg | ||
145 | |||
146 | |||
147 | |||
148 |
2/2✓ Branch 0 taken 65520 times.
✓ Branch 1 taken 1680 times.
|
67200 | DO j = 1, nd |
149 |
2/2✓ Branch 0 taken 65126880 times.
✓ Branch 1 taken 65520 times.
|
65194080 | DO i = 1, len |
150 |
3/4✓ Branch 0 taken 65126880 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 3942758 times.
✓ Branch 3 taken 61184122 times.
|
65192400 | IF (j>=j1(i) .AND. j<=j2(i)) THEN |
151 | ! c x=(.5*(p1(i,j)+p2(i,j))*p0m1)**rdcp(i) | ||
152 | 3942758 | y = (.5*(p1(i,j)+p2(i,j))/pnk(i))**rdcp(i) | |
153 | ! c a2(i)=a2(i)+(cpd*(1.-qmix(i))+qmix(i)*cpv)*x*wi(i,j) | ||
154 | 3942758 | b2(i) = b2(i) + (cpd*(1.-qmix(i))+qmix(i)*cpv)*y*wi(i, j) | |
155 | END IF | ||
156 | END DO | ||
157 | END DO | ||
158 | |||
159 |
2/2✓ Branch 0 taken 1669920 times.
✓ Branch 1 taken 1680 times.
|
1671600 | DO i = 1, len |
160 | 1669920 | tmix(i) = akm(i)/b2(i) | |
161 | 1669920 | thmix(i) = tmix(i)*(p0/pnk(i))**rdcp(i) | |
162 | ! print*,'thmix akm',akm(i),b2(i) | ||
163 | ! print*,'thmix t',tmix(i),p0 | ||
164 | ! print*,'thmix p',pnk(i),rdcp(i) | ||
165 | ! print*,'thmix',thmix(i) | ||
166 | ! c thmix(i) = akm(i)/a2(i) | ||
167 | ! c tmix(i)= thmix(i)*(pnk(i)*p0m1)**rdcp(i) | ||
168 | 1669920 | zdelta = max(0., sign(1.,rtt-tmix(i))) | |
169 | 1669920 | qsmix(i) = r2es*foeew(tmix(i), zdelta)/(pnk(i)*100.) | |
170 | 1669920 | qsmix(i) = min(0.5, qsmix(i)) | |
171 | 1669920 | zcor = 1./(1.-retv*qsmix(i)) | |
172 | 1671600 | qsmix(i) = qsmix(i)*zcor | |
173 | END DO | ||
174 | |||
175 | ! ------------------------------------------------------------------- | ||
176 | ! --- Calculate lifted condensation level of air at parcel origin level | ||
177 | ! --- (Within 0.2% of formula of Bolton, MON. WEA. REV.,1980) | ||
178 | ! ------------------------------------------------------------------- | ||
179 | |||
180 | a = 1669.0 ! convect3 | ||
181 | b = 122.0 ! convect3 | ||
182 | |||
183 | |||
184 | niflag7 = 0 | ||
185 |
2/2✓ Branch 0 taken 1669920 times.
✓ Branch 1 taken 1680 times.
|
1671600 | DO i = 1, len |
186 | |||
187 |
1/2✓ Branch 0 taken 1669920 times.
✗ Branch 1 not taken.
|
1671600 | IF (iflag(i)/=7) THEN ! modif sb Jun7th 2002 |
188 | |||
189 | 1669920 | rh(i) = qmix(i)/qsmix(i) | |
190 | 1669920 | chi(i) = tmix(i)/(a-b*rh(i)-tmix(i)) ! convect3 | |
191 | ! ATTENTION, la LIGNE DESSOUS A ETE RAJOUTEE ARBITRAIREMENT ET | ||
192 | ! MASQUE UN PB POTENTIEL | ||
193 | 1669920 | chi(i) = max(chi(i), 0.) | |
194 | 1669920 | rh(i) = max(rh(i), 0.) | |
195 | 1669920 | plcl(i) = pnk(i)*(rh(i)**chi(i)) | |
196 |
2/6✓ Branch 0 taken 1669920 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1669920 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
|
1669920 | IF (((plcl(i)<200.0) .OR. (plcl(i)>=2000.0)) .AND. (iflag(i)==0)) & |
197 | ✗ | iflag(i) = 8 | |
198 | |||
199 | ELSE | ||
200 | |||
201 | niflag7 = niflag7 + 1 | ||
202 | ✗ | plcl(i) = plim2p(i) | |
203 | |||
204 | END IF ! iflag=7 | ||
205 | |||
206 | ! print*,'NIFLAG7 =',niflag7 | ||
207 | |||
208 | END DO | ||
209 | |||
210 | !! print *,' cv3_vertmix->' !jyg | ||
211 | |||
212 | |||
213 | 1680 | RETURN | |
214 | END SUBROUTINE cv3_enthalpmix | ||
215 | |||
216 |