GCC Code Coverage Report

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