1 |
|
432 |
SUBROUTINE SW1S & |
2 |
|
|
& ( KIDIA , KFDIA , KLON , KLEV , KAER , KNU,& |
3 |
|
216 |
& PAER , PALBD , PALBP, PCG , PCLD , PCLEAR,& |
4 |
|
216 |
& PDSIG , POMEGA, POZ , PRMU , PSEC , PTAU , PUD,& |
5 |
|
216 |
& 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 |
|
432 |
REAL(KIND=JPRB) :: ZCGAZ(KLON,KLEV)& |
124 |
|
432 |
& , ZDIFF(KLON) , ZDIRF(KLON) & |
125 |
|
432 |
& , ZDIFT(KLON) , ZDIRT(KLON) & |
126 |
|
432 |
& , ZPIZAZ(KLON,KLEV)& |
127 |
|
432 |
& , ZRAYL(KLON), ZRAY1(KLON,KLEV+1), ZRAY2(KLON,KLEV+1)& |
128 |
|
432 |
& , ZREFZ(KLON,2,KLEV+1)& |
129 |
|
432 |
& , ZRJ(KLON,6,KLEV+1), ZRJ0(KLON,6,KLEV+1)& |
130 |
|
432 |
& , ZRK(KLON,6,KLEV+1), ZRK0(KLON,6,KLEV+1)& |
131 |
|
432 |
& , ZRMUE(KLON,KLEV+1), ZRMU0(KLON,KLEV+1)& |
132 |
|
432 |
& , ZR(KLON,6)& |
133 |
|
432 |
& , ZTAUAZ(KLON,KLEV)& |
134 |
|
432 |
& , ZTRA1(KLON,KLEV+1), ZTRA2(KLON,KLEV+1)& |
135 |
|
432 |
& , ZTRCLD(KLON) , ZTRCLR(KLON)& |
136 |
|
432 |
& , 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 |
|
|
#include "swclr.intfb.h" |
143 |
|
|
#include "swr.intfb.h" |
144 |
|
|
#include "swtt1.intfb.h" |
145 |
|
|
#include "swuvo3.intfb.h" |
146 |
|
|
|
147 |
|
|
! ------------------------------------------------------------------ |
148 |
|
|
|
149 |
|
|
!* 1. FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON) |
150 |
|
|
! ----------------------- ------------------ |
151 |
|
|
|
152 |
|
|
!* 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING |
153 |
|
|
! ----------------------------------------- |
154 |
|
|
|
155 |
✓✗ |
216 |
IF (LHOOK) CALL DR_HOOK('SW1S',0,ZHOOK_HANDLE) |
156 |
|
|
LLDEBUG=.FALSE. |
157 |
✓✓ |
214920 |
DO JL = KIDIA,KFDIA |
158 |
|
|
ZRAYL(JL) = RRAY(KNU,1) + PRMU(JL) * (RRAY(KNU,2) + PRMU(JL)& |
159 |
|
|
& * (RRAY(KNU,3) + PRMU(JL) * (RRAY(KNU,4) + PRMU(JL)& |
160 |
|
214920 |
& * (RRAY(KNU,5) + PRMU(JL) * RRAY(KNU,6) )))) |
161 |
|
|
ENDDO |
162 |
|
|
! ------------------------------------------------------------------ |
163 |
|
|
|
164 |
|
|
!* 2. CONTINUUM SCATTERING CALCULATIONS |
165 |
|
|
! --------------------------------- |
166 |
|
|
|
167 |
|
|
!* 2.1 CLEAR-SKY FRACTION OF THE COLUMN |
168 |
|
|
! -------------------------------- |
169 |
|
|
|
170 |
|
|
!++MODIFCODE |
171 |
|
|
CALL SWCLR & |
172 |
|
|
&( KIDIA , KFDIA , KLON , KLEV , KAER , KNU & |
173 |
|
|
&, PAER , PALBP , PDSIG , ZRAYL, PSEC & |
174 |
|
|
&, ZCGAZ , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0 & |
175 |
|
|
&, ZRK0 , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2, ZTRCLR & |
176 |
|
|
&, LRDUST , PPIZA_DST,PCGA_DST & |
177 |
|
216 |
&, PTAUREL_DST ) |
178 |
|
|
|
179 |
|
|
!--MODIFCODE |
180 |
|
|
|
181 |
|
|
!* 2.2 CLOUDY FRACTION OF THE COLUMN |
182 |
|
|
! ----------------------------- |
183 |
|
|
|
184 |
|
|
CALL SWR & |
185 |
|
|
& ( KIDIA ,KFDIA ,KLON ,KLEV , KNU,& |
186 |
|
|
& PALBD ,PCG ,PCLD ,POMEGA, PSEC , PTAU,& |
187 |
|
|
& ZCGAZ ,ZPIZAZ,ZRAY1 ,ZRAY2 , ZREFZ, ZRJ ,ZRK , ZRMUE,& |
188 |
|
|
& ZTAUAZ,ZTRA1 ,ZTRA2 ,ZTRCLD & |
189 |
|
216 |
& ) |
190 |
|
|
|
191 |
|
|
! DO JK = 1 , KLEV |
192 |
|
|
! IKL = KLEV+1-JK |
193 |
|
|
! DO JL = KIDIA,KFDIA |
194 |
|
|
! print *,'Apres SWCLR,SWR RMU0 RMUE ',ZRMU0(JL,IKL),ZRMUE(JL,IKL) |
195 |
|
|
! ENDDO |
196 |
|
|
! ENDDO |
197 |
|
|
! ------------------------------------------------------------------ |
198 |
|
|
|
199 |
|
|
!* 3. OZONE ABSORPTION |
200 |
|
|
! ---------------- |
201 |
|
|
|
202 |
✗✓ |
216 |
IF (NSW <= 4) THEN |
203 |
|
|
|
204 |
|
|
!* 3.1 TWO OR FOUR SPECTRAL INTERVALS |
205 |
|
|
! ------------------------------ |
206 |
|
|
|
207 |
|
|
IIND(1)=1 |
208 |
|
|
IIND(2)=2 |
209 |
|
|
IIND(3)=3 |
210 |
|
|
IIND(4)=1 |
211 |
|
|
IIND(5)=2 |
212 |
|
|
IIND(6)=3 |
213 |
|
|
|
214 |
|
|
!* 3.1.1 DOWNWARD FLUXES |
215 |
|
|
! --------------- |
216 |
|
|
|
217 |
|
|
JAJ = 2 |
218 |
|
|
|
219 |
|
|
DO JL = KIDIA,KFDIA |
220 |
|
|
ZW(JL,1)=0.0_JPRB |
221 |
|
|
ZW(JL,2)=0.0_JPRB |
222 |
|
|
ZW(JL,3)=0.0_JPRB |
223 |
|
|
ZW(JL,4)=0.0_JPRB |
224 |
|
|
ZW(JL,5)=0.0_JPRB |
225 |
|
|
ZW(JL,6)=0.0_JPRB |
226 |
|
|
PFD(JL,KLEV+1)=((1.0_JPRB-PCLEAR(JL))*ZRJ(JL,JAJ,KLEV+1)& |
227 |
|
|
& + PCLEAR(JL) *ZRJ0(JL,JAJ,KLEV+1)) * RSUN(KNU) |
228 |
|
|
PCD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1) * RSUN(KNU) |
229 |
|
|
ENDDO |
230 |
|
|
DO JK = 1 , KLEV |
231 |
|
|
IKL = KLEV+1-JK |
232 |
|
|
DO JL = KIDIA,KFDIA |
233 |
|
|
ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL) |
234 |
|
|
ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKL)/ZRMUE(JL,IKL) |
235 |
|
|
ZW(JL,3)=ZW(JL,3)+POZ(JL, IKL)/ZRMUE(JL,IKL) |
236 |
|
|
ZW(JL,4)=ZW(JL,4)+PUD(JL,1,IKL)/ZRMU0(JL,IKL) |
237 |
|
|
ZW(JL,5)=ZW(JL,5)+PUD(JL,2,IKL)/ZRMU0(JL,IKL) |
238 |
|
|
ZW(JL,6)=ZW(JL,6)+POZ(JL, IKL)/ZRMU0(JL,IKL) |
239 |
|
|
ENDDO |
240 |
|
|
|
241 |
|
|
CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 6,& |
242 |
|
|
& IIND,& |
243 |
|
|
& ZW,& |
244 |
|
|
& ZR ) |
245 |
|
|
|
246 |
|
|
DO JL = KIDIA,KFDIA |
247 |
|
|
ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZR(JL,3)*ZRJ(JL,JAJ,IKL) |
248 |
|
|
ZDIRF(JL) = ZR(JL,4)*ZR(JL,5)*ZR(JL,6)*ZRJ0(JL,JAJ,IKL) |
249 |
|
|
PDIFF(JL,IKL) = ZDIFF(JL) * RSUN(KNU)*(1.0_JPRB-PCLEAR(JL)) |
250 |
|
|
PDIRF(JL,IKL) = ZDIRF(JL) * RSUN(KNU)*PCLEAR(JL) |
251 |
|
|
PFD(JL,IKL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)& |
252 |
|
|
& +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU) |
253 |
|
|
PCD(JL,IKL) = ZDIRF(JL) * RSUN(KNU) |
254 |
|
|
ENDDO |
255 |
|
|
ENDDO |
256 |
|
|
|
257 |
|
|
DO JL=KIDIA,KFDIA |
258 |
|
|
ZDIFT(JL) = ZR(JL,1)*ZR(JL,2)*ZR(JL,3)*ZTRCLD(JL) |
259 |
|
|
ZDIRT(JL) = ZR(JL,4)*ZR(JL,5)*ZR(JL,6)*ZTRCLR(JL) |
260 |
|
|
PSUDU1(JL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFT(JL)& |
261 |
|
|
& +PCLEAR(JL) * ZDIRT(JL)) * RSUN(KNU) |
262 |
|
|
ENDDO |
263 |
|
|
|
264 |
|
|
!* 3.1.2 UPWARD FLUXES |
265 |
|
|
! ------------- |
266 |
|
|
|
267 |
|
|
DO JL = KIDIA,KFDIA |
268 |
|
|
PFU(JL,1) = ((1.0_JPRB-PCLEAR(JL))*ZDIFF(JL)*PALBD(JL,KNU)& |
269 |
|
|
& + PCLEAR(JL) *ZDIRF(JL)*PALBP(JL,KNU))& |
270 |
|
|
& * RSUN(KNU) |
271 |
|
|
PCU(JL,1) = ZDIRF(JL) * PALBP(JL,KNU) * RSUN(KNU) |
272 |
|
|
ENDDO |
273 |
|
|
|
274 |
|
|
DO JK = 2 , KLEV+1 |
275 |
|
|
IKM1=JK-1 |
276 |
|
|
DO JL = KIDIA,KFDIA |
277 |
|
|
ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKM1)*1.66_JPRB |
278 |
|
|
ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKM1)*1.66_JPRB |
279 |
|
|
ZW(JL,3)=ZW(JL,3)+POZ(JL, IKM1)*1.66_JPRB |
280 |
|
|
ZW(JL,4)=ZW(JL,4)+PUD(JL,1,IKM1)*1.66_JPRB |
281 |
|
|
ZW(JL,5)=ZW(JL,5)+PUD(JL,2,IKM1)*1.66_JPRB |
282 |
|
|
ZW(JL,6)=ZW(JL,6)+POZ(JL, IKM1)*1.66_JPRB |
283 |
|
|
ENDDO |
284 |
|
|
|
285 |
|
|
CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 6,& |
286 |
|
|
& IIND,& |
287 |
|
|
& ZW,& |
288 |
|
|
& ZR ) |
289 |
|
|
|
290 |
|
|
DO JL = KIDIA,KFDIA |
291 |
|
|
ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZR(JL,3)*ZRK(JL,JAJ,JK) |
292 |
|
|
ZDIRF(JL) = ZR(JL,4)*ZR(JL,5)*ZR(JL,6)*ZRK0(JL,JAJ,JK) |
293 |
|
|
PFU(JL,JK) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)& |
294 |
|
|
& +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU) |
295 |
|
|
PCU(JL,JK) = ZDIRF(JL) * RSUN(KNU) |
296 |
|
|
ENDDO |
297 |
|
|
!WRITE(*,'("---> Dans SW1S:")') |
298 |
|
|
!WRITE(*,'("PFU",10E12.5)') (PFU(1,JJ),JJ=1,KLEV+1) |
299 |
|
|
!WRITE(*,'("PCLEAR",10E12.5)') (PCLEAR(1)) |
300 |
|
|
!WRITE(*,'("ZDIFF",10E12.5)') (ZDIFF(1)) |
301 |
|
|
!WRITE(*,'("ZDIRF",10E12.5)') (ZDIRF(1)) |
302 |
|
|
!WRITE(*,'("RSUN",10E12.5)') (RSUN(KNU)) |
303 |
|
|
ENDDO |
304 |
|
|
|
305 |
✓✗ |
216 |
ELSEIF (NSW == 6) THEN |
306 |
|
|
!print *,'... dans SW1S: NSW=',NSW |
307 |
|
|
|
308 |
|
|
!* 3.2 SIX SPECTRAL INTERVALS |
309 |
|
|
! ---------------------- |
310 |
|
|
|
311 |
|
216 |
IIND(1)=1 |
312 |
|
216 |
IIND(2)=2 |
313 |
|
216 |
IIND(3)=1 |
314 |
|
216 |
IIND(4)=2 |
315 |
|
|
|
316 |
|
|
!* 3.2,1 DOWNWARD FLUXES |
317 |
|
|
! --------------- |
318 |
|
|
|
319 |
|
|
JAJ = 2 |
320 |
|
|
|
321 |
✓✓ |
214920 |
DO JL = KIDIA,KFDIA |
322 |
|
214704 |
ZW(JL,1)=0.0_JPRB |
323 |
|
214704 |
ZW(JL,2)=0.0_JPRB |
324 |
|
214704 |
ZW(JL,3)=0.0_JPRB |
325 |
|
214704 |
ZW(JL,4)=0.0_JPRB |
326 |
|
|
|
327 |
|
214704 |
ZO(JL,1)=0.0_JPRB |
328 |
|
214704 |
ZO(JL,2)=0.0_JPRB |
329 |
|
|
PFD(JL,KLEV+1)=((1.0_JPRB-PCLEAR(JL))*ZRJ(JL,JAJ,KLEV+1)& |
330 |
|
214704 |
& + PCLEAR(JL) *ZRJ0(JL,JAJ,KLEV+1)) * RSUN(KNU) |
331 |
|
214920 |
PCD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1) * RSUN(KNU) |
332 |
|
|
ENDDO |
333 |
✓✓ |
8640 |
DO JK = 1 , KLEV |
334 |
|
8424 |
IKL = KLEV+1-JK |
335 |
✓✓ |
8381880 |
DO JL = KIDIA,KFDIA |
336 |
|
8373456 |
ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL) |
337 |
|
8373456 |
ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKL)/ZRMUE(JL,IKL) |
338 |
|
8373456 |
ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKL)/ZRMU0(JL,IKL) |
339 |
|
8373456 |
ZW(JL,4)=ZW(JL,4)+PUD(JL,2,IKL)/ZRMU0(JL,IKL) |
340 |
|
|
|
341 |
|
8373456 |
ZO(JL,1)=ZO(JL,1)+POZ(JL, IKL)/ZRMUE(JL,IKL) |
342 |
|
8381880 |
ZO(JL,2)=ZO(JL,2)+POZ(JL, IKL)/ZRMU0(JL,IKL) |
343 |
|
|
ENDDO |
344 |
|
|
|
345 |
|
|
! WRITE(*,'("---> Dans SW1S avant SWTT1:")') |
346 |
|
|
CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 4,& |
347 |
|
|
& IIND,& |
348 |
|
|
& ZW,& |
349 |
|
|
& ZR & |
350 |
|
8424 |
& ) |
351 |
|
|
|
352 |
|
|
! WRITE(*,'("---> Dans SW1S avant SWUVO3 flux dwn:")') |
353 |
|
|
CALL SWUVO3 ( KIDIA, KFDIA, KLON, KNU, 2,& |
354 |
|
|
& ZO,& |
355 |
|
|
& ZT & |
356 |
|
8424 |
& ) |
357 |
|
|
|
358 |
✓✓ |
8382096 |
DO JL = KIDIA,KFDIA |
359 |
|
8373456 |
ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZT(JL,1)*ZRJ(JL,JAJ,IKL) |
360 |
|
8373456 |
ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZT(JL,2)*ZRJ0(JL,JAJ,IKL) |
361 |
|
8373456 |
PDIFF(JL,IKL) = ZDIFF(JL) * RSUN(KNU)*(1.0_JPRB-PCLEAR(JL)) |
362 |
|
8373456 |
PDIRF(JL,IKL) = ZDIRF(JL) * RSUN(KNU)*PCLEAR(JL) |
363 |
|
|
PFD(JL,IKL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)& |
364 |
|
8373456 |
& +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU) |
365 |
|
8381880 |
PCD(JL,IKL) = ZDIRF(JL) * RSUN(KNU) |
366 |
|
|
ENDDO |
367 |
|
|
ENDDO |
368 |
|
|
|
369 |
|
|
IF(LLDEBUG) THEN |
370 |
|
|
call writefield_phy('sw1s_pud1',PUD(:,1,:),klev) |
371 |
|
|
call writefield_phy('sw1s_pud2',PUD(:,2,:),klev) |
372 |
|
|
call writefield_phy('sw1s_psec',PSEC,1) |
373 |
|
|
call writefield_phy('sw1s_zrmue',ZRMUE,klev+1) |
374 |
|
|
call writefield_phy('sw1s_zrmu0',ZRMU0,klev+1) |
375 |
|
|
call writefield_phy('sw1s_pdirf',PDIRF,klev) |
376 |
|
|
call writefield_phy('sw1s_pdiff',PDIFF,klev) |
377 |
|
|
call writefield_phy('sw1s_pfd',PFD,klev) |
378 |
|
|
ENDIF |
379 |
✓✓ |
214920 |
DO JL=KIDIA,KFDIA |
380 |
|
214704 |
ZDIFT(JL) = ZR(JL,1)*ZR(JL,2)*ZT(JL,1)*ZTRCLD(JL) |
381 |
|
214704 |
ZDIRT(JL) = ZR(JL,3)*ZR(JL,4)*ZT(JL,2)*ZTRCLR(JL) |
382 |
|
|
PSUDU1(JL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFT(JL)& |
383 |
|
214920 |
& +PCLEAR(JL) * ZDIRT(JL)) * RSUN(KNU) |
384 |
|
|
ENDDO |
385 |
|
|
|
386 |
|
|
!* 3.2.2 UPWARD FLUXES |
387 |
|
|
! ------------- |
388 |
|
|
|
389 |
✓✓ |
214920 |
DO JL = KIDIA,KFDIA |
390 |
|
|
PFU(JL,1) = ((1.0_JPRB-PCLEAR(JL))*ZDIFF(JL)*PALBD(JL,KNU)& |
391 |
|
|
& + PCLEAR(JL) *ZDIRF(JL)*PALBP(JL,KNU))& |
392 |
|
214704 |
& * RSUN(KNU) |
393 |
|
214920 |
PCU(JL,1) = ZDIRF(JL) * PALBP(JL,KNU) * RSUN(KNU) |
394 |
|
|
ENDDO |
395 |
|
|
|
396 |
✓✓ |
8640 |
DO JK = 2 , KLEV+1 |
397 |
|
8424 |
IKM1=JK-1 |
398 |
✓✓ |
8381880 |
DO JL = KIDIA,KFDIA |
399 |
|
8373456 |
ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKM1)*1.66_JPRB |
400 |
|
8373456 |
ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKM1)*1.66_JPRB |
401 |
|
8373456 |
ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKM1)*1.66_JPRB |
402 |
|
8373456 |
ZW(JL,4)=ZW(JL,4)+PUD(JL,2,IKM1)*1.66_JPRB |
403 |
|
|
|
404 |
|
8373456 |
ZO(JL,1)=ZO(JL,1)+POZ(JL, IKM1)*1.66_JPRB |
405 |
|
8381880 |
ZO(JL,2)=ZO(JL,2)+POZ(JL, IKM1)*1.66_JPRB |
406 |
|
|
ENDDO |
407 |
|
|
|
408 |
|
|
! WRITE(*,'("---> Dans SW1S avant SWTT1:")') |
409 |
|
|
CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 4,& |
410 |
|
|
& IIND,& |
411 |
|
|
& ZW,& |
412 |
|
|
& ZR & |
413 |
|
8424 |
& ) |
414 |
|
|
|
415 |
|
|
! WRITE(*,'("---> Dans SW1S avant SWUVO3 flux up:")') |
416 |
|
|
CALL SWUVO3 ( KIDIA, KFDIA, KLON, KNU, 2,& |
417 |
|
|
& ZO,& |
418 |
|
|
& ZT & |
419 |
|
8424 |
& ) |
420 |
|
|
|
421 |
✓✓ |
8382096 |
DO JL = KIDIA,KFDIA |
422 |
|
8373456 |
ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZT(JL,1)*ZRK(JL,JAJ,JK) |
423 |
|
8373456 |
ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZT(JL,2)*ZRK0(JL,JAJ,JK) |
424 |
|
|
PFU(JL,JK) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)& |
425 |
|
8373456 |
& +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU) |
426 |
|
8381880 |
PCU(JL,JK) = ZDIRF(JL) * RSUN(KNU) |
427 |
|
|
!WRITE(*,'("---> Dans SW1S:")') |
428 |
|
|
!print *,'===JL= ',jl |
429 |
|
|
!WRITE(*,'("ZR1",10E12.5)') (ZR(JL,1)) |
430 |
|
|
!WRITE(*,'("ZR2",10E12.5)') (ZR(JL,2)) |
431 |
|
|
!WRITE(*,'("ZR3",10E12.5)') (ZR(JL,3)) |
432 |
|
|
!WRITE(*,'("ZR4",10E12.5)') (ZR(JL,4)) |
433 |
|
|
!WRITE(*,'("ZT1",10E12.5)') (ZT(JL,1)) |
434 |
|
|
!WRITE(*,'("ZT2",10E12.5)') (ZT(JL,2)) |
435 |
|
|
ENDDO |
436 |
|
|
ENDDO |
437 |
|
|
|
438 |
|
|
!WRITE(*,'("---> Dans SW1S:")') |
439 |
|
|
!WRITE(*,'("PFU",10E12.5)') (PFU(1,JJ),JJ=1,KLEV+1) |
440 |
|
|
!WRITE(*,'("ZR",10E12.5)') (ZR(1,JJ),JJ=1,4) |
441 |
|
|
!WRITE(*,'("PCLEAR",10E12.5)') (PCLEAR(1)) |
442 |
|
|
!WRITE(*,'("ZDIFF",10E12.5)') (ZDIFF(1)) |
443 |
|
|
!WRITE(*,'("ZDIRF",10E12.5)') (ZDIRF(1)) |
444 |
|
|
!WRITE(*,'("RSUN",10E12.5)') (RSUN(KNU)) |
445 |
|
|
ENDIF |
446 |
|
|
|
447 |
|
|
! ------------------------------------------------------------------ |
448 |
|
|
|
449 |
✓✗ |
216 |
IF (LHOOK) CALL DR_HOOK('SW1S',1,ZHOOK_HANDLE) |
450 |
|
216 |
END SUBROUTINE SW1S |