Directory: | ./ |
---|---|
File: | rad/swclr.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 128 | 170 | 75.3% |
Branches: | 57 | 82 | 69.5% |
Line | Branch | Exec | Source |
---|---|---|---|
1 | 1440 | SUBROUTINE SWCLR & | |
2 | & ( KIDIA , KFDIA , KLON , KLEV , KAER , KNU,& | ||
3 | 720 | & PAER , PALBP , PDSIG , PRAYL , PSEC,& | |
4 | 720 | & PCGAZ , PPIZAZ, PRAY1 , PRAY2 , PREFZ , PRJ,& | |
5 | & PRK , PRMU0 , PTAUAZ, PTRA1 , PTRA2 , PTRCLR, & | ||
6 | !++MODIFCODE | ||
7 | & LDDUST,PPIZA_DST, PCGA_DST, PTAU_DST ) | ||
8 | !--MODIFCODE | ||
9 | |||
10 | !**** *SWCLR* - CLEAR-SKY COLUMN COMPUTATIONS | ||
11 | |||
12 | ! PURPOSE. | ||
13 | ! -------- | ||
14 | ! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF | ||
15 | ! CLEAR-SKY COLUMN | ||
16 | |||
17 | !** INTERFACE. | ||
18 | ! ---------- | ||
19 | |||
20 | ! *SWCLR* IS CALLED EITHER FROM *SW1S* | ||
21 | ! OR FROM *SWNI* | ||
22 | |||
23 | ! IMPLICIT ARGUMENTS : | ||
24 | ! -------------------- | ||
25 | |||
26 | ! ==== INPUTS === | ||
27 | ! ==== OUTPUTS === | ||
28 | |||
29 | ! METHOD. | ||
30 | ! ------- | ||
31 | |||
32 | ! EXTERNALS. | ||
33 | ! ---------- | ||
34 | |||
35 | ! NONE | ||
36 | |||
37 | ! REFERENCE. | ||
38 | ! ---------- | ||
39 | |||
40 | ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT | ||
41 | ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980) | ||
42 | |||
43 | ! AUTHOR. | ||
44 | ! ------- | ||
45 | ! JEAN-JACQUES MORCRETTE *ECMWF* | ||
46 | |||
47 | ! MODIFICATIONS. | ||
48 | ! -------------- | ||
49 | ! ORIGINAL : 94-11-15 | ||
50 | ! Modified : 96-03-19 JJM-PhD (loop 107 in absence of aerosols) | ||
51 | ! JJMorcrette 990128 : sunshine duration | ||
52 | ! JJMorcrette 990128 : sunshine duration | ||
53 | ! 99-05-25 JJMorcrette Revised aerosols | ||
54 | ! JJMorcrette 001218 : 6 spectral intervals | ||
55 | ! 03-10-10 Deborah Salmond and Marta Janiskova Optimisation | ||
56 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning | ||
57 | ! A.Grini (Meteo-France: 2005-11-10) | ||
58 | ! Y.Seity 05-10-10 : add add 3 optional arg. for dust SW properties | ||
59 | ! Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests | ||
60 | ! O.Boucher fev.2014: modification sur les aerosols pour utiliser les variables DST | ||
61 | ! ------------------------------------------------------------------ | ||
62 | |||
63 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
64 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK | ||
65 | |||
66 | USE YOESW , ONLY : RTAUA ,RPIZA ,RCGA | ||
67 | !USE YOERAD , ONLY : NOVLP ,NSW | ||
68 | ! NSW mis dans .def MPL 20140211 | ||
69 | USE YOERAD , ONLY : NOVLP | ||
70 | USE YOERDI , ONLY : REPCLC | ||
71 | USE YOERDU , ONLY : REPSCT | ||
72 | |||
73 | IMPLICIT NONE | ||
74 | INCLUDE "clesphys.h" | ||
75 | |||
76 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
77 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
78 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
79 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
80 | INTEGER(KIND=JPIM),INTENT(IN) :: KAER | ||
81 | INTEGER(KIND=JPIM),INTENT(IN) :: KNU | ||
82 | REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) | ||
83 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW) | ||
84 | REAL(KIND=JPRB) ,INTENT(IN) :: PDSIG(KLON,KLEV) | ||
85 | REAL(KIND=JPRB) ,INTENT(IN) :: PRAYL(KLON) | ||
86 | REAL(KIND=JPRB) ,INTENT(IN) :: PSEC(KLON) | ||
87 | !++MODIFCODE | ||
88 | LOGICAL ,INTENT(IN) :: LDDUST ! flag for DUST | ||
89 | REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV) | ||
90 | REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV) | ||
91 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_DST(KLON,KLEV) | ||
92 | !--MODIFCODE | ||
93 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCGAZ(KLON,KLEV) | ||
94 | REAL(KIND=JPRB) ,INTENT(OUT) :: PPIZAZ(KLON,KLEV) | ||
95 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY1(KLON,KLEV+1) | ||
96 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY2(KLON,KLEV+1) | ||
97 | REAL(KIND=JPRB) ,INTENT(OUT) :: PREFZ(KLON,2,KLEV+1) | ||
98 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRJ(KLON,6,KLEV+1) | ||
99 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRK(KLON,6,KLEV+1) | ||
100 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRMU0(KLON,KLEV+1) | ||
101 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTAUAZ(KLON,KLEV) | ||
102 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA1(KLON,KLEV+1) | ||
103 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA2(KLON,KLEV+1) | ||
104 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRCLR(KLON) | ||
105 | ! ------------------------------------------------------------------ | ||
106 | |||
107 | !* 0.1 ARGUMENTS | ||
108 | ! --------- | ||
109 | |||
110 | ! ------------------------------------------------------------------ | ||
111 | |||
112 | ! ------------ | ||
113 | |||
114 | 1440 | REAL(KIND=JPRB) :: ZC0I(KLON,KLEV+1)& | |
115 | 1440 | & , ZCLE0(KLON,KLEV), ZCLEAR(KLON) & | |
116 | 1440 | & , ZR21(KLON)& | |
117 | 1440 | & , ZR23(KLON) , ZSS0(KLON) , ZSCAT(KLON)& | |
118 | 1440 | & , ZTR(KLON,2,KLEV+1) | |
119 | |||
120 | INTEGER(KIND=JPIM) :: IKL, JA, JAE, JAJ, JK, JKL, JKLP1, JKM1, JL, INU1 | ||
121 | |||
122 | REAL(KIND=JPRB) :: ZBMU0, ZBMU1, ZCORAE, ZDEN, ZDEN1, ZFACOA,& | ||
123 | & ZFF, ZGAP, ZGAR, ZMU1, ZMUE, ZRATIO, ZRE11, & | ||
124 | & ZTO, ZTRAY, ZWW, ZDENB | ||
125 | REAL(KIND=JPRB) :: ZRR,ZMU0,ZI2MU1,ZIMU1,ZIDEN,ZIDEN1 | ||
126 | REAL(KIND=JPRB) :: ZHOOK_HANDLE | ||
127 | !++MODIFCODE | ||
128 | 1440 | REAL(KIND=JPRB) ::ZFACOA_NEW(KLON,KLEV) | |
129 | !--MODIFCODE | ||
130 | |||
131 | |||
132 | ! ------------------------------------------------------------------ | ||
133 | |||
134 | !* 1. OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH | ||
135 | ! -------------------------------------------- | ||
136 | |||
137 |
1/2✓ Branch 0 taken 720 times.
✗ Branch 1 not taken.
|
720 | IF (LHOOK) CALL DR_HOOK('SWCLR',0,ZHOOK_HANDLE) |
138 |
2/2✓ Branch 0 taken 28800 times.
✓ Branch 1 taken 720 times.
|
29520 | DO JK = 1 , KLEV+1 |
139 |
2/2✓ Branch 0 taken 172800 times.
✓ Branch 1 taken 28800 times.
|
202320 | DO JA = 1 , 6 |
140 |
2/2✓ Branch 0 taken 171763200 times.
✓ Branch 1 taken 172800 times.
|
171964800 | DO JL = KIDIA,KFDIA |
141 | 171763200 | PRJ(JL,JA,JK) = 0.0_JPRB | |
142 | 171936000 | PRK(JL,JA,JK) = 0.0_JPRB | |
143 | ENDDO | ||
144 | ENDDO | ||
145 | ENDDO | ||
146 | |||
147 | ! ------ NB: 'PAER' AEROSOLS ARE ENTERED FROM TOP TO BOTTOM | ||
148 | |||
149 |
2/2✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
|
28800 | DO JK = 1 , KLEV |
150 | 28080 | IKL=KLEV+1-JK | |
151 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27939600 | DO JL = KIDIA,KFDIA |
152 | 27911520 | PCGAZ(JL,JK) = 0.0_JPRB | |
153 | 27911520 | PPIZAZ(JL,JK) = 0.0_JPRB | |
154 | 27911520 | PTAUAZ(JL,JK) = 0.0_JPRB | |
155 | 27939600 | ZFACOA_NEW(JL,JK) = 0.0_JPRB | |
156 | ENDDO | ||
157 | |||
158 | !++MODIFCODE | ||
159 | !--OB on fait passer les aerosols LMDZ dans la variable DST | ||
160 |
1/2✓ Branch 0 taken 28080 times.
✗ Branch 1 not taken.
|
28080 | IF(NOVLP < 5)THEN !ECMWF VERSION |
161 | ! DO JAE=1,6 | ||
162 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27939600 | DO JL = KIDIA,KFDIA |
163 | ! PTAUAZ(JL,JK)=PTAUAZ(JL,JK)+PAER(JL,JAE,IKL)*RTAUA(KNU,JAE) | ||
164 | 27911520 | PTAUAZ(JL,JK)=PTAU_DST(JL,IKL) | |
165 | ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JAE,IKL)& | ||
166 | ! & * RTAUA(KNU,JAE)*RPIZA(KNU,JAE) | ||
167 | 27911520 | PPIZAZ(JL,JK)=PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL) | |
168 | ! PCGAZ(JL,JK) = PCGAZ(JL,JK) +PAER(JL,JAE,IKL)& | ||
169 | ! & * RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE) | ||
170 | 27939600 | PCGAZ(JL,JK)=PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL) | |
171 | ENDDO | ||
172 | ! ENDDO | ||
173 | ELSE ! MESONH VERSION | ||
174 | !--OB on utilise directement les aerosols LMDZ | ||
175 | ! DO JAE=1,6 | ||
176 | ✗ | DO JL = KIDIA,KFDIA | |
177 | !Special optical properties for dust | ||
178 | ! IF (LDDUST.AND.(JAE==3)) THEN | ||
179 | !Ponderation of aerosol optical properties:first step | ||
180 | !ti | ||
181 | ! PTAUAZ(JL,JK)=PTAUAZ(JL,JK) + PAER(JL,JAE,IKL) * PTAUREL_DST(JL,IKL) | ||
182 | ✗ | PTAUAZ(JL,JK)= PTAU_DST(JL,IKL) | |
183 | !wi*ti | ||
184 | ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK) + PAER(JL,JAE,IKL) & | ||
185 | ! & *PTAUREL_DST(JL,IKL)*PPIZA_DST(JL,IKL) | ||
186 | ✗ | PPIZAZ(JL,JK)=PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL) | |
187 | !wi*ti*gi | ||
188 | ! PCGAZ(JL,JK) = PCGAZ(JL,JK) + PAER(JL,JAE,IKL) & | ||
189 | ! & *PTAUREL_DST(JL,IKL)*PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL) | ||
190 | ✗ | PCGAZ(JL,JK) = PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL) | |
191 | !wi*ti*(gi**2) | ||
192 | ! ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)+PAER(JL, JAE, IKL)& | ||
193 | ! & *PTAUREL_DST(JL,IKL) *PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)*& | ||
194 | ! & PCGA_DST(JL,IKL) | ||
195 | ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)+& | ||
196 | & PTAU_DST(JL,IKL) *PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)*& | ||
197 | ✗ | & PCGA_DST(JL,IKL) | |
198 | ! ELSE | ||
199 | !Ponderation of aerosol optical properties:first step | ||
200 | !ti | ||
201 | ! PTAUAZ(JL,JK)=PTAUAZ(JL,JK)+PAER(JL, JAE, IKL)*RTAUA(KNU,JAE) | ||
202 | !wi*ti | ||
203 | ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL, JAE, IKL)& | ||
204 | ! &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE) | ||
205 | !wi*ti*gi | ||
206 | ! PCGAZ(JL,JK) = PCGAZ(JL,JK) +PAER(JL, JAE, IKL)& | ||
207 | ! &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE) | ||
208 | !wi*ti*(gi**2) | ||
209 | ! ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)+PAER(JL, JAE, IKL)& | ||
210 | ! &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)*RCGA(KNU,JAE) | ||
211 | ! ENDIF | ||
212 | ENDDO | ||
213 | ! ENDDO | ||
214 | ENDIF | ||
215 | !--MODIFCODE | ||
216 | |||
217 | !++MODIFCODE | ||
218 |
1/2✓ Branch 0 taken 28080 times.
✗ Branch 1 not taken.
|
28800 | IF (NOVLP < 5) then !ECMWF VERSION |
219 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27939600 | DO JL = KIDIA,KFDIA |
220 |
1/2✓ Branch 0 taken 27911520 times.
✗ Branch 1 not taken.
|
27939600 | IF (KAER /= 0) THEN |
221 | 27911520 | PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK) | |
222 | 27911520 | PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK) | |
223 | !!!! wrong ZRATIO = ZTRAY / (ZTRAY + PTAUAZ(JL,JK)) | ||
224 | !-- | ||
225 | ZGAR = PCGAZ(JL,JK) | ||
226 | 27911520 | ZFF = ZGAR * ZGAR | |
227 | |||
228 | !-- bug-fix: ZRATIO must be defined from the transformed value of optical thickness | ||
229 | ! MPLFH : ZTRAY N'EST PAS INITIALISE !!!!! A REVOIR (MPL) | ||
230 | 27911520 | ZTRAY= PRAYL(JL) * PDSIG(JL,JK) | |
231 | ! print *,'>>>>>>> swclr: ZTRAY ',ZTRAY | ||
232 | 27911520 | ZDENB = ZTRAY + PTAUAZ(JL,JK)*(1.0_JPRB-PPIZAZ(JL,JK)*ZFF) | |
233 | 27911520 | ZRATIO=ZTRAY/ZDENB | |
234 | !-- | ||
235 | 27911520 | PTAUAZ(JL,JK)=ZTRAY+PTAUAZ(JL,JK)*(1.0_JPRB-PPIZAZ(JL,JK)*ZFF) | |
236 | 27911520 | PCGAZ(JL,JK) = ZGAR * (1.0_JPRB - ZRATIO) / (1.0_JPRB + ZGAR) | |
237 | PPIZAZ(JL,JK) =ZRATIO+(1.0_JPRB-ZRATIO)*PPIZAZ(JL,JK)*(1.0_JPRB-ZFF)& | ||
238 | 27911520 | & / (1.0_JPRB - PPIZAZ(JL,JK) * ZFF) | |
239 | ELSE | ||
240 | ✗ | ZTRAY = PRAYL(JL) * PDSIG(JL,JK) | |
241 | ✗ | PTAUAZ(JL,JK) = ZTRAY | |
242 | ✗ | PCGAZ(JL,JK) = 0.0_JPRB | |
243 | ✗ | PPIZAZ(JL,JK) = 1.0_JPRB-REPSCT | |
244 | ENDIF | ||
245 | ENDDO | ||
246 | ELSE !MESONH VERSION | ||
247 | ✗ | DO JL = KIDIA,KFDIA | |
248 | ✗ | IF (KAER /= 0) THEN | |
249 | ✗ | ZTRAY = PRAYL(JL) * PDSIG(JL,JK) | |
250 | ✗ | ZRATIO =PPIZAZ(JL,JK)+ZTRAY | |
251 | !Ponderation G**2 | ||
252 | ✗ | ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)/ZRATIO | |
253 | !Ponderation w | ||
254 | ✗ | PPIZAZ(JL,JK)=ZRATIO/(PTAUAZ(JL,JK)+ZTRAY) | |
255 | !Ponderation g | ||
256 | ✗ | PCGAZ(JL,JK)=PCGAZ(JL,JK)/ZRATIO | |
257 | !Ponderation+delta-modified parameters tau | ||
258 | PTAUAZ(JL,JK)=(ZTRAY+PTAUAZ(JL,JK))*& | ||
259 | ✗ | & (1.0_JPRB-PPIZAZ(JL,JK)*ZFACOA_NEW(JL,JK)) | |
260 | !delta-modified parameters w | ||
261 | PPIZAZ(JL,JK)=PPIZAZ(JL,JK)*(1.0_JPRB-ZFACOA_NEW(JL,JK))/& | ||
262 | ✗ | & (1.0_JPRB-ZFACOA_NEW(JL,JK)*PPIZAZ(JL,JK)) | |
263 | !delta-modified parameters g | ||
264 | ✗ | PCGAZ(JL,JK)=PCGAZ(JL,JK)/(1.0_JPRB+PCGAZ(JL,JK)) | |
265 | |||
266 | ELSE | ||
267 | ✗ | ZTRAY = PRAYL(JL) * PDSIG(JL,JK) | |
268 | ✗ | ZFACOA_NEW(JL,JK)= 0.0_JPRB | |
269 | ✗ | PTAUAZ(JL,JK) = ZTRAY | |
270 | ✗ | PCGAZ(JL,JK) = 0.0_JPRB | |
271 | ✗ | PPIZAZ(JL,JK) = 1.0_JPRB-REPSCT | |
272 | ENDIF | ||
273 | ENDDO | ||
274 | ENDIF | ||
275 | !--MODIFCODE | ||
276 | |||
277 | ENDDO | ||
278 | |||
279 | ! ------------------------------------------------------------------ | ||
280 | |||
281 | !* 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL | ||
282 | ! ---------------------------------------------- | ||
283 | |||
284 |
2/2✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
|
716400 | DO JL = KIDIA,KFDIA |
285 | 715680 | ZR23(JL) = 0.0_JPRB | |
286 | 715680 | ZC0I(JL,KLEV+1) = 0.0_JPRB | |
287 | 715680 | ZCLEAR(JL) = 1.0_JPRB | |
288 | 716400 | ZSCAT(JL) = 0.0_JPRB | |
289 | ENDDO | ||
290 | |||
291 | JK = 1 | ||
292 | JKL = KLEV+1 - JK | ||
293 | JKLP1 = JKL + 1 | ||
294 |
2/2✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
|
716400 | DO JL = KIDIA,KFDIA |
295 | !++MODIFCODE | ||
296 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 715680 times.
|
715680 | IF (NOVLP >= 5) THEN |
297 | ✗ | ZFACOA = PTAUAZ(JL,JK) | |
298 | ✗ | ZCORAE = ZFACOA * PSEC(JL) | |
299 | ELSE | ||
300 | 715680 | ZFACOA = 1.0_JPRB - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL) | |
301 | 715680 | ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL) | |
302 | ENDIF | ||
303 | !--MODIFCODE | ||
304 | 715680 | ZR21(JL) = EXP(-ZCORAE ) | |
305 | 715680 | ZSS0(JL) = 1.0_JPRB-ZR21(JL) | |
306 | 715680 | ZCLE0(JL,JKL) = ZSS0(JL) | |
307 | |||
308 |
1/2✓ Branch 0 taken 715680 times.
✗ Branch 1 not taken.
|
716400 | IF (NOVLP == 1 .OR. NOVLP == 4) THEN |
309 | !* maximum-random | ||
310 | ZCLEAR(JL) = ZCLEAR(JL)& | ||
311 | & *(1.0_JPRB-MAX(ZSS0(JL),ZSCAT(JL)))& | ||
312 | 715680 | & /(1.0_JPRB-MIN(ZSCAT(JL),1.0_JPRB-REPCLC)) | |
313 | 715680 | ZC0I(JL,JKL) = 1.0_JPRB - ZCLEAR(JL) | |
314 | 715680 | ZSCAT(JL) = ZSS0(JL) | |
315 | ✗ | ELSEIF (NOVLP == 2) THEN | |
316 | !* maximum | ||
317 | ✗ | ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) ) | |
318 | ✗ | ZC0I(JL,JKL) = ZSCAT(JL) | |
319 | !++MODIFCODE | ||
320 | ✗ | ELSEIF ((NOVLP == 3).OR.(NOVLP >= 5)) THEN | |
321 | !--MODIFCODE | ||
322 | !* random | ||
323 | ✗ | ZCLEAR(JL)=ZCLEAR(JL)*(1.0_JPRB-ZSS0(JL)) | |
324 | ✗ | ZSCAT(JL) = 1.0_JPRB - ZCLEAR(JL) | |
325 | ✗ | ZC0I(JL,JKL) = ZSCAT(JL) | |
326 | ENDIF | ||
327 | ENDDO | ||
328 | |||
329 |
2/2✓ Branch 0 taken 27360 times.
✓ Branch 1 taken 720 times.
|
28080 | DO JK = 2 , KLEV |
330 | 27360 | JKL = KLEV+1 - JK | |
331 | JKLP1 = JKL + 1 | ||
332 |
2/2✓ Branch 0 taken 27195840 times.
✓ Branch 1 taken 27360 times.
|
27223920 | DO JL = KIDIA,KFDIA |
333 | !++MODIFCODE | ||
334 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 27195840 times.
|
27195840 | IF (NOVLP >= 5) THEN |
335 | ✗ | ZFACOA = PTAUAZ(JL,JK) | |
336 | ✗ | ZCORAE = ZFACOA * PSEC(JL) | |
337 | ELSE | ||
338 | 27195840 | ZFACOA = 1.0_JPRB - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL) | |
339 | 27195840 | ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL) | |
340 | ENDIF | ||
341 | !--MODIFCODE | ||
342 | 27195840 | ZR21(JL) = EXP(-ZCORAE ) | |
343 | 27195840 | ZSS0(JL) = 1.0_JPRB-ZR21(JL) | |
344 | 27195840 | ZCLE0(JL,JKL) = ZSS0(JL) | |
345 | |||
346 |
1/2✓ Branch 0 taken 27195840 times.
✗ Branch 1 not taken.
|
27223200 | IF (NOVLP == 1 .OR. NOVLP == 4) THEN |
347 | !* maximum-random | ||
348 | ZCLEAR(JL) = ZCLEAR(JL)& | ||
349 | & *(1.0_JPRB-MAX(ZSS0(JL),ZSCAT(JL)))& | ||
350 | 27195840 | & /(1.0_JPRB-MIN(ZSCAT(JL),1.0_JPRB-REPCLC)) | |
351 | 27195840 | ZC0I(JL,JKL) = 1.0_JPRB - ZCLEAR(JL) | |
352 | 27195840 | ZSCAT(JL) = ZSS0(JL) | |
353 | ✗ | ELSEIF (NOVLP == 2) THEN | |
354 | !* maximum | ||
355 | ✗ | ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) ) | |
356 | ✗ | ZC0I(JL,JKL) = ZSCAT(JL) | |
357 | !++MODIFCODE | ||
358 | ✗ | ELSEIF ((NOVLP == 3).OR.(NOVLP >= 5)) THEN | |
359 | !--MODIFCODE | ||
360 | !* random | ||
361 | ✗ | ZCLEAR(JL)=ZCLEAR(JL)*(1.0_JPRB-ZSS0(JL)) | |
362 | ✗ | ZSCAT(JL) = 1.0_JPRB - ZCLEAR(JL) | |
363 | ✗ | ZC0I(JL,JKL) = ZSCAT(JL) | |
364 | ENDIF | ||
365 | ENDDO | ||
366 | ENDDO | ||
367 | |||
368 | ! ------------------------------------------------------------------ | ||
369 | |||
370 | !* 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING | ||
371 | ! ----------------------------------------------- | ||
372 | |||
373 |
2/2✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
|
716400 | DO JL = KIDIA,KFDIA |
374 | 715680 | PRAY1(JL,KLEV+1) = 0.0_JPRB | |
375 | 715680 | PRAY2(JL,KLEV+1) = 0.0_JPRB | |
376 | 715680 | PREFZ(JL,2,1) = PALBP(JL,KNU) | |
377 | 715680 | PREFZ(JL,1,1) = PALBP(JL,KNU) | |
378 | 715680 | PTRA1(JL,KLEV+1) = 1.0_JPRB | |
379 | 716400 | PTRA2(JL,KLEV+1) = 1.0_JPRB | |
380 | ENDDO | ||
381 | |||
382 |
2/2✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
|
28800 | DO JK = 2 , KLEV+1 |
383 | 28080 | JKM1 = JK-1 | |
384 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27940320 | DO JL = KIDIA,KFDIA |
385 | |||
386 | ! ------------------------------------------------------------------ | ||
387 | |||
388 | !* 3.1 EQUIVALENT ZENITH ANGLE | ||
389 | ! ----------------------- | ||
390 | |||
391 | 27911520 | ZMUE = (1.0_JPRB-ZC0I(JL,JK)) * PSEC(JL)+ ZC0I(JL,JK) * 1.66_JPRB | |
392 | 27911520 | PRMU0(JL,JK) = 1.0_JPRB/ZMUE | |
393 | ZMU0=PRMU0(JL,JK) | ||
394 | |||
395 | ! ------------------------------------------------------------------ | ||
396 | |||
397 | !* 3.2 REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS | ||
398 | ! ---------------------------------------------------- | ||
399 | |||
400 | 27911520 | ZGAP = PCGAZ(JL,JKM1) | |
401 | 27911520 | ZBMU0 = 0.5_JPRB - 0.75_JPRB * ZGAP *ZMU0 | |
402 | 27911520 | ZWW = PPIZAZ(JL,JKM1) | |
403 | 27911520 | ZTO = PTAUAZ(JL,JKM1) | |
404 | ZDEN = 1.0_JPRB + (1.0_JPRB - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE & | ||
405 | 27911520 | & + (1-ZWW) * (1.0_JPRB - ZWW +2.0_JPRB*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE | |
406 | 27911520 | ZIDEN=1.0_JPRB / ZDEN | |
407 | 27911520 | PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE * ZIDEN | |
408 | 27911520 | PTRA1(JL,JKM1) = ZIDEN | |
409 | |||
410 | ZMU1 = 0.5_JPRB | ||
411 | ZIMU1=2.0_JPRB | ||
412 | ZI2MU1=4.0_JPRB | ||
413 | 27911520 | ZBMU1 = 0.5_JPRB - 0.75_JPRB * ZGAP * ZMU1 | |
414 | ZDEN1= 1.0_JPRB + (1.0_JPRB - ZWW + ZBMU1 * ZWW) * ZTO * ZIMU1 & | ||
415 | 27911520 | & + (1-ZWW) * (1.0_JPRB - ZWW +2.0_JPRB*ZBMU1*ZWW)*ZTO*ZTO*ZI2MU1 | |
416 | 27911520 | ZIDEN1=1.0_JPRB / ZDEN1 | |
417 | 27911520 | PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO * ZIMU1 *ZIDEN1 | |
418 | 27911520 | PTRA2(JL,JKM1) = ZIDEN1 | |
419 | |||
420 | 27911520 | ZRR=1.0_JPRB/(1.0_JPRB-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)) | |
421 | PREFZ(JL,1,JK) = PRAY1(JL,JKM1)& | ||
422 | & + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1)& | ||
423 | & * PTRA2(JL,JKM1)& | ||
424 | 27911520 | & *ZRR | |
425 | |||
426 | ZTR(JL,1,JKM1) = PTRA1(JL,JKM1)& | ||
427 | 27911520 | & *ZRR | |
428 | |||
429 | PREFZ(JL,2,JK) = PRAY1(JL,JKM1)& | ||
430 | & + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)& | ||
431 | 27911520 | & * PTRA2(JL,JKM1) | |
432 | |||
433 | 27939600 | ZTR(JL,2,JKM1) = PTRA1(JL,JKM1) | |
434 | |||
435 | ENDDO | ||
436 | ENDDO | ||
437 |
2/2✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
|
716400 | DO JL = KIDIA,KFDIA |
438 | 715680 | ZMUE = (1.0_JPRB-ZC0I(JL,1))*PSEC(JL)+ZC0I(JL,1)*1.66_JPRB | |
439 | 715680 | PRMU0(JL,1)=1.0_JPRB/ZMUE | |
440 | 716400 | PTRCLR(JL)=1.0_JPRB-ZC0I(JL,1) | |
441 | ENDDO | ||
442 | |||
443 | ! ------------------------------------------------------------------ | ||
444 | |||
445 | !* 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL | ||
446 | ! ------------------------------------------------- | ||
447 | |||
448 |
1/2✓ Branch 0 taken 720 times.
✗ Branch 1 not taken.
|
720 | IF (NSW <= 4) THEN |
449 | INU1=1 | ||
450 |
1/2✓ Branch 0 taken 720 times.
✗ Branch 1 not taken.
|
720 | ELSEIF (NSW == 6) THEN |
451 | INU1=3 | ||
452 | ENDIF | ||
453 | |||
454 |
2/2✓ Branch 0 taken 360 times.
✓ Branch 1 taken 360 times.
|
720 | IF (KNU <= INU1) THEN |
455 | JAJ = 2 | ||
456 |
2/2✓ Branch 0 taken 357840 times.
✓ Branch 1 taken 360 times.
|
358200 | DO JL = KIDIA,KFDIA |
457 | 357840 | PRJ(JL,JAJ,KLEV+1) = 1.0_JPRB | |
458 | 358200 | PRK(JL,JAJ,KLEV+1) = PREFZ(JL, 1,KLEV+1) | |
459 | ENDDO | ||
460 | |||
461 |
2/2✓ Branch 0 taken 14040 times.
✓ Branch 1 taken 360 times.
|
14400 | DO JK = 1 , KLEV |
462 | 14040 | JKL = KLEV+1 - JK | |
463 | 14040 | JKLP1 = JKL + 1 | |
464 |
2/2✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
|
13970160 | DO JL = KIDIA,KFDIA |
465 | 13955760 | ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL, 1,JKL) | |
466 | 13955760 | PRJ(JL,JAJ,JKL) = ZRE11 | |
467 | 13969800 | PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL, 1,JKL) | |
468 | ENDDO | ||
469 | ENDDO | ||
470 | |||
471 | ELSE | ||
472 | |||
473 |
2/2✓ Branch 0 taken 360 times.
✓ Branch 1 taken 720 times.
|
1080 | DO JAJ = 1 , 2 |
474 |
2/2✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
|
716400 | DO JL = KIDIA,KFDIA |
475 | 715680 | PRJ(JL,JAJ,KLEV+1) = 1.0_JPRB | |
476 | 716400 | PRK(JL,JAJ,KLEV+1) = PREFZ(JL,JAJ,KLEV+1) | |
477 | ENDDO | ||
478 | |||
479 |
2/2✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
|
29160 | DO JK = 1 , KLEV |
480 | 28080 | JKL = KLEV+1 - JK | |
481 | 28080 | JKLP1 = JKL + 1 | |
482 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27940320 | DO JL = KIDIA,KFDIA |
483 | 27911520 | ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL) | |
484 | 27911520 | PRJ(JL,JAJ,JKL) = ZRE11 | |
485 | 27939600 | PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,JAJ,JKL) | |
486 | ENDDO | ||
487 | ENDDO | ||
488 | ENDDO | ||
489 | |||
490 | ENDIF | ||
491 | |||
492 | ! ------------------------------------------------------------------ | ||
493 | |||
494 |
1/2✓ Branch 0 taken 720 times.
✗ Branch 1 not taken.
|
720 | IF (LHOOK) CALL DR_HOOK('SWCLR',1,ZHOOK_HANDLE) |
495 | 720 | END SUBROUTINE SWCLR | |
496 |