1 |
|
360 |
SUBROUTINE SW & |
2 |
|
|
& ( KIDIA, KFDIA , KLON , KLEV , KAER,& |
3 |
|
72 |
& PSCT , PCARDI, PPSOL , PALBD, PALBP , PWV, PQS,& |
4 |
|
72 |
& PRMU0, PCG , PCLDSW, PDP , POMEGA, POZ, PPMB,& |
5 |
|
|
& PTAU , PTAVE , PAER,& |
6 |
|
|
& PFDOWN, PFUP,& |
7 |
|
|
& PCDOWN, PCUP,& |
8 |
|
|
& PFDNN, PFDNV , PFUPN, PFUPV,& |
9 |
|
|
& PCDNN, PCDNV , PCUPN, PCUPV,& |
10 |
|
|
& PSUDU, PUVDF , PPARF, PPARCF, PDIFFS , PDIRFS, & |
11 |
|
|
& LRDUST, PPIZA_DST,PCGA_DST,PTAUREL_DST & |
12 |
|
|
& ) |
13 |
|
|
|
14 |
|
|
|
15 |
|
|
!**** *SW* - COMPUTES THE SHORTWAVE RADIATION FLUXES. |
16 |
|
|
|
17 |
|
|
! PURPOSE. |
18 |
|
|
! -------- |
19 |
|
|
|
20 |
|
|
! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO |
21 |
|
|
! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980). |
22 |
|
|
|
23 |
|
|
!** INTERFACE. |
24 |
|
|
! ---------- |
25 |
|
|
|
26 |
|
|
! *SW* IS CALLED FROM *RADLSW* |
27 |
|
|
|
28 |
|
|
! IMPLICIT ARGUMENTS : |
29 |
|
|
! -------------------- |
30 |
|
|
|
31 |
|
|
! ==== INPUTS === |
32 |
|
|
! ==== OUTPUTS === |
33 |
|
|
|
34 |
|
|
! METHOD. |
35 |
|
|
! ------- |
36 |
|
|
|
37 |
|
|
! 1. COMPUTES ABSORBER AMOUNTS (SWU) |
38 |
|
|
! 2. COMPUTES FLUXES IN U.V./VISIBLE SPECTRAL INTERVAL (SW1S) |
39 |
|
|
! 3. COMPUTES FLUXES IN NEAR-INFRARED SPECTRAL INTERVAL (SWNI) |
40 |
|
|
|
41 |
|
|
! EXTERNALS. |
42 |
|
|
! ---------- |
43 |
|
|
|
44 |
|
|
! *SWU*, *SW1S*, *SWNI* |
45 |
|
|
|
46 |
|
|
! REFERENCE. |
47 |
|
|
! ---------- |
48 |
|
|
|
49 |
|
|
! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
50 |
|
|
! DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
51 |
|
|
|
52 |
|
|
! AUTHOR. |
53 |
|
|
! ------- |
54 |
|
|
! JEAN-JACQUES MORCRETTE *ECMWF* |
55 |
|
|
|
56 |
|
|
! MODIFICATIONS. |
57 |
|
|
! -------------- |
58 |
|
|
! ORIGINAL : 89-07-14 |
59 |
|
|
! 95-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo |
60 |
|
|
! 95-12-07 J.-J. MORCRETTE Near-Infrared in nsw-1 Intervals |
61 |
|
|
! 990128 JJMorcrette sunshine duration |
62 |
|
|
! 99-05-25 JJMorcrette Revised aerosols |
63 |
|
|
! 00-12-18 JJMorcrette 6 spectral intervals |
64 |
|
|
! 02-09-01 JJMorcrette UV and PAR |
65 |
|
|
! M.Hamrud 01-Oct-2003 CY28 Cleaning |
66 |
|
|
! Y.Seity 04-11-18 : add two arguments for AROME extern. surface |
67 |
|
|
! Y.Seity 05-10-10 : add add 3 optional arg. for dust SW properties |
68 |
|
|
! JJMorcrette 20060721 PP of clear-sky PAR |
69 |
|
|
! ------------------------------------------------------------------ |
70 |
|
|
|
71 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
72 |
|
|
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
73 |
|
|
!USE YOERAD , ONLY : NSW |
74 |
|
|
! NSW mis dans .def MPL 20140211 |
75 |
|
|
USE write_field_phy |
76 |
|
|
|
77 |
|
|
IMPLICIT NONE |
78 |
|
|
|
79 |
|
|
include "clesphys.h" |
80 |
|
|
|
81 |
|
|
integer, save :: icount=0 |
82 |
|
|
!$OMP THREADPRIVATE(icount) |
83 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KLON |
84 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KLEV |
85 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA |
86 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA |
87 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KAER |
88 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PSCT |
89 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PCARDI |
90 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PPSOL(KLON) |
91 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,NSW) |
92 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW) |
93 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PWV(KLON,KLEV) |
94 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PQS(KLON,KLEV) |
95 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KLON) |
96 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PCG(KLON,NSW,KLEV) |
97 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PCLDSW(KLON,KLEV) |
98 |
|
|
REAL(KIND=JPRB) :: PDP(KLON,KLEV) ! Argument NOT used |
99 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: POMEGA(KLON,NSW,KLEV) |
100 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: POZ(KLON,KLEV) |
101 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PPMB(KLON,KLEV+1) |
102 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PTAU(KLON,NSW,KLEV) |
103 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PTAVE(KLON,KLEV) |
104 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) |
105 |
|
|
!++MODIFCODE |
106 |
|
|
LOGICAL ,INTENT(IN) :: LRDUST |
107 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV,NSW) |
108 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV,NSW) |
109 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV,NSW) |
110 |
|
|
!--MODIFCODE |
111 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PFDOWN(KLON,KLEV+1) |
112 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PFUP(KLON,KLEV+1) |
113 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PCDOWN(KLON,KLEV+1) |
114 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PCUP(KLON,KLEV+1) |
115 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PFDNN(KLON) |
116 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PFDNV(KLON) |
117 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PFUPN(KLON) |
118 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PFUPV(KLON) |
119 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PCDNN(KLON) |
120 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PCDNV(KLON) |
121 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PCUPN(KLON) |
122 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PCUPV(KLON) |
123 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU(KLON) |
124 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PUVDF(KLON) |
125 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PPARF(KLON) |
126 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PPARCF(KLON) |
127 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PDIFFS(KLON,NSW) |
128 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PDIRFS(KLON,NSW) |
129 |
|
|
! ------------------------------------------------------------------ |
130 |
|
|
|
131 |
|
|
!* 0.1 ARGUMENTS |
132 |
|
|
! --------- |
133 |
|
|
|
134 |
|
|
! ------------------------------------------------------------------ |
135 |
|
|
|
136 |
|
|
! ------------ |
137 |
|
|
|
138 |
|
144 |
REAL(KIND=JPRB) :: ZAKI(KLON,2,NSW)& |
139 |
|
144 |
& , ZCLD(KLON,KLEV) , ZCLEAR(KLON) & |
140 |
|
144 |
& , ZDSIG(KLON,KLEV) , ZFACT(KLON)& |
141 |
|
144 |
& , ZFD(KLON,KLEV+1) , ZCD(KLON,KLEV+1)& |
142 |
|
144 |
& , ZCDOWN(KLON,KLEV+1), ZCDNIR(KLON,KLEV+1), ZCDUVS(KLON,KLEV+1)& |
143 |
|
144 |
& , ZFDOWN(KLON,KLEV+1), ZFDNIR(KLON,KLEV+1), ZFDUVS(KLON,KLEV+1)& |
144 |
|
144 |
& , ZFU(KLON,KLEV+1) , ZCU(KLON,KLEV+1)& |
145 |
|
144 |
& , ZCUP(KLON,KLEV+1) , ZCUNIR(KLON,KLEV+1), ZCUUVS(KLON,KLEV+1)& |
146 |
|
144 |
& , ZFUP(KLON,KLEV+1) , ZFUNIR(KLON,KLEV+1), ZFUUVS(KLON,KLEV+1)& |
147 |
|
144 |
& , ZRMU(KLON) , ZSEC(KLON) & |
148 |
|
144 |
& , ZSUDU1(KLON) , ZSUDU2(KLON) & |
149 |
|
144 |
& , ZSUDU1T(KLON) , ZSUDU2T(KLON) & |
150 |
|
144 |
& , ZUD(KLON,5,KLEV+1) ,ZDIFF(KLON,KLEV) ,ZDIRF(KLON,KLEV) & |
151 |
|
144 |
& , ZDIFF2(KLON,KLEV) , ZDIRF2(KLON,KLEV) |
152 |
|
|
|
153 |
|
|
INTEGER(KIND=JPIM) :: JK, JL, JNU, INUVS, INUIR |
154 |
|
|
|
155 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
156 |
|
|
LOGICAL :: LLDEBUG |
157 |
|
|
character*1 str1 |
158 |
|
|
|
159 |
|
|
#include "sw1s.intfb.h" |
160 |
|
|
#include "swni.intfb.h" |
161 |
|
|
#include "swu.intfb.h" |
162 |
|
|
|
163 |
|
|
! ------------------------------------------------------------------ |
164 |
|
|
|
165 |
|
|
!* 1. ABSORBER AMOUNTS AND OTHER USEFUL QUANTITIES |
166 |
|
|
! -------------------------------------------- |
167 |
|
|
|
168 |
✓✗ |
72 |
IF (LHOOK) CALL DR_HOOK('SW',0,ZHOOK_HANDLE) |
169 |
|
|
LLDEBUG=.FALSE. |
170 |
|
|
CALL SWU ( KIDIA,KFDIA ,KLON ,KLEV,& |
171 |
|
|
& PSCT ,PCARDI,PCLDSW,PPMB ,PPSOL,& |
172 |
|
|
& PRMU0,PTAVE ,PWV,& |
173 |
|
72 |
& ZAKI ,ZCLD ,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD ) |
174 |
|
|
|
175 |
|
|
! ------------------------------------------------------------------ |
176 |
|
|
!* 2. INTERVAL (0.185/0.25-0.68 MICRON): U.V. AND VISIBLE |
177 |
|
|
! --------------------------------------------------- |
178 |
✓✗ |
72 |
IF (NSW <= 4) THEN |
179 |
|
|
INUVS=1 |
180 |
|
|
INUIR=2 |
181 |
✓✗ |
72 |
ELSEIF (NSW == 6) THEN |
182 |
|
|
INUVS=1 |
183 |
|
|
INUIR=4 |
184 |
|
|
ENDIF |
185 |
|
|
|
186 |
✓✓ |
2952 |
DO JK = 1 , KLEV+1 |
187 |
✓✓ |
2865672 |
DO JL = KIDIA,KFDIA |
188 |
|
2862720 |
ZFD(JL,JK) =0.0_JPRB |
189 |
|
2862720 |
ZFU(JL,JK) =0.0_JPRB |
190 |
|
2862720 |
ZCD(JL,JK) =0.0_JPRB |
191 |
|
2865600 |
ZCU(JL,JK) =0.0_JPRB |
192 |
|
|
ENDDO |
193 |
|
|
ENDDO |
194 |
✓✓ |
71640 |
DO JL = KIDIA,KFDIA |
195 |
|
71568 |
ZSUDU1T(JL)=0.0_JPRB |
196 |
|
71568 |
PUVDF(JL) =0.0_JPRB |
197 |
|
71568 |
PPARF(JL) =0.0_JPRB |
198 |
|
71640 |
PPARCF(JL) =0.0_JPRB |
199 |
|
|
ENDDO |
200 |
|
|
|
201 |
|
|
IF(LLDEBUG) THEN |
202 |
|
|
call writefield_phy('sw_zsec',ZSEC,1) |
203 |
|
|
call writefield_phy('sw_zrmu',ZRMU,1) |
204 |
|
|
call writefield_phy('sw_prmu0',PRMU0,1) |
205 |
|
|
call writefield_phy('sw_zfact',ZFACT,1) |
206 |
|
|
ENDIF |
207 |
|
|
|
208 |
|
72 |
icount=icount+1 |
209 |
✓✓ |
288 |
DO JNU = INUVS , INUIR-1 |
210 |
|
|
!++MODIFCODE |
211 |
|
|
CALL SW1S & |
212 |
|
|
&( KIDIA , KFDIA, KLON , KLEV , KAER , JNU & |
213 |
|
|
&, PAER , PALBD , PALBP, PCG , ZCLD , ZCLEAR & |
214 |
|
|
&, ZDSIG, POMEGA, POZ , ZRMU , ZSEC , PTAU , ZUD & |
215 |
|
|
&, ZFDUVS,ZFUUVS, ZCDUVS,ZCUUVS, ZSUDU1, ZDIFF,ZDIRF & |
216 |
|
|
&, LRDUST,PPIZA_DST(:,:,JNU) & ! SSA for this wavelength |
217 |
|
|
&, PCGA_DST(:,:,JNU) & ! GCA for this wavelengt |
218 |
|
216 |
&, PTAUREL_DST(:,:,JNU) ) ! TAUREL for this wavelength |
219 |
|
|
!--MODIFCODE |
220 |
|
|
IF(LLDEBUG) THEN |
221 |
|
|
! Ecriture des champs avec un indicage du fichier par l'intervalle spectral |
222 |
|
|
write(str1,'(i1)') jnu |
223 |
|
|
call writefield_phy("sw_zcduvs"//str1,zcduvs,klev+1) |
224 |
|
|
ENDIF |
225 |
|
|
|
226 |
|
|
|
227 |
✓✓ |
214920 |
DO JL=KIDIA,KFDIA |
228 |
|
214704 |
PDIFFS(JL,JNU)=ZDIFF(JL,1)*ZFACT(JL) |
229 |
|
214920 |
PDIRFS(JL,JNU)=ZDIRF(JL,1)*ZFACT(JL) |
230 |
|
|
ENDDO |
231 |
✓✓ |
8856 |
DO JK = 1 , KLEV+1 |
232 |
✓✓ |
8597016 |
DO JL = KIDIA,KFDIA |
233 |
|
8588160 |
ZFD(JL,JK)=ZFD(JL,JK)+ZFDUVS(JL,JK) |
234 |
|
8588160 |
ZFU(JL,JK)=ZFU(JL,JK)+ZFUUVS(JL,JK) |
235 |
|
8588160 |
ZCD(JL,JK)=ZCD(JL,JK)+ZCDUVS(JL,JK) |
236 |
|
8596800 |
ZCU(JL,JK)=ZCU(JL,JK)+ZCUUVS(JL,JK) |
237 |
|
|
ENDDO |
238 |
|
|
ENDDO |
239 |
✓✓ |
214920 |
DO JL = KIDIA,KFDIA |
240 |
|
214920 |
ZSUDU1T(JL)=ZSUDU1T(JL)+ZSUDU1(JL) |
241 |
|
|
ENDDO |
242 |
|
|
|
243 |
✓✗ |
288 |
IF (NSW == 6) THEN |
244 |
✓✓ |
216 |
IF (JNU <= 2) THEN |
245 |
✓✓ |
143280 |
DO JL = KIDIA,KFDIA |
246 |
|
143280 |
PUVDF(JL)=PUVDF(JL)+ZFDUVS(JL,1) |
247 |
|
|
ENDDO |
248 |
|
|
ELSEIF (JNU == 3) THEN |
249 |
✓✓ |
71640 |
DO JL=KIDIA,KFDIA |
250 |
|
71568 |
PPARF(JL)=PPARF(JL)+ZFDUVS(JL,1) |
251 |
|
71640 |
PPARCF(JL)=PPARCF(JL)+ZCDUVS(JL,1) |
252 |
|
|
ENDDO |
253 |
|
|
ENDIF |
254 |
|
|
ENDIF |
255 |
|
|
ENDDO |
256 |
|
|
|
257 |
|
|
!if (icount==5) stop'on arrete dans sw.F90 au bout de 5 appels' |
258 |
|
|
! ------------------------------------------------------------------ |
259 |
|
|
|
260 |
|
|
!* 3. INTERVAL (0.68-4.00 MICRON): NEAR-INFRARED |
261 |
|
|
! ------------------------------------------ |
262 |
|
|
|
263 |
✓✓ |
2952 |
DO JK = 1 , KLEV+1 |
264 |
✓✓ |
2865672 |
DO JL = KIDIA,KFDIA |
265 |
|
2862720 |
ZFDOWN(JL,JK)=0.0_JPRB |
266 |
|
2862720 |
ZFUP (JL,JK)=0.0_JPRB |
267 |
|
2862720 |
ZCDOWN(JL,JK)=0.0_JPRB |
268 |
|
2862720 |
ZCUP (JL,JK)=0.0_JPRB |
269 |
|
2865600 |
ZSUDU2T(JL) =0.0_JPRB |
270 |
|
|
ENDDO |
271 |
|
|
ENDDO |
272 |
|
|
|
273 |
✓✓ |
288 |
DO JNU = INUIR , NSW |
274 |
|
|
!++MODIFCODE |
275 |
|
|
CALL SWNI & |
276 |
|
|
&( KIDIA ,KFDIA , KLON , KLEV , KAER , JNU & |
277 |
|
|
&, PAER ,ZAKI , PALBD, PALBP, PCG , ZCLD, ZCLEAR & |
278 |
|
|
&, ZDSIG ,POMEGA, POZ , ZRMU , ZSEC , PTAU, ZUD & |
279 |
|
|
&, PWV ,PQS & |
280 |
|
|
&, ZFDNIR,ZFUNIR,ZCDNIR,ZCUNIR,ZSUDU2,ZDIFF2,ZDIRF2 & |
281 |
|
|
&, LRDUST,PPIZA_DST(:,:,JNU) & |
282 |
|
|
&, PCGA_DST(:,:,JNU) & |
283 |
|
|
&, PTAUREL_DST(:,:,JNU) & |
284 |
|
216 |
&) |
285 |
|
|
!--MODIFCODE |
286 |
|
|
|
287 |
|
|
IF(LLDEBUG) THEN |
288 |
|
|
! Ecriture des champs avec un indicage du fichier par l'intervalle spectral |
289 |
|
|
write(str1,'(i1)') jnu |
290 |
|
|
call writefield_phy("sw_zcdnir"//str1,zcdnir,klev+1) |
291 |
|
|
ENDIF |
292 |
|
|
|
293 |
✓✓ |
214920 |
DO JL=KIDIA,KFDIA |
294 |
|
214704 |
PDIFFS(JL,JNU)=ZDIFF2(JL,1)*ZFACT(JL) |
295 |
|
214920 |
PDIRFS(JL,JNU)=ZDIRF2(JL,1)*ZFACT(JL) |
296 |
|
|
ENDDO |
297 |
✓✓ |
8856 |
DO JK = 1 , KLEV+1 |
298 |
✓✓ |
8597016 |
DO JL = KIDIA,KFDIA |
299 |
|
8588160 |
ZFDOWN(JL,JK)=ZFDOWN(JL,JK)+ZFDNIR(JL,JK) |
300 |
|
8588160 |
ZFUP (JL,JK)=ZFUP (JL,JK)+ZFUNIR(JL,JK) |
301 |
|
8588160 |
ZCDOWN(JL,JK)=ZCDOWN(JL,JK)+ZCDNIR(JL,JK) |
302 |
|
8596800 |
ZCUP (JL,JK)=ZCUP (JL,JK)+ZCUNIR(JL,JK) |
303 |
|
|
ENDDO |
304 |
|
|
ENDDO |
305 |
✓✓ |
214992 |
DO JL = KIDIA,KFDIA |
306 |
|
214920 |
ZSUDU2T(JL)=ZSUDU2T(JL)+ZSUDU2(JL) |
307 |
|
|
ENDDO |
308 |
|
|
ENDDO |
309 |
|
|
|
310 |
|
|
! ------------------------------------------------------------------ |
311 |
|
|
|
312 |
|
|
!* 4. FILL THE DIAGNOSTIC ARRAYS |
313 |
|
|
! -------------------------- |
314 |
|
|
|
315 |
✓✓ |
71640 |
DO JL = KIDIA,KFDIA |
316 |
|
71568 |
PFDNN(JL)=ZFDOWN(JL,1)*ZFACT(JL) |
317 |
|
71568 |
PFDNV(JL)=ZFD(JL,1)*ZFACT(JL) |
318 |
|
71568 |
PFUPN(JL)=ZFUP(JL,KLEV+1)*ZFACT(JL) |
319 |
|
71568 |
PFUPV(JL)=ZFU(JL,KLEV+1)*ZFACT(JL) |
320 |
|
|
|
321 |
|
71568 |
PCDNN(JL)=ZCDOWN(JL,1)*ZFACT(JL) |
322 |
|
71568 |
PCDNV(JL)=ZCD(JL,1)*ZFACT(JL) |
323 |
|
71568 |
PCUPN(JL)=ZCUP(JL,KLEV+1)*ZFACT(JL) |
324 |
|
71568 |
PCUPV(JL)=ZCU(JL,KLEV+1)*ZFACT(JL) |
325 |
|
|
|
326 |
|
71568 |
PSUDU(JL)=(ZSUDU1T(JL)+ZSUDU2T(JL))*ZFACT(JL) |
327 |
|
71568 |
PUVDF(JL)=PUVDF(JL)*ZFACT(JL) |
328 |
|
71568 |
PPARF(JL)=PPARF(JL)*ZFACT(JL) |
329 |
|
71640 |
PPARCF(JL)=PPARCF(JL)*ZFACT(JL) |
330 |
|
|
ENDDO |
331 |
|
|
|
332 |
|
|
!WRITE(*,'("---> Dans SW:")') |
333 |
|
|
!WRITE(*,'("ZFUP ",10E12.5)') (ZFUP(1,JK),JK=1,KLEV+1) |
334 |
|
|
!WRITE(*,'("ZFU ",10E12.5)') (ZFU(1,JK),JK=1,KLEV+1) |
335 |
|
|
!WRITE(*,'("ZFUNIR",10E12.5)') (ZFUNIR(1,JK),JK=1,KLEV+1) |
336 |
|
|
!WRITE(*,'("ZFACT ",E12.5)') ZFACT(1) |
337 |
|
|
|
338 |
✓✓ |
2952 |
DO JK = 1 , KLEV+1 |
339 |
✓✓ |
2865672 |
DO JL = KIDIA,KFDIA |
340 |
|
2862720 |
PFUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) |
341 |
|
2862720 |
PFDOWN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) |
342 |
|
2862720 |
PCUP(JL,JK) = (ZCUP(JL,JK) + ZCU(JL,JK)) * ZFACT(JL) |
343 |
|
2865600 |
PCDOWN(JL,JK) = (ZCDOWN(JL,JK) + ZCD(JL,JK)) * ZFACT(JL) |
344 |
|
|
ENDDO |
345 |
|
|
ENDDO |
346 |
|
|
IF(LLDEBUG) THEN |
347 |
|
|
call writefield_phy('sw_pcdown',PCDOWN,KLEV+1) |
348 |
|
|
ENDIF |
349 |
|
|
|
350 |
|
|
! ------------------------------------------------------------------ |
351 |
|
|
|
352 |
✓✗ |
72 |
IF (LHOOK) CALL DR_HOOK('SW',1,ZHOOK_HANDLE) |
353 |
|
72 |
END SUBROUTINE SW |