1 |
|
864 |
SUBROUTINE SWCLR & |
2 |
|
|
& ( KIDIA , KFDIA , KLON , KLEV , KAER , KNU,& |
3 |
|
432 |
& PAER , PALBP , PDSIG , PRAYL , PSEC,& |
4 |
|
432 |
& 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 |
|
864 |
REAL(KIND=JPRB) :: ZC0I(KLON,KLEV+1)& |
115 |
|
864 |
& , ZCLE0(KLON,KLEV), ZCLEAR(KLON) & |
116 |
|
864 |
& , ZR21(KLON)& |
117 |
|
864 |
& , ZR23(KLON) , ZSS0(KLON) , ZSCAT(KLON)& |
118 |
|
864 |
& , 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 |
|
864 |
REAL(KIND=JPRB) ::ZFACOA_NEW(KLON,KLEV) |
129 |
|
|
!--MODIFCODE |
130 |
|
|
|
131 |
|
|
|
132 |
|
|
! ------------------------------------------------------------------ |
133 |
|
|
|
134 |
|
|
!* 1. OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH |
135 |
|
|
! -------------------------------------------- |
136 |
|
|
|
137 |
✓✗ |
432 |
IF (LHOOK) CALL DR_HOOK('SWCLR',0,ZHOOK_HANDLE) |
138 |
✓✓ |
17712 |
DO JK = 1 , KLEV+1 |
139 |
✓✓ |
121392 |
DO JA = 1 , 6 |
140 |
✓✓ |
103178880 |
DO JL = KIDIA,KFDIA |
141 |
|
103057920 |
PRJ(JL,JA,JK) = 0.0_JPRB |
142 |
|
103161600 |
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 |
✓✓ |
17280 |
DO JK = 1 , KLEV |
150 |
|
16848 |
IKL=KLEV+1-JK |
151 |
✓✓ |
16763760 |
DO JL = KIDIA,KFDIA |
152 |
|
16746912 |
PCGAZ(JL,JK) = 0.0_JPRB |
153 |
|
16746912 |
PPIZAZ(JL,JK) = 0.0_JPRB |
154 |
|
16746912 |
PTAUAZ(JL,JK) = 0.0_JPRB |
155 |
|
16763760 |
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 |
✓✗ |
16848 |
IF(NOVLP < 5)THEN !ECMWF VERSION |
161 |
|
|
! DO JAE=1,6 |
162 |
✓✓ |
16763760 |
DO JL = KIDIA,KFDIA |
163 |
|
|
! PTAUAZ(JL,JK)=PTAUAZ(JL,JK)+PAER(JL,JAE,IKL)*RTAUA(KNU,JAE) |
164 |
|
16746912 |
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 |
|
16746912 |
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 |
|
16763760 |
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 |
✓✗ |
17280 |
IF (NOVLP < 5) then !ECMWF VERSION |
219 |
✓✓ |
16763760 |
DO JL = KIDIA,KFDIA |
220 |
✓✗ |
16763760 |
IF (KAER /= 0) THEN |
221 |
|
16746912 |
PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK) |
222 |
|
16746912 |
PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK) |
223 |
|
|
!!!! wrong ZRATIO = ZTRAY / (ZTRAY + PTAUAZ(JL,JK)) |
224 |
|
|
!-- |
225 |
|
|
ZGAR = PCGAZ(JL,JK) |
226 |
|
16746912 |
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 |
|
16746912 |
ZTRAY= PRAYL(JL) * PDSIG(JL,JK) |
231 |
|
|
! print *,'>>>>>>> swclr: ZTRAY ',ZTRAY |
232 |
|
16746912 |
ZDENB = ZTRAY + PTAUAZ(JL,JK)*(1.0_JPRB-PPIZAZ(JL,JK)*ZFF) |
233 |
|
16746912 |
ZRATIO=ZTRAY/ZDENB |
234 |
|
|
!-- |
235 |
|
16746912 |
PTAUAZ(JL,JK)=ZTRAY+PTAUAZ(JL,JK)*(1.0_JPRB-PPIZAZ(JL,JK)*ZFF) |
236 |
|
16746912 |
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 |
|
16746912 |
& / (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 |
✓✓ |
429840 |
DO JL = KIDIA,KFDIA |
285 |
|
429408 |
ZR23(JL) = 0.0_JPRB |
286 |
|
429408 |
ZC0I(JL,KLEV+1) = 0.0_JPRB |
287 |
|
429408 |
ZCLEAR(JL) = 1.0_JPRB |
288 |
|
429840 |
ZSCAT(JL) = 0.0_JPRB |
289 |
|
|
ENDDO |
290 |
|
|
|
291 |
|
|
JK = 1 |
292 |
|
|
JKL = KLEV+1 - JK |
293 |
|
|
JKLP1 = JKL + 1 |
294 |
✓✓ |
429840 |
DO JL = KIDIA,KFDIA |
295 |
|
|
!++MODIFCODE |
296 |
✗✓ |
429408 |
IF (NOVLP >= 5) THEN |
297 |
|
|
ZFACOA = PTAUAZ(JL,JK) |
298 |
|
|
ZCORAE = ZFACOA * PSEC(JL) |
299 |
|
|
ELSE |
300 |
|
429408 |
ZFACOA = 1.0_JPRB - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL) |
301 |
|
429408 |
ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL) |
302 |
|
|
ENDIF |
303 |
|
|
!--MODIFCODE |
304 |
|
429408 |
ZR21(JL) = EXP(-ZCORAE ) |
305 |
|
429408 |
ZSS0(JL) = 1.0_JPRB-ZR21(JL) |
306 |
|
429408 |
ZCLE0(JL,JKL) = ZSS0(JL) |
307 |
|
|
|
308 |
✓✗ |
429840 |
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 |
|
429408 |
& /(1.0_JPRB-MIN(ZSCAT(JL),1.0_JPRB-REPCLC)) |
313 |
|
429408 |
ZC0I(JL,JKL) = 1.0_JPRB - ZCLEAR(JL) |
314 |
|
429408 |
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 |
✓✓ |
16848 |
DO JK = 2 , KLEV |
330 |
|
16416 |
JKL = KLEV+1 - JK |
331 |
|
|
JKLP1 = JKL + 1 |
332 |
✓✓ |
16334352 |
DO JL = KIDIA,KFDIA |
333 |
|
|
!++MODIFCODE |
334 |
✗✓ |
16317504 |
IF (NOVLP >= 5) THEN |
335 |
|
|
ZFACOA = PTAUAZ(JL,JK) |
336 |
|
|
ZCORAE = ZFACOA * PSEC(JL) |
337 |
|
|
ELSE |
338 |
|
16317504 |
ZFACOA = 1.0_JPRB - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL) |
339 |
|
16317504 |
ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL) |
340 |
|
|
ENDIF |
341 |
|
|
!--MODIFCODE |
342 |
|
16317504 |
ZR21(JL) = EXP(-ZCORAE ) |
343 |
|
16317504 |
ZSS0(JL) = 1.0_JPRB-ZR21(JL) |
344 |
|
16317504 |
ZCLE0(JL,JKL) = ZSS0(JL) |
345 |
|
|
|
346 |
✓✗ |
16333920 |
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 |
|
16317504 |
& /(1.0_JPRB-MIN(ZSCAT(JL),1.0_JPRB-REPCLC)) |
351 |
|
16317504 |
ZC0I(JL,JKL) = 1.0_JPRB - ZCLEAR(JL) |
352 |
|
16317504 |
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 |
✓✓ |
429840 |
DO JL = KIDIA,KFDIA |
374 |
|
429408 |
PRAY1(JL,KLEV+1) = 0.0_JPRB |
375 |
|
429408 |
PRAY2(JL,KLEV+1) = 0.0_JPRB |
376 |
|
429408 |
PREFZ(JL,2,1) = PALBP(JL,KNU) |
377 |
|
429408 |
PREFZ(JL,1,1) = PALBP(JL,KNU) |
378 |
|
429408 |
PTRA1(JL,KLEV+1) = 1.0_JPRB |
379 |
|
429840 |
PTRA2(JL,KLEV+1) = 1.0_JPRB |
380 |
|
|
ENDDO |
381 |
|
|
|
382 |
✓✓ |
17280 |
DO JK = 2 , KLEV+1 |
383 |
|
16848 |
JKM1 = JK-1 |
384 |
✓✓ |
16764192 |
DO JL = KIDIA,KFDIA |
385 |
|
|
|
386 |
|
|
! ------------------------------------------------------------------ |
387 |
|
|
|
388 |
|
|
!* 3.1 EQUIVALENT ZENITH ANGLE |
389 |
|
|
! ----------------------- |
390 |
|
|
|
391 |
|
16746912 |
ZMUE = (1.0_JPRB-ZC0I(JL,JK)) * PSEC(JL)+ ZC0I(JL,JK) * 1.66_JPRB |
392 |
|
16746912 |
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 |
|
16746912 |
ZGAP = PCGAZ(JL,JKM1) |
401 |
|
16746912 |
ZBMU0 = 0.5_JPRB - 0.75_JPRB * ZGAP *ZMU0 |
402 |
|
16746912 |
ZWW = PPIZAZ(JL,JKM1) |
403 |
|
16746912 |
ZTO = PTAUAZ(JL,JKM1) |
404 |
|
|
ZDEN = 1.0_JPRB + (1.0_JPRB - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE & |
405 |
|
16746912 |
& + (1-ZWW) * (1.0_JPRB - ZWW +2.0_JPRB*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE |
406 |
|
16746912 |
ZIDEN=1.0_JPRB / ZDEN |
407 |
|
16746912 |
PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE * ZIDEN |
408 |
|
16746912 |
PTRA1(JL,JKM1) = ZIDEN |
409 |
|
|
|
410 |
|
|
ZMU1 = 0.5_JPRB |
411 |
|
|
ZIMU1=2.0_JPRB |
412 |
|
|
ZI2MU1=4.0_JPRB |
413 |
|
16746912 |
ZBMU1 = 0.5_JPRB - 0.75_JPRB * ZGAP * ZMU1 |
414 |
|
|
ZDEN1= 1.0_JPRB + (1.0_JPRB - ZWW + ZBMU1 * ZWW) * ZTO * ZIMU1 & |
415 |
|
16746912 |
& + (1-ZWW) * (1.0_JPRB - ZWW +2.0_JPRB*ZBMU1*ZWW)*ZTO*ZTO*ZI2MU1 |
416 |
|
16746912 |
ZIDEN1=1.0_JPRB / ZDEN1 |
417 |
|
16746912 |
PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO * ZIMU1 *ZIDEN1 |
418 |
|
16746912 |
PTRA2(JL,JKM1) = ZIDEN1 |
419 |
|
|
|
420 |
|
16746912 |
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 |
|
16746912 |
& *ZRR |
425 |
|
|
|
426 |
|
|
ZTR(JL,1,JKM1) = PTRA1(JL,JKM1)& |
427 |
|
16746912 |
& *ZRR |
428 |
|
|
|
429 |
|
|
PREFZ(JL,2,JK) = PRAY1(JL,JKM1)& |
430 |
|
|
& + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)& |
431 |
|
16746912 |
& * PTRA2(JL,JKM1) |
432 |
|
|
|
433 |
|
16763760 |
ZTR(JL,2,JKM1) = PTRA1(JL,JKM1) |
434 |
|
|
|
435 |
|
|
ENDDO |
436 |
|
|
ENDDO |
437 |
✓✓ |
429840 |
DO JL = KIDIA,KFDIA |
438 |
|
429408 |
ZMUE = (1.0_JPRB-ZC0I(JL,1))*PSEC(JL)+ZC0I(JL,1)*1.66_JPRB |
439 |
|
429408 |
PRMU0(JL,1)=1.0_JPRB/ZMUE |
440 |
|
429840 |
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 |
✓✗ |
432 |
IF (NSW <= 4) THEN |
449 |
|
|
INU1=1 |
450 |
✓✗ |
432 |
ELSEIF (NSW == 6) THEN |
451 |
|
|
INU1=3 |
452 |
|
|
ENDIF |
453 |
|
|
|
454 |
✓✓ |
432 |
IF (KNU <= INU1) THEN |
455 |
|
|
JAJ = 2 |
456 |
✓✓ |
214920 |
DO JL = KIDIA,KFDIA |
457 |
|
214704 |
PRJ(JL,JAJ,KLEV+1) = 1.0_JPRB |
458 |
|
214920 |
PRK(JL,JAJ,KLEV+1) = PREFZ(JL, 1,KLEV+1) |
459 |
|
|
ENDDO |
460 |
|
|
|
461 |
✓✓ |
8640 |
DO JK = 1 , KLEV |
462 |
|
8424 |
JKL = KLEV+1 - JK |
463 |
|
8424 |
JKLP1 = JKL + 1 |
464 |
✓✓ |
8382096 |
DO JL = KIDIA,KFDIA |
465 |
|
8373456 |
ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL, 1,JKL) |
466 |
|
8373456 |
PRJ(JL,JAJ,JKL) = ZRE11 |
467 |
|
8381880 |
PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL, 1,JKL) |
468 |
|
|
ENDDO |
469 |
|
|
ENDDO |
470 |
|
|
|
471 |
|
|
ELSE |
472 |
|
|
|
473 |
✓✓ |
648 |
DO JAJ = 1 , 2 |
474 |
✓✓ |
429840 |
DO JL = KIDIA,KFDIA |
475 |
|
429408 |
PRJ(JL,JAJ,KLEV+1) = 1.0_JPRB |
476 |
|
429840 |
PRK(JL,JAJ,KLEV+1) = PREFZ(JL,JAJ,KLEV+1) |
477 |
|
|
ENDDO |
478 |
|
|
|
479 |
✓✓ |
17496 |
DO JK = 1 , KLEV |
480 |
|
16848 |
JKL = KLEV+1 - JK |
481 |
|
16848 |
JKLP1 = JKL + 1 |
482 |
✓✓ |
16764192 |
DO JL = KIDIA,KFDIA |
483 |
|
16746912 |
ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL) |
484 |
|
16746912 |
PRJ(JL,JAJ,JKL) = ZRE11 |
485 |
|
16763760 |
PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,JAJ,JKL) |
486 |
|
|
ENDDO |
487 |
|
|
ENDDO |
488 |
|
|
ENDDO |
489 |
|
|
|
490 |
|
|
ENDIF |
491 |
|
|
|
492 |
|
|
! ------------------------------------------------------------------ |
493 |
|
|
|
494 |
✓✗ |
432 |
IF (LHOOK) CALL DR_HOOK('SWCLR',1,ZHOOK_HANDLE) |
495 |
|
432 |
END SUBROUTINE SWCLR |