Directory: | ./ |
---|---|
File: | rad/sw1s.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 81 | 135 | 60.0% |
Branches: | 24 | 46 | 52.2% |
Line | Branch | Exec | Source |
---|---|---|---|
1 | 720 | SUBROUTINE SW1S & | |
2 | & ( KIDIA , KFDIA , KLON , KLEV , KAER , KNU,& | ||
3 | 360 | & PAER , PALBD , PALBP, PCG , PCLD , PCLEAR,& | |
4 | 360 | & PDSIG , POMEGA, POZ , PRMU , PSEC , PTAU , PUD,& | |
5 | 360 | & PFD , PFU , PCD , PCU , PSUDU1,PDIFF , PDIRF, & | |
6 | !++MODIFCODE | ||
7 | & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST & | ||
8 | !--MODIFCODE | ||
9 | &) | ||
10 | |||
11 | !**** *SW1S* - SHORTWAVE RADIATION, FIRST SPECTRAL INTERVAL | ||
12 | |||
13 | ! PURPOSE. | ||
14 | ! -------- | ||
15 | |||
16 | ! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO | ||
17 | ! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980). | ||
18 | |||
19 | !** INTERFACE. | ||
20 | ! ---------- | ||
21 | |||
22 | ! *SW1S* IS CALLED FROM *SW*. | ||
23 | |||
24 | ! IMPLICIT ARGUMENTS : | ||
25 | ! -------------------- | ||
26 | |||
27 | ! ==== INPUTS === | ||
28 | ! ==== OUTPUTS === | ||
29 | |||
30 | ! METHOD. | ||
31 | ! ------- | ||
32 | |||
33 | ! 1. COMPUTES QUANTITIES FOR THE CLEAR-SKY FRACTION OF THE | ||
34 | ! COLUMN | ||
35 | ! 2. COMPUTES UPWARD AND DOWNWARD FLUXES CORRESPONDING TO | ||
36 | ! CONTINUUM SCATTERING | ||
37 | ! 3. MULTIPLY BY OZONE TRANSMISSION FUNCTION | ||
38 | |||
39 | ! EXTERNALS. | ||
40 | ! ---------- | ||
41 | |||
42 | ! *SWCLR*, *SWR*, *SWTT*, *SWUVO3* | ||
43 | |||
44 | ! REFERENCE. | ||
45 | ! ---------- | ||
46 | |||
47 | ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT | ||
48 | ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980) | ||
49 | |||
50 | ! AUTHOR. | ||
51 | ! ------- | ||
52 | ! JEAN-JACQUES MORCRETTE *ECMWF* | ||
53 | |||
54 | ! MODIFICATIONS. | ||
55 | ! -------------- | ||
56 | ! ORIGINAL : 89-07-14 | ||
57 | ! 94-11-15 J.-J. MORCRETTE DIRECT/DIFFUSE ALBEDO | ||
58 | ! 96-01-15 J.-J. MORCRETTE SW in nsw SPECTRAL INTERVALS | ||
59 | ! 990128 JJMorcrette sunshine duration | ||
60 | ! 99-05-25 JJMorcrette Revised aerosols | ||
61 | ! 00-12-18 JJMorcrette 6 spectral intervals | ||
62 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning | ||
63 | ! Y.Seity 04-11-19 : add two arguments for AROME externalized surface | ||
64 | ! Y.Seity 05-10-10 : add 3 optional arg. for dust SW properties | ||
65 | ! Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests | ||
66 | ! ------------------------------------------------------------------ | ||
67 | |||
68 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
69 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK | ||
70 | |||
71 | USE YOESW , ONLY : RRAY ,RSUN | ||
72 | !USE YOERAD , ONLY : NSW | ||
73 | ! NSW mis dans .def MPL 20140211 | ||
74 | USE write_field_phy | ||
75 | |||
76 | IMPLICIT NONE | ||
77 | |||
78 | include "clesphys.h" | ||
79 | |||
80 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
81 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
82 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
83 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
84 | INTEGER(KIND=JPIM),INTENT(IN) :: KAER | ||
85 | INTEGER(KIND=JPIM),INTENT(IN) :: KNU | ||
86 | REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) | ||
87 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,NSW) | ||
88 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW) | ||
89 | REAL(KIND=JPRB) ,INTENT(IN) :: PCG(KLON,NSW,KLEV) | ||
90 | REAL(KIND=JPRB) ,INTENT(IN) :: PCLD(KLON,KLEV) | ||
91 | REAL(KIND=JPRB) ,INTENT(IN) :: PCLEAR(KLON) | ||
92 | REAL(KIND=JPRB) ,INTENT(IN) :: PDSIG(KLON,KLEV) | ||
93 | REAL(KIND=JPRB) ,INTENT(IN) :: POMEGA(KLON,NSW,KLEV) | ||
94 | REAL(KIND=JPRB) ,INTENT(IN) :: POZ(KLON,KLEV) | ||
95 | REAL(KIND=JPRB) ,INTENT(IN) :: PRMU(KLON) | ||
96 | REAL(KIND=JPRB) ,INTENT(IN) :: PSEC(KLON) | ||
97 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAU(KLON,NSW,KLEV) | ||
98 | REAL(KIND=JPRB) ,INTENT(IN) :: PUD(KLON,5,KLEV+1) | ||
99 | !++MODIFCODE | ||
100 | LOGICAL ,INTENT(IN) :: LRDUST ! flag for DUST | ||
101 | REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV) | ||
102 | REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV) | ||
103 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV) | ||
104 | !--MODIFCODE | ||
105 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFD(KLON,KLEV+1) | ||
106 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFU(KLON,KLEV+1) | ||
107 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCD(KLON,KLEV+1) | ||
108 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCU(KLON,KLEV+1) | ||
109 | REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU1(KLON) | ||
110 | REAL(KIND=JPRB) ,INTENT(OUT) :: PDIFF(KLON,KLEV) | ||
111 | REAL(KIND=JPRB) ,INTENT(OUT) :: PDIRF(KLON,KLEV) | ||
112 | ! ------------------------------------------------------------------ | ||
113 | |||
114 | !* 0.1 ARGUMENTS | ||
115 | ! --------- | ||
116 | |||
117 | ! ------------------------------------------------------------------ | ||
118 | |||
119 | ! ------------ | ||
120 | |||
121 | INTEGER(KIND=JPIM) :: IIND(6) | ||
122 | |||
123 | 720 | REAL(KIND=JPRB) :: ZCGAZ(KLON,KLEV)& | |
124 | 720 | & , ZDIFF(KLON) , ZDIRF(KLON) & | |
125 | 720 | & , ZDIFT(KLON) , ZDIRT(KLON) & | |
126 | 720 | & , ZPIZAZ(KLON,KLEV)& | |
127 | 720 | & , ZRAYL(KLON), ZRAY1(KLON,KLEV+1), ZRAY2(KLON,KLEV+1)& | |
128 | 720 | & , ZREFZ(KLON,2,KLEV+1)& | |
129 | 720 | & , ZRJ(KLON,6,KLEV+1), ZRJ0(KLON,6,KLEV+1)& | |
130 | 720 | & , ZRK(KLON,6,KLEV+1), ZRK0(KLON,6,KLEV+1)& | |
131 | 720 | & , ZRMUE(KLON,KLEV+1), ZRMU0(KLON,KLEV+1)& | |
132 | 720 | & , ZR(KLON,6)& | |
133 | 720 | & , ZTAUAZ(KLON,KLEV)& | |
134 | 720 | & , ZTRA1(KLON,KLEV+1), ZTRA2(KLON,KLEV+1)& | |
135 | 720 | & , ZTRCLD(KLON) , ZTRCLR(KLON)& | |
136 | 720 | & , ZW(KLON,6) , ZO(KLON,2) ,ZT(KLON,2) | |
137 | |||
138 | INTEGER(KIND=JPIM) :: IKL, IKM1, JAJ, JK, JL , JJ | ||
139 | REAL(KIND=JPRB) :: ZHOOK_HANDLE | ||
140 | LOGICAL :: LLDEBUG | ||
141 | |||
142 | INTERFACE | ||
143 | SUBROUTINE SWCLR& | ||
144 | & ( KIDIA , KFDIA , KLON , KLEV , KAER , KNU,& | ||
145 | & PAER , PALBP , PDSIG , PRAYL , PSEC,& | ||
146 | & PCGAZ , PPIZAZ, PRAY1 , PRAY2 , PREFZ , PRJ,& | ||
147 | & PRK , PRMU0 , PTAUAZ, PTRA1 , PTRA2 , PTRCLR,& | ||
148 | & LRDUST,PPIZA_DST, PCGA_DST, PTAUREL_DST ) | ||
149 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
150 | USE YOERAD , ONLY : NOVLP | ||
151 | include "clesphys.h" | ||
152 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
153 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
154 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
155 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
156 | INTEGER(KIND=JPIM),INTENT(IN) :: KAER | ||
157 | INTEGER(KIND=JPIM),INTENT(IN) :: KNU | ||
158 | REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) | ||
159 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW) | ||
160 | REAL(KIND=JPRB) ,INTENT(IN) :: PDSIG(KLON,KLEV) | ||
161 | REAL(KIND=JPRB) ,INTENT(IN) :: PRAYL(KLON) | ||
162 | REAL(KIND=JPRB) ,INTENT(IN) :: PSEC(KLON) | ||
163 | LOGICAL ,INTENT(IN) :: LRDUST | ||
164 | REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV) | ||
165 | REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV) | ||
166 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV) | ||
167 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCGAZ(KLON,KLEV) | ||
168 | REAL(KIND=JPRB) ,INTENT(OUT) :: PPIZAZ(KLON,KLEV) | ||
169 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY1(KLON,KLEV+1) | ||
170 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY2(KLON,KLEV+1) | ||
171 | REAL(KIND=JPRB) ,INTENT(OUT) :: PREFZ(KLON,2,KLEV+1) | ||
172 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRJ(KLON,6,KLEV+1) | ||
173 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRK(KLON,6,KLEV+1) | ||
174 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRMU0(KLON,KLEV+1) | ||
175 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTAUAZ(KLON,KLEV) | ||
176 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA1(KLON,KLEV+1) | ||
177 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA2(KLON,KLEV+1) | ||
178 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRCLR(KLON) | ||
179 | END SUBROUTINE SWCLR | ||
180 | END INTERFACE | ||
181 | INTERFACE | ||
182 | SUBROUTINE SWR& | ||
183 | & ( KIDIA , KFDIA , KLON , KLEV , KNU,& | ||
184 | & PALBD , PCG , PCLD , POMEGA, PSEC , PTAU,& | ||
185 | & PCGAZ , PPIZAZ, PRAY1, PRAY2 , PREFZ, PRJ , PRK , PRMUE,& | ||
186 | & PTAUAZ, PTRA1 , PTRA2, PTRCLD& | ||
187 | & ) | ||
188 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
189 | USE YOERAD , ONLY : NOVLP | ||
190 | include "clesphys.h" | ||
191 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
192 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
193 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
194 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
195 | INTEGER(KIND=JPIM),INTENT(IN) :: KNU | ||
196 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,NSW) | ||
197 | REAL(KIND=JPRB) ,INTENT(IN) :: PCG(KLON,NSW,KLEV) | ||
198 | REAL(KIND=JPRB) ,INTENT(IN) :: PCLD(KLON,KLEV) | ||
199 | REAL(KIND=JPRB) ,INTENT(IN) :: POMEGA(KLON,NSW,KLEV) | ||
200 | REAL(KIND=JPRB) ,INTENT(IN) :: PSEC(KLON) | ||
201 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAU(KLON,NSW,KLEV) | ||
202 | REAL(KIND=JPRB) ,INTENT(IN) :: PCGAZ(KLON,KLEV) | ||
203 | REAL(KIND=JPRB) ,INTENT(IN) :: PPIZAZ(KLON,KLEV) | ||
204 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY1(KLON,KLEV+1) | ||
205 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY2(KLON,KLEV+1) | ||
206 | REAL(KIND=JPRB) ,INTENT(OUT) :: PREFZ(KLON,2,KLEV+1) | ||
207 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRJ(KLON,6,KLEV+1) | ||
208 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRK(KLON,6,KLEV+1) | ||
209 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRMUE(KLON,KLEV+1) | ||
210 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAUAZ(KLON,KLEV) | ||
211 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA1(KLON,KLEV+1) | ||
212 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA2(KLON,KLEV+1) | ||
213 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRCLD(KLON) | ||
214 | END SUBROUTINE SWR | ||
215 | END INTERFACE | ||
216 | INTERFACE | ||
217 | SUBROUTINE SWTT1 ( KIDIA,KFDIA,KLON,KNU,KABS,KIND, PU, PTR ) | ||
218 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
219 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
220 | INTEGER(KIND=JPIM),INTENT(IN) :: KABS | ||
221 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
222 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
223 | INTEGER(KIND=JPIM),INTENT(IN) :: KNU | ||
224 | INTEGER(KIND=JPIM),INTENT(IN) :: KIND(KABS) | ||
225 | REAL(KIND=JPRB) ,INTENT(IN) :: PU(KLON,KABS) | ||
226 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTR(KLON,KABS) | ||
227 | END SUBROUTINE SWTT1 | ||
228 | END INTERFACE | ||
229 | INTERFACE | ||
230 | SUBROUTINE SWUVO3& | ||
231 | & ( KIDIA,KFDIA,KLON,KNU,KABS,& | ||
232 | & PU, PTR& | ||
233 | & ) | ||
234 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
235 | USE YOMJFH , ONLY : N_VMASS | ||
236 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
237 | INTEGER(KIND=JPIM),INTENT(IN) :: KABS | ||
238 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
239 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
240 | INTEGER(KIND=JPIM),INTENT(IN) :: KNU | ||
241 | REAL(KIND=JPRB) ,INTENT(IN) :: PU(KLON,KABS) | ||
242 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTR(KLON,KABS) | ||
243 | END SUBROUTINE SWUVO3 | ||
244 | END INTERFACE | ||
245 | |||
246 | ! ------------------------------------------------------------------ | ||
247 | |||
248 | !* 1. FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON) | ||
249 | ! ----------------------- ------------------ | ||
250 | |||
251 | !* 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING | ||
252 | ! ----------------------------------------- | ||
253 | |||
254 |
1/2✓ Branch 0 taken 360 times.
✗ Branch 1 not taken.
|
360 | IF (LHOOK) CALL DR_HOOK('SW1S',0,ZHOOK_HANDLE) |
255 | LLDEBUG=.FALSE. | ||
256 |
2/2✓ Branch 0 taken 357840 times.
✓ Branch 1 taken 360 times.
|
358200 | DO JL = KIDIA,KFDIA |
257 | ZRAYL(JL) = RRAY(KNU,1) + PRMU(JL) * (RRAY(KNU,2) + PRMU(JL)& | ||
258 | & * (RRAY(KNU,3) + PRMU(JL) * (RRAY(KNU,4) + PRMU(JL)& | ||
259 | 358200 | & * (RRAY(KNU,5) + PRMU(JL) * RRAY(KNU,6) )))) | |
260 | ENDDO | ||
261 | ! ------------------------------------------------------------------ | ||
262 | |||
263 | !* 2. CONTINUUM SCATTERING CALCULATIONS | ||
264 | ! --------------------------------- | ||
265 | |||
266 | !* 2.1 CLEAR-SKY FRACTION OF THE COLUMN | ||
267 | ! -------------------------------- | ||
268 | |||
269 | !++MODIFCODE | ||
270 | CALL SWCLR & | ||
271 | &( KIDIA , KFDIA , KLON , KLEV , KAER , KNU & | ||
272 | &, PAER , PALBP , PDSIG , ZRAYL, PSEC & | ||
273 | &, ZCGAZ , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0 & | ||
274 | &, ZRK0 , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2, ZTRCLR & | ||
275 | &, LRDUST , PPIZA_DST,PCGA_DST & | ||
276 | 360 | &, PTAUREL_DST ) | |
277 | |||
278 | !--MODIFCODE | ||
279 | |||
280 | !* 2.2 CLOUDY FRACTION OF THE COLUMN | ||
281 | ! ----------------------------- | ||
282 | |||
283 | CALL SWR & | ||
284 | & ( KIDIA ,KFDIA ,KLON ,KLEV , KNU,& | ||
285 | & PALBD ,PCG ,PCLD ,POMEGA, PSEC , PTAU,& | ||
286 | & ZCGAZ ,ZPIZAZ,ZRAY1 ,ZRAY2 , ZREFZ, ZRJ ,ZRK , ZRMUE,& | ||
287 | & ZTAUAZ,ZTRA1 ,ZTRA2 ,ZTRCLD & | ||
288 | 360 | & ) | |
289 | |||
290 | ! DO JK = 1 , KLEV | ||
291 | ! IKL = KLEV+1-JK | ||
292 | ! DO JL = KIDIA,KFDIA | ||
293 | ! print *,'Apres SWCLR,SWR RMU0 RMUE ',ZRMU0(JL,IKL),ZRMUE(JL,IKL) | ||
294 | ! ENDDO | ||
295 | ! ENDDO | ||
296 | ! ------------------------------------------------------------------ | ||
297 | |||
298 | !* 3. OZONE ABSORPTION | ||
299 | ! ---------------- | ||
300 | |||
301 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 360 times.
|
360 | IF (NSW <= 4) THEN |
302 | |||
303 | !* 3.1 TWO OR FOUR SPECTRAL INTERVALS | ||
304 | ! ------------------------------ | ||
305 | |||
306 | ✗ | IIND(1)=1 | |
307 | ✗ | IIND(2)=2 | |
308 | ✗ | IIND(3)=3 | |
309 | ✗ | IIND(4)=1 | |
310 | ✗ | IIND(5)=2 | |
311 | ✗ | IIND(6)=3 | |
312 | |||
313 | !* 3.1.1 DOWNWARD FLUXES | ||
314 | ! --------------- | ||
315 | |||
316 | JAJ = 2 | ||
317 | |||
318 | ✗ | DO JL = KIDIA,KFDIA | |
319 | ✗ | ZW(JL,1)=0.0_JPRB | |
320 | ✗ | ZW(JL,2)=0.0_JPRB | |
321 | ✗ | ZW(JL,3)=0.0_JPRB | |
322 | ✗ | ZW(JL,4)=0.0_JPRB | |
323 | ✗ | ZW(JL,5)=0.0_JPRB | |
324 | ✗ | ZW(JL,6)=0.0_JPRB | |
325 | PFD(JL,KLEV+1)=((1.0_JPRB-PCLEAR(JL))*ZRJ(JL,JAJ,KLEV+1)& | ||
326 | ✗ | & + PCLEAR(JL) *ZRJ0(JL,JAJ,KLEV+1)) * RSUN(KNU) | |
327 | ✗ | PCD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1) * RSUN(KNU) | |
328 | ENDDO | ||
329 | ✗ | DO JK = 1 , KLEV | |
330 | ✗ | IKL = KLEV+1-JK | |
331 | ✗ | DO JL = KIDIA,KFDIA | |
332 | ✗ | ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL) | |
333 | ✗ | ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKL)/ZRMUE(JL,IKL) | |
334 | ✗ | ZW(JL,3)=ZW(JL,3)+POZ(JL, IKL)/ZRMUE(JL,IKL) | |
335 | ✗ | ZW(JL,4)=ZW(JL,4)+PUD(JL,1,IKL)/ZRMU0(JL,IKL) | |
336 | ✗ | ZW(JL,5)=ZW(JL,5)+PUD(JL,2,IKL)/ZRMU0(JL,IKL) | |
337 | ✗ | ZW(JL,6)=ZW(JL,6)+POZ(JL, IKL)/ZRMU0(JL,IKL) | |
338 | ENDDO | ||
339 | |||
340 | CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 6,& | ||
341 | & IIND,& | ||
342 | & ZW,& | ||
343 | ✗ | & ZR ) | |
344 | |||
345 | ✗ | DO JL = KIDIA,KFDIA | |
346 | ✗ | ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZR(JL,3)*ZRJ(JL,JAJ,IKL) | |
347 | ✗ | ZDIRF(JL) = ZR(JL,4)*ZR(JL,5)*ZR(JL,6)*ZRJ0(JL,JAJ,IKL) | |
348 | ✗ | PDIFF(JL,IKL) = ZDIFF(JL) * RSUN(KNU)*(1.0_JPRB-PCLEAR(JL)) | |
349 | ✗ | PDIRF(JL,IKL) = ZDIRF(JL) * RSUN(KNU)*PCLEAR(JL) | |
350 | PFD(JL,IKL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)& | ||
351 | ✗ | & +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU) | |
352 | ✗ | PCD(JL,IKL) = ZDIRF(JL) * RSUN(KNU) | |
353 | ENDDO | ||
354 | ENDDO | ||
355 | |||
356 | ✗ | DO JL=KIDIA,KFDIA | |
357 | ✗ | ZDIFT(JL) = ZR(JL,1)*ZR(JL,2)*ZR(JL,3)*ZTRCLD(JL) | |
358 | ✗ | ZDIRT(JL) = ZR(JL,4)*ZR(JL,5)*ZR(JL,6)*ZTRCLR(JL) | |
359 | PSUDU1(JL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFT(JL)& | ||
360 | ✗ | & +PCLEAR(JL) * ZDIRT(JL)) * RSUN(KNU) | |
361 | ENDDO | ||
362 | |||
363 | !* 3.1.2 UPWARD FLUXES | ||
364 | ! ------------- | ||
365 | |||
366 | ✗ | DO JL = KIDIA,KFDIA | |
367 | PFU(JL,1) = ((1.0_JPRB-PCLEAR(JL))*ZDIFF(JL)*PALBD(JL,KNU)& | ||
368 | & + PCLEAR(JL) *ZDIRF(JL)*PALBP(JL,KNU))& | ||
369 | ✗ | & * RSUN(KNU) | |
370 | ✗ | PCU(JL,1) = ZDIRF(JL) * PALBP(JL,KNU) * RSUN(KNU) | |
371 | ENDDO | ||
372 | |||
373 | ✗ | DO JK = 2 , KLEV+1 | |
374 | ✗ | IKM1=JK-1 | |
375 | ✗ | DO JL = KIDIA,KFDIA | |
376 | ✗ | ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKM1)*1.66_JPRB | |
377 | ✗ | ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKM1)*1.66_JPRB | |
378 | ✗ | ZW(JL,3)=ZW(JL,3)+POZ(JL, IKM1)*1.66_JPRB | |
379 | ✗ | ZW(JL,4)=ZW(JL,4)+PUD(JL,1,IKM1)*1.66_JPRB | |
380 | ✗ | ZW(JL,5)=ZW(JL,5)+PUD(JL,2,IKM1)*1.66_JPRB | |
381 | ✗ | ZW(JL,6)=ZW(JL,6)+POZ(JL, IKM1)*1.66_JPRB | |
382 | ENDDO | ||
383 | |||
384 | CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 6,& | ||
385 | & IIND,& | ||
386 | & ZW,& | ||
387 | ✗ | & ZR ) | |
388 | |||
389 | ✗ | DO JL = KIDIA,KFDIA | |
390 | ✗ | ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZR(JL,3)*ZRK(JL,JAJ,JK) | |
391 | ✗ | ZDIRF(JL) = ZR(JL,4)*ZR(JL,5)*ZR(JL,6)*ZRK0(JL,JAJ,JK) | |
392 | PFU(JL,JK) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)& | ||
393 | ✗ | & +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU) | |
394 | ✗ | PCU(JL,JK) = ZDIRF(JL) * RSUN(KNU) | |
395 | ENDDO | ||
396 | !WRITE(*,'("---> Dans SW1S:")') | ||
397 | !WRITE(*,'("PFU",10E12.5)') (PFU(1,JJ),JJ=1,KLEV+1) | ||
398 | !WRITE(*,'("PCLEAR",10E12.5)') (PCLEAR(1)) | ||
399 | !WRITE(*,'("ZDIFF",10E12.5)') (ZDIFF(1)) | ||
400 | !WRITE(*,'("ZDIRF",10E12.5)') (ZDIRF(1)) | ||
401 | !WRITE(*,'("RSUN",10E12.5)') (RSUN(KNU)) | ||
402 | ENDDO | ||
403 | |||
404 |
1/2✓ Branch 0 taken 360 times.
✗ Branch 1 not taken.
|
360 | ELSEIF (NSW == 6) THEN |
405 | !print *,'... dans SW1S: NSW=',NSW | ||
406 | |||
407 | !* 3.2 SIX SPECTRAL INTERVALS | ||
408 | ! ---------------------- | ||
409 | |||
410 | 360 | IIND(1)=1 | |
411 | 360 | IIND(2)=2 | |
412 | 360 | IIND(3)=1 | |
413 | 360 | IIND(4)=2 | |
414 | |||
415 | !* 3.2,1 DOWNWARD FLUXES | ||
416 | ! --------------- | ||
417 | |||
418 | JAJ = 2 | ||
419 | |||
420 |
2/2✓ Branch 0 taken 360 times.
✓ Branch 1 taken 357840 times.
|
358200 | DO JL = KIDIA,KFDIA |
421 | 357840 | ZW(JL,1)=0.0_JPRB | |
422 | 357840 | ZW(JL,2)=0.0_JPRB | |
423 | 357840 | ZW(JL,3)=0.0_JPRB | |
424 | 357840 | ZW(JL,4)=0.0_JPRB | |
425 | |||
426 | 357840 | ZO(JL,1)=0.0_JPRB | |
427 | 357840 | ZO(JL,2)=0.0_JPRB | |
428 | PFD(JL,KLEV+1)=((1.0_JPRB-PCLEAR(JL))*ZRJ(JL,JAJ,KLEV+1)& | ||
429 | 357840 | & + PCLEAR(JL) *ZRJ0(JL,JAJ,KLEV+1)) * RSUN(KNU) | |
430 | 358200 | PCD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1) * RSUN(KNU) | |
431 | ENDDO | ||
432 |
2/2✓ Branch 0 taken 360 times.
✓ Branch 1 taken 14040 times.
|
14400 | DO JK = 1 , KLEV |
433 | 14040 | IKL = KLEV+1-JK | |
434 |
2/2✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
|
13969800 | DO JL = KIDIA,KFDIA |
435 | 13955760 | ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL) | |
436 | 13955760 | ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKL)/ZRMUE(JL,IKL) | |
437 | 13955760 | ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKL)/ZRMU0(JL,IKL) | |
438 | 13955760 | ZW(JL,4)=ZW(JL,4)+PUD(JL,2,IKL)/ZRMU0(JL,IKL) | |
439 | |||
440 | 13955760 | ZO(JL,1)=ZO(JL,1)+POZ(JL, IKL)/ZRMUE(JL,IKL) | |
441 | 13969800 | ZO(JL,2)=ZO(JL,2)+POZ(JL, IKL)/ZRMU0(JL,IKL) | |
442 | ENDDO | ||
443 | |||
444 | ! WRITE(*,'("---> Dans SW1S avant SWTT1:")') | ||
445 | CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 4,& | ||
446 | & IIND,& | ||
447 | & ZW,& | ||
448 | & ZR & | ||
449 | 14040 | & ) | |
450 | |||
451 | ! WRITE(*,'("---> Dans SW1S avant SWUVO3 flux dwn:")') | ||
452 | CALL SWUVO3 ( KIDIA, KFDIA, KLON, KNU, 2,& | ||
453 | & ZO,& | ||
454 | & ZT & | ||
455 | 14040 | & ) | |
456 | |||
457 |
2/2✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
|
13970160 | DO JL = KIDIA,KFDIA |
458 | 13955760 | ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZT(JL,1)*ZRJ(JL,JAJ,IKL) | |
459 | 13955760 | ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZT(JL,2)*ZRJ0(JL,JAJ,IKL) | |
460 | 13955760 | PDIFF(JL,IKL) = ZDIFF(JL) * RSUN(KNU)*(1.0_JPRB-PCLEAR(JL)) | |
461 | 13955760 | PDIRF(JL,IKL) = ZDIRF(JL) * RSUN(KNU)*PCLEAR(JL) | |
462 | PFD(JL,IKL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)& | ||
463 | 13955760 | & +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU) | |
464 | 13969800 | PCD(JL,IKL) = ZDIRF(JL) * RSUN(KNU) | |
465 | ENDDO | ||
466 | ENDDO | ||
467 | |||
468 | IF(LLDEBUG) THEN | ||
469 | call writefield_phy('sw1s_pud1',PUD(:,1,:),klev) | ||
470 | call writefield_phy('sw1s_pud2',PUD(:,2,:),klev) | ||
471 | call writefield_phy('sw1s_psec',PSEC,1) | ||
472 | call writefield_phy('sw1s_zrmue',ZRMUE,klev+1) | ||
473 | call writefield_phy('sw1s_zrmu0',ZRMU0,klev+1) | ||
474 | call writefield_phy('sw1s_pdirf',PDIRF,klev) | ||
475 | call writefield_phy('sw1s_pdiff',PDIFF,klev) | ||
476 | call writefield_phy('sw1s_pfd',PFD,klev) | ||
477 | ENDIF | ||
478 |
2/2✓ Branch 0 taken 360 times.
✓ Branch 1 taken 357840 times.
|
358200 | DO JL=KIDIA,KFDIA |
479 | 357840 | ZDIFT(JL) = ZR(JL,1)*ZR(JL,2)*ZT(JL,1)*ZTRCLD(JL) | |
480 | 357840 | ZDIRT(JL) = ZR(JL,3)*ZR(JL,4)*ZT(JL,2)*ZTRCLR(JL) | |
481 | PSUDU1(JL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFT(JL)& | ||
482 | 358200 | & +PCLEAR(JL) * ZDIRT(JL)) * RSUN(KNU) | |
483 | ENDDO | ||
484 | |||
485 | !* 3.2.2 UPWARD FLUXES | ||
486 | ! ------------- | ||
487 | |||
488 |
2/2✓ Branch 0 taken 360 times.
✓ Branch 1 taken 357840 times.
|
358200 | DO JL = KIDIA,KFDIA |
489 | PFU(JL,1) = ((1.0_JPRB-PCLEAR(JL))*ZDIFF(JL)*PALBD(JL,KNU)& | ||
490 | & + PCLEAR(JL) *ZDIRF(JL)*PALBP(JL,KNU))& | ||
491 | 357840 | & * RSUN(KNU) | |
492 | 358200 | PCU(JL,1) = ZDIRF(JL) * PALBP(JL,KNU) * RSUN(KNU) | |
493 | ENDDO | ||
494 | |||
495 |
2/2✓ Branch 0 taken 360 times.
✓ Branch 1 taken 14040 times.
|
14400 | DO JK = 2 , KLEV+1 |
496 | 14040 | IKM1=JK-1 | |
497 |
2/2✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
|
13969800 | DO JL = KIDIA,KFDIA |
498 | 13955760 | ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKM1)*1.66_JPRB | |
499 | 13955760 | ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKM1)*1.66_JPRB | |
500 | 13955760 | ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKM1)*1.66_JPRB | |
501 | 13955760 | ZW(JL,4)=ZW(JL,4)+PUD(JL,2,IKM1)*1.66_JPRB | |
502 | |||
503 | 13955760 | ZO(JL,1)=ZO(JL,1)+POZ(JL, IKM1)*1.66_JPRB | |
504 | 13969800 | ZO(JL,2)=ZO(JL,2)+POZ(JL, IKM1)*1.66_JPRB | |
505 | ENDDO | ||
506 | |||
507 | ! WRITE(*,'("---> Dans SW1S avant SWTT1:")') | ||
508 | CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 4,& | ||
509 | & IIND,& | ||
510 | & ZW,& | ||
511 | & ZR & | ||
512 | 14040 | & ) | |
513 | |||
514 | ! WRITE(*,'("---> Dans SW1S avant SWUVO3 flux up:")') | ||
515 | CALL SWUVO3 ( KIDIA, KFDIA, KLON, KNU, 2,& | ||
516 | & ZO,& | ||
517 | & ZT & | ||
518 | 14040 | & ) | |
519 | |||
520 |
2/2✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
|
13970160 | DO JL = KIDIA,KFDIA |
521 | 13955760 | ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZT(JL,1)*ZRK(JL,JAJ,JK) | |
522 | 13955760 | ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZT(JL,2)*ZRK0(JL,JAJ,JK) | |
523 | PFU(JL,JK) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)& | ||
524 | 13955760 | & +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU) | |
525 | 13969800 | PCU(JL,JK) = ZDIRF(JL) * RSUN(KNU) | |
526 | !WRITE(*,'("---> Dans SW1S:")') | ||
527 | !print *,'===JL= ',jl | ||
528 | !WRITE(*,'("ZR1",10E12.5)') (ZR(JL,1)) | ||
529 | !WRITE(*,'("ZR2",10E12.5)') (ZR(JL,2)) | ||
530 | !WRITE(*,'("ZR3",10E12.5)') (ZR(JL,3)) | ||
531 | !WRITE(*,'("ZR4",10E12.5)') (ZR(JL,4)) | ||
532 | !WRITE(*,'("ZT1",10E12.5)') (ZT(JL,1)) | ||
533 | !WRITE(*,'("ZT2",10E12.5)') (ZT(JL,2)) | ||
534 | ENDDO | ||
535 | ENDDO | ||
536 | |||
537 | !WRITE(*,'("---> Dans SW1S:")') | ||
538 | !WRITE(*,'("PFU",10E12.5)') (PFU(1,JJ),JJ=1,KLEV+1) | ||
539 | !WRITE(*,'("ZR",10E12.5)') (ZR(1,JJ),JJ=1,4) | ||
540 | !WRITE(*,'("PCLEAR",10E12.5)') (PCLEAR(1)) | ||
541 | !WRITE(*,'("ZDIFF",10E12.5)') (ZDIFF(1)) | ||
542 | !WRITE(*,'("ZDIRF",10E12.5)') (ZDIRF(1)) | ||
543 | !WRITE(*,'("RSUN",10E12.5)') (RSUN(KNU)) | ||
544 | ENDIF | ||
545 | |||
546 | ! ------------------------------------------------------------------ | ||
547 | |||
548 |
1/2✓ Branch 0 taken 360 times.
✗ Branch 1 not taken.
|
360 | IF (LHOOK) CALL DR_HOOK('SW1S',1,ZHOOK_HANDLE) |
549 | 360 | END SUBROUTINE SW1S | |
550 |