1 |
|
216 |
SUBROUTINE SWNI & |
2 |
|
|
& ( KIDIA , KFDIA , KLON , KLEV , KAER , KNU,& |
3 |
|
216 |
& PAER , PAKI , PALBD , PALBP, PCG , PCLD, PCLEAR,& |
4 |
|
216 |
& PDSIG , POMEGA, POZ , PRMU , PSEC , PTAU,& |
5 |
|
216 |
& PUD , PWV , PQS,& |
6 |
|
216 |
& PFDOWN, PFUP , PCDOWN, PCUP , PSUDU2, PDIFF , PDIRF, & |
7 |
|
|
!++MODIFCODE |
8 |
|
|
& LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST ) |
9 |
|
|
!--MODIFCODE |
10 |
|
|
|
11 |
|
|
!**** *SWNI* - SHORTWAVE RADIATION, NEAR-INFRARED SPECTRAL INTERVALS |
12 |
|
|
|
13 |
|
|
! PURPOSE. |
14 |
|
|
! -------- |
15 |
|
|
|
16 |
|
|
! COMPUTES THE SHORTWAVE RADIATION FLUXES IN THE NEAR-INFRARED |
17 |
|
|
! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980). |
18 |
|
|
|
19 |
|
|
!** INTERFACE. |
20 |
|
|
! ---------- |
21 |
|
|
|
22 |
|
|
! *SWNI* IS CALLED FROM *SW*. |
23 |
|
|
|
24 |
|
|
! IMPLICIT ARGUMENTS : |
25 |
|
|
! -------------------- |
26 |
|
|
|
27 |
|
|
! ==== INPUTS === |
28 |
|
|
! ==== OUTPUTS === |
29 |
|
|
|
30 |
|
|
! METHOD. |
31 |
|
|
! ------- |
32 |
|
|
|
33 |
|
|
! 1. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING TO |
34 |
|
|
! CONTINUUM SCATTERING |
35 |
|
|
! 2. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING FOR |
36 |
|
|
! A GREY MOLECULAR ABSORPTION |
37 |
|
|
! 3. LAPLACE TRANSFORM ON THE PREVIOUS TO GET EFFECTIVE AMOUNTS |
38 |
|
|
! OF ABSORBERS |
39 |
|
|
! 4. APPLY H2O AND U.M.G. TRANSMISSION FUNCTIONS |
40 |
|
|
! 5. MULTIPLY BY OZONE TRANSMISSION FUNCTION |
41 |
|
|
|
42 |
|
|
! EXTERNALS. |
43 |
|
|
! ---------- |
44 |
|
|
|
45 |
|
|
! *SWCLR*, *SWR*, *SWDE*, *SWTT* |
46 |
|
|
|
47 |
|
|
! REFERENCE. |
48 |
|
|
! ---------- |
49 |
|
|
|
50 |
|
|
! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
51 |
|
|
! DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
52 |
|
|
|
53 |
|
|
! AUTHOR. |
54 |
|
|
! ------- |
55 |
|
|
! JEAN-JACQUES MORCRETTE *ECMWF* |
56 |
|
|
|
57 |
|
|
! MODIFICATIONS. |
58 |
|
|
! -------------- |
59 |
|
|
! ORIGINAL : 89-07-14 |
60 |
|
|
! 94-11-15 J.-J. MORCRETTE DIRECT/DIFFUSE ALBEDO |
61 |
|
|
! 95-12-07 J.-J. MORCRETTE NEAR-INFRARED SW |
62 |
|
|
! 990128 JJMorcrette Sunshine duration |
63 |
|
|
! 99-05-25 JJMorcrette Revised aerosols |
64 |
|
|
! 03-03-17 JJMorcrette Sunshine duration (correction) |
65 |
|
|
! 03-10-10 Deborah Salmond and Marta Janiskova Optimisation |
66 |
|
|
! M.Hamrud 01-Oct-2003 CY28 Cleaning |
67 |
|
|
! 04-11-18 Y.Seity : add 2 arguments for AROME extern. surface |
68 |
|
|
! Y.Seity 05-10-10 : add add 3 optional arg. for dust SW properties |
69 |
|
|
! Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests |
70 |
|
|
! ------------------------------------------------------------------ |
71 |
|
|
|
72 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
73 |
|
|
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
74 |
|
|
|
75 |
|
|
USE YOESW , ONLY : RRAY ,RSUN ,RSWCE ,RSWCP |
76 |
|
|
!++MODIFCODE |
77 |
|
|
!USE YOERAD , ONLY : NSW ,NOVLP |
78 |
|
|
! NSW mis dans .def MPL 20140211 |
79 |
|
|
USE YOERAD , ONLY : NOVLP |
80 |
|
|
!--MODIFCODE |
81 |
|
|
USE YOERDU , ONLY : REPLOG ,REPSCQ ,REPSC |
82 |
|
|
USE write_field_phy |
83 |
|
|
|
84 |
|
|
IMPLICIT NONE |
85 |
|
|
|
86 |
|
|
include "clesphys.h" |
87 |
|
|
|
88 |
|
|
character*1 str1 |
89 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KLON |
90 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KLEV |
91 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA |
92 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA |
93 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KAER |
94 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KNU |
95 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) |
96 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PAKI(KLON,2,NSW) |
97 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,NSW) |
98 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW) |
99 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PCG(KLON,NSW,KLEV) |
100 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PCLD(KLON,KLEV) |
101 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PCLEAR(KLON) |
102 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PDSIG(KLON,KLEV) |
103 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: POMEGA(KLON,NSW,KLEV) |
104 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: POZ(KLON,KLEV) |
105 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PRMU(KLON) |
106 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PSEC(KLON) |
107 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PTAU(KLON,NSW,KLEV) |
108 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PUD(KLON,5,KLEV+1) |
109 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PWV(KLON,KLEV) |
110 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PQS(KLON,KLEV) |
111 |
|
|
!++MODIFCODE |
112 |
|
|
LOGICAL ,INTENT(IN) :: LRDUST |
113 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV) |
114 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV) |
115 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV) |
116 |
|
|
!--MODIFCODE |
117 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PFDOWN(KLON,KLEV+1) |
118 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PFUP(KLON,KLEV+1) |
119 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PCDOWN(KLON,KLEV+1) |
120 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PCUP(KLON,KLEV+1) |
121 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU2(KLON) |
122 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PDIFF(KLON,KLEV) |
123 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PDIRF(KLON,KLEV) |
124 |
|
|
!#include "yoeaer.h" |
125 |
|
|
! ------------------------------------------------------------------ |
126 |
|
|
|
127 |
|
|
!* 0.1 ARGUMENTS |
128 |
|
|
! --------- |
129 |
|
|
|
130 |
|
|
! ------------------------------------------------------------------ |
131 |
|
|
|
132 |
|
|
! ------------ |
133 |
|
|
|
134 |
|
|
INTEGER(KIND=JPIM) :: IIND2(2), IIND3(6) |
135 |
|
432 |
REAL(KIND=JPRB) :: ZCGAZ(KLON,KLEV) , ZDIFF(KLON) , ZDIRF(KLON)& |
136 |
|
432 |
& , ZFD(KLON,KLEV+1) , ZFU(KLON,KLEV+1) & |
137 |
|
432 |
& , ZG(KLON) , ZGG(KLON) |
138 |
|
432 |
REAL(KIND=JPRB) :: ZPIZAZ(KLON,KLEV)& |
139 |
|
432 |
& , ZRAYL(KLON) , ZRAY1(KLON,KLEV+1) , ZRAY2(KLON,KLEV+1)& |
140 |
|
432 |
& , ZREF(KLON) , ZREFZ(KLON,2,KLEV+1)& |
141 |
|
432 |
& , ZRE1(KLON) , ZRE2(KLON)& |
142 |
|
432 |
& , ZRJ(KLON,6,KLEV+1), ZRJ0(KLON,6,KLEV+1)& |
143 |
|
432 |
& , ZRK(KLON,6,KLEV+1), ZRK0(KLON,6,KLEV+1)& |
144 |
|
432 |
& , ZRL(KLON,8)& |
145 |
|
432 |
& , ZRMUE(KLON,KLEV+1), ZRMU0(KLON,KLEV+1) , ZRMUZ(KLON)& |
146 |
|
432 |
& , ZRNEB(KLON) , ZRUEF(KLON,8) , ZR1(KLON) & |
147 |
|
432 |
& , ZR2(KLON,2) , ZR3(KLON,6) , ZR4(KLON,2)& |
148 |
|
432 |
& , ZR21(KLON) , ZR22(KLON) |
149 |
|
432 |
REAL(KIND=JPRB) :: ZS(KLON)& |
150 |
|
432 |
& , ZTAUAZ(KLON,KLEV) , ZTO1(KLON) , ZTR(KLON,2,KLEV+1)& |
151 |
|
432 |
& , ZTRA1(KLON,KLEV+1), ZTRA2(KLON,KLEV+1)& |
152 |
|
432 |
& , ZTRCLD(KLON) , ZTRCLR(KLON)& |
153 |
|
432 |
& , ZTR1(KLON) , ZTR2(KLON)& |
154 |
|
432 |
& , ZW(KLON) , ZW1(KLON) , ZW2(KLON,2)& |
155 |
|
432 |
& , ZW3(KLON,6) , ZW4(KLON,2) , ZW5(KLON,2) |
156 |
|
|
|
157 |
|
|
INTEGER(KIND=JPIM) :: IABS, IKL, IKM1, JABS, JAJ, JAJP, JK, JKKI,& |
158 |
|
|
& JKKP4, JKL, JKLP1, JKM1, JL, JN, JN2J, JREF |
159 |
|
|
|
160 |
|
|
REAL(KIND=JPRB) :: ZAA, ZBB, ZCNEB, ZRE11, ZRKI, ZRMUM1, ZWH2O, ZCHKG, ZCHKS |
161 |
|
|
REAL(KIND=JPRB) :: ZRR,ZRRJ,ZRRK |
162 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
163 |
|
|
!++MODIF_CODE |
164 |
|
432 |
REAL(KIND=JPRB) :: ZB_ODI(KLON) |
165 |
|
|
!--MODIF_CODE |
166 |
|
|
LOGICAL :: LLDEBUG |
167 |
|
|
|
168 |
|
|
#include "swclr.intfb.h" |
169 |
|
|
#include "swde.intfb.h" |
170 |
|
|
#include "swr.intfb.h" |
171 |
|
|
#include "swtt.intfb.h" |
172 |
|
|
#include "swtt1.intfb.h" |
173 |
|
|
|
174 |
|
|
LLDEBUG=.FALSE. |
175 |
|
|
|
176 |
|
|
IF(LLDEBUG) THEN |
177 |
|
|
write(str1,'(i1)') knu |
178 |
|
|
! call writefield_phy("sw_zcduvs"//str1,zcduvs,klev+1) |
179 |
|
|
ENDIF |
180 |
|
|
|
181 |
|
|
! ------------------------------------------------------------------ |
182 |
|
|
|
183 |
|
|
!* 1. NEAR-INFRARED SPECTRAL INTERVAL (0.68-4.00 MICRON) |
184 |
|
|
! -------------------------------------------------- |
185 |
|
|
|
186 |
|
|
!* 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING |
187 |
|
|
! ----------------------------------------- |
188 |
|
|
|
189 |
✓✗ |
216 |
IF (LHOOK) CALL DR_HOOK('SWNI',0,ZHOOK_HANDLE) |
190 |
✓✓ |
214920 |
DO JL = KIDIA,KFDIA |
191 |
|
214704 |
ZRMUM1 = 1.0_JPRB - PRMU(JL) |
192 |
|
|
ZRAYL(JL) = RRAY(KNU,1) + ZRMUM1 * (RRAY(KNU,2) + ZRMUM1 & |
193 |
|
|
& * (RRAY(KNU,3) + ZRMUM1 * (RRAY(KNU,4) + ZRMUM1 & |
194 |
|
214704 |
& * (RRAY(KNU,5) + ZRMUM1 * RRAY(KNU,6) )))) |
195 |
|
214920 |
ZRAYL(JL) = MAX (ZRAYL(JL), 0.0_JPRB) |
196 |
|
|
ENDDO |
197 |
|
|
|
198 |
|
|
! ------------------------------------------------------------------ |
199 |
|
|
|
200 |
|
|
!* 2. CONTINUUM SCATTERING CALCULATIONS |
201 |
|
|
! --------------------------------- |
202 |
|
|
|
203 |
|
|
!* 2.1 CLEAR-SKY FRACTION OF THE COLUMN |
204 |
|
|
! -------------------------------- |
205 |
|
|
|
206 |
|
|
|
207 |
|
|
!++MODIFCODE |
208 |
|
|
CALL SWCLR & |
209 |
|
|
&( KIDIA , KFDIA , KLON , KLEV , KAER , KNU & |
210 |
|
|
&, PAER , PALBP , PDSIG , ZRAYL, PSEC & |
211 |
|
|
&, ZCGAZ , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0 & |
212 |
|
|
&, ZRK0 , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2, ZTRCLR & |
213 |
|
|
&, LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST & |
214 |
|
216 |
&) |
215 |
|
|
!--MODIFCODE |
216 |
|
|
|
217 |
|
|
!* 2.2 CLOUDY FRACTION OF THE COLUMN |
218 |
|
|
! ----------------------------- |
219 |
|
|
|
220 |
|
|
CALL SWR & |
221 |
|
|
& ( KIDIA , KFDIA , KLON , KLEV , KNU,& |
222 |
|
|
& PALBD , PCG , PCLD , POMEGA, PSEC , PTAU,& |
223 |
|
|
& ZCGAZ , ZPIZAZ, ZRAY1, ZRAY2 , ZREFZ, ZRJ , ZRK, ZRMUE,& |
224 |
|
|
& ZTAUAZ, ZTRA1 , ZTRA2, ZTRCLD & |
225 |
|
216 |
& ) |
226 |
|
|
|
227 |
|
|
! ------------------------------------------------------------------ |
228 |
|
|
|
229 |
|
|
!* 3. SCATTERING CALCULATIONS WITH GREY MOLECULAR ABSORPTION |
230 |
|
|
! ------------------------------------------------------ |
231 |
|
|
|
232 |
|
|
JN = 2 |
233 |
|
|
|
234 |
✓✓ |
648 |
DO JABS=1,2 |
235 |
|
|
|
236 |
|
|
!* 3.1 SURFACE CONDITIONS |
237 |
|
|
! ------------------ |
238 |
|
|
|
239 |
✓✓ |
429840 |
DO JL = KIDIA,KFDIA |
240 |
|
429408 |
ZREFZ(JL,2,1) = PALBD(JL,KNU) |
241 |
|
429840 |
ZREFZ(JL,1,1) = PALBD(JL,KNU) |
242 |
|
|
ENDDO |
243 |
|
|
|
244 |
|
|
!* 3.2 INTRODUCING CLOUD EFFECTS |
245 |
|
|
! ------------------------- |
246 |
|
|
|
247 |
✓✓ |
17280 |
DO JK = 2 , KLEV+1 |
248 |
|
16848 |
JKM1 = JK - 1 |
249 |
|
16848 |
IKL=KLEV+1-JKM1 |
250 |
✓✓ |
16763760 |
DO JL = KIDIA,KFDIA |
251 |
|
16746912 |
ZRNEB(JL) = PCLD(JL,JKM1) |
252 |
✓✓✓✓
|
16746912 |
IF (JABS == 1.AND. ZRNEB(JL) > REPSC ) THEN |
253 |
|
1860903 |
ZWH2O=MAX(PWV(JL,IKL),REPSCQ) |
254 |
|
1860903 |
ZCNEB=MAX(REPSC ,MIN(ZRNEB(JL),1.0_JPRB-REPSC )) |
255 |
|
1860903 |
ZBB=PUD(JL,JABS,JKM1)*PQS(JL,IKL)/ZWH2O |
256 |
|
1860903 |
ZAA=MAX((PUD(JL,JABS,JKM1)-ZCNEB*ZBB)/(1.0_JPRB-ZCNEB),REPSCQ) |
257 |
|
|
ELSE |
258 |
|
14886009 |
ZAA=PUD(JL,JABS,JKM1) |
259 |
|
|
ZBB=ZAA |
260 |
|
|
ZCNEB=0.0_JPRB |
261 |
|
|
ZWH2O=MAX(PWV(JL,IKL),REPSCQ) |
262 |
|
|
ENDIF |
263 |
|
|
|
264 |
|
|
! ZEXP1=-ZRKI * ZAA * 1.66_JPRB |
265 |
|
|
! ZEXP2=-ZRKI * ZAA / ZRMUE(JL,JK) |
266 |
|
|
! IF ( ZEXP1 > _ZERO_ .OR. ZEXP2 > _ZERO_ & |
267 |
|
|
! & .OR. ZEXP1 < -700._JPRB .OR. ZEXP2 < -700._JPRB ) THEN |
268 |
|
|
! WRITE (NULOUT,'(" SWNI 3.2 : JK=",I4," JL=",I4," JABS=",I4,,8E13.6)') & |
269 |
|
|
! & JK,JL,JABS,ZAA,ZBB,ZRKI,ZCNEB,ZWH2O,ZRMUE(JL,JK),ZEXP1,ZEXP2 |
270 |
|
|
! END IF |
271 |
|
|
|
272 |
|
16746912 |
ZRKI = PAKI(JL,JABS,KNU) |
273 |
|
|
! ZS(JL) = EXP(-ZRKI * ZAA * 1.66_JPRB) |
274 |
|
|
! ZG(JL) = EXP(-ZRKI * ZAA / ZRMUE(JL,JK) ) |
275 |
|
|
|
276 |
|
16746912 |
ZCHKS = MIN( 200._JPRB, ZRKI * ZAA * 1.66_JPRB ) |
277 |
|
16746912 |
ZCHKG = MIN( 200._JPRB, ZRKI * ZAA / ZRMUE(JL,JK)) |
278 |
|
16746912 |
ZS(JL) = EXP( - ZCHKS ) |
279 |
|
16746912 |
ZG(JL) = EXP( - ZCHKG ) |
280 |
|
|
|
281 |
|
16746912 |
ZTR1(JL) = 0.0_JPRB |
282 |
|
16746912 |
ZRE1(JL) = 0.0_JPRB |
283 |
|
16746912 |
ZTR2(JL) = 0.0_JPRB |
284 |
|
16746912 |
ZRE2(JL) = 0.0_JPRB |
285 |
|
|
|
286 |
|
|
!++MODIFCODE |
287 |
✗✓ |
16746912 |
IF (NOVLP >= 5)THEN !MESONH VERSION |
288 |
|
|
ZW(JL) =PCG(JL,KNU,JKM1)*PCG(JL,KNU,JKM1) |
289 |
|
|
ZTO1(JL) = PTAU(JL,KNU,JKM1)*(1-(POMEGA(JL,KNU,JKM1)*ZW(JL))) |
290 |
|
|
ZW(JL) =POMEGA(JL,KNU,JKM1)*(1-ZW(JL))/(1-(POMEGA(JL,KNU,JKM1)*ZW(JL))) |
291 |
|
|
ZGG(JL) =PCG(JL,KNU,JKM1)/(1+PCG(JL,KNU,JKM1)) |
292 |
|
|
ZGG(JL)=ZTO1(JL)*ZW(JL)*ZGG(JL)+ZTAUAZ(JL,JKM1)*ZPIZAZ(JL,JKM1)*ZCGAZ(JL,JKM1) |
293 |
|
|
ZGG(JL)=ZGG(JL)/(ZTO1(JL)*ZW(JL)+ZTAUAZ(JL,JKM1)*ZPIZAZ(JL,JKM1)) |
294 |
|
|
ZB_ODI(JL)=ZTO1(JL) / ZW(JL)& |
295 |
|
|
&+ ZTAUAZ(JL,JKM1) / ZPIZAZ(JL,JKM1)& |
296 |
|
|
!if g=0 tau/w=tau'/w' |
297 |
|
|
&+ ZBB * ZRKI |
298 |
|
|
ZB_ODI(JL)=(1/( (ZTO1(JL) / ZW(JL))& |
299 |
|
|
&+ (ZTAUAZ(JL,JKM1) / ZPIZAZ(JL,JKM1)) ))-(1/ZB_ODI(JL)) |
300 |
|
|
ZB_ODI(JL)=((ZTO1(JL) + ZTAUAZ(JL,JKM1))**2)*ZB_ODI(JL) |
301 |
|
|
ZW(JL)=ZTO1(JL)*ZW(JL)+ZTAUAZ(JL,JKM1)*ZPIZAZ(JL,JKM1)-ZB_ODI(JL) |
302 |
|
|
ZTO1(JL) = ZTO1(JL) + ZTAUAZ(JL,JKM1) |
303 |
|
|
ZW(JL)=ZW(JL)/ZTO1(JL) |
304 |
|
|
ELSE !ECMWF VERSION |
305 |
|
16746912 |
ZW(JL)= POMEGA(JL,KNU,JKM1) |
306 |
|
|
ZTO1(JL) = PTAU(JL,KNU,JKM1) / ZW(JL)& |
307 |
|
|
& + ZTAUAZ(JL,JKM1) / ZPIZAZ(JL,JKM1)& |
308 |
|
16746912 |
& + ZBB * ZRKI |
309 |
|
16746912 |
ZR21(JL) = PTAU(JL,KNU,JKM1) + ZTAUAZ(JL,JKM1) |
310 |
|
16746912 |
ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL) |
311 |
|
|
ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1)& |
312 |
|
16746912 |
& + (1.0_JPRB - ZR22(JL)) * ZCGAZ(JL,JKM1) |
313 |
|
16746912 |
ZW(JL) = ZR21(JL) / ZTO1(JL) |
314 |
|
|
ENDIF |
315 |
|
|
!--MODIFCODE |
316 |
|
16746912 |
ZREF(JL) = ZREFZ(JL,1,JKM1) |
317 |
|
16763760 |
ZRMUZ(JL) = ZRMUE(JL,JK) |
318 |
|
|
ENDDO |
319 |
|
|
|
320 |
|
|
CALL SWDE ( KIDIA, KFDIA, KLON,& |
321 |
|
|
& ZGG , ZREF , ZRMUZ, ZTO1, ZW,& |
322 |
|
16848 |
& ZRE1 , ZRE2 , ZTR1 , ZTR2 ) |
323 |
|
|
|
324 |
✓✓ |
16764192 |
DO JL = KIDIA,KFDIA |
325 |
|
|
|
326 |
|
16746912 |
ZRR=1.0_JPRB/(1.0_JPRB-ZRAY2(JL,JKM1)*ZREFZ(JL,1,JKM1)) |
327 |
|
|
ZREFZ(JL,2,JK) = (1.0_JPRB-ZRNEB(JL)) * (ZRAY1(JL,JKM1)& |
328 |
|
|
& + ZREFZ(JL,2,JKM1) * ZTRA1(JL,JKM1)& |
329 |
|
|
& * ZTRA2(JL,JKM1) ) * ZG(JL) * ZS(JL)& |
330 |
|
16746912 |
& + ZRNEB(JL) * ZRE1(JL) |
331 |
|
|
|
332 |
|
|
ZTR(JL,2,JKM1)=ZRNEB(JL)*ZTR1(JL)& |
333 |
|
16746912 |
& + (ZTRA1(JL,JKM1)) * ZG(JL) * (1.0_JPRB-ZRNEB(JL)) |
334 |
|
|
|
335 |
|
|
ZREFZ(JL,1,JK)=(1.0_JPRB-ZRNEB(JL))*(ZRAY1(JL,JKM1)& |
336 |
|
|
& +ZREFZ(JL,1,JKM1)*ZTRA1(JL,JKM1)*ZTRA2(JL,JKM1)& |
337 |
|
|
& *ZRR ) & |
338 |
|
|
& *ZG(JL)*ZS(JL)& |
339 |
|
16746912 |
& + ZRNEB(JL) * ZRE2(JL) |
340 |
|
|
|
341 |
|
|
ZTR(JL,1,JKM1)= ZRNEB(JL) * ZTR2(JL)& |
342 |
|
|
& + (ZTRA1(JL,JKM1) & |
343 |
|
|
& *ZRR ) & |
344 |
|
16763760 |
& * ZG(JL) * (1.0_JPRB -ZRNEB(JL)) |
345 |
|
|
|
346 |
|
|
ENDDO |
347 |
|
|
ENDDO |
348 |
|
|
|
349 |
|
|
!* 3.3 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL |
350 |
|
|
! ------------------------------------------------- |
351 |
|
|
|
352 |
✓✓ |
1512 |
DO JREF=1,2 |
353 |
|
|
|
354 |
|
864 |
JN = JN + 1 |
355 |
|
|
|
356 |
✓✓ |
859680 |
DO JL = KIDIA,KFDIA |
357 |
|
858816 |
ZRJ(JL,JN,KLEV+1) = 1.0_JPRB |
358 |
|
859680 |
ZRK(JL,JN,KLEV+1) = ZREFZ(JL,JREF,KLEV+1) |
359 |
|
|
ENDDO |
360 |
|
|
|
361 |
✓✓ |
34992 |
DO JK = 1 , KLEV |
362 |
|
33696 |
JKL = KLEV+1 - JK |
363 |
|
33696 |
JKLP1 = JKL + 1 |
364 |
✓✓ |
33528384 |
DO JL = KIDIA,KFDIA |
365 |
|
33493824 |
ZRE11 = ZRJ(JL,JN,JKLP1) * ZTR(JL,JREF,JKL) |
366 |
|
33493824 |
ZRJ(JL,JN,JKL) = ZRE11 |
367 |
|
33527520 |
ZRK(JL,JN,JKL) = ZRE11 * ZREFZ(JL,JREF,JKL) |
368 |
|
|
ENDDO |
369 |
|
|
ENDDO |
370 |
|
|
ENDDO |
371 |
|
|
ENDDO |
372 |
|
|
|
373 |
|
|
! ------------------------------------------------------------------ |
374 |
|
|
|
375 |
|
|
!* 4. INVERT GREY AND CONTINUUM FLUXES |
376 |
|
|
! -------------------------------- |
377 |
|
|
|
378 |
|
|
!* 4.1 UPWARD (ZRK) AND DOWNWARD (ZRJ) PSEUDO-FLUXES |
379 |
|
|
! --------------------------------------------- |
380 |
|
|
|
381 |
✓✓ |
8856 |
DO JK = 1 , KLEV+1 |
382 |
✓✓ |
26136 |
DO JAJ = 1 , 5 , 2 |
383 |
|
25920 |
JAJP = JAJ + 1 |
384 |
✓✓ |
25799040 |
DO JL = KIDIA,KFDIA |
385 |
|
25764480 |
ZRJ(JL,JAJ,JK)= ZRJ(JL,JAJ,JK) - ZRJ(JL,JAJP,JK) |
386 |
|
25764480 |
ZRK(JL,JAJ,JK)= ZRK(JL,JAJ,JK) - ZRK(JL,JAJP,JK) |
387 |
|
25764480 |
ZRJ(JL,JAJ,JK)= MAX( ZRJ(JL,JAJ,JK) , REPLOG ) |
388 |
|
25790400 |
ZRK(JL,JAJ,JK)= MAX( ZRK(JL,JAJ,JK) , REPLOG ) |
389 |
|
|
ENDDO |
390 |
|
|
ENDDO |
391 |
|
|
ENDDO |
392 |
|
|
|
393 |
✓✓ |
8856 |
DO JK = 1 , KLEV+1 |
394 |
✓✓ |
26136 |
DO JAJ = 2 , 6 , 2 |
395 |
✓✓ |
25799040 |
DO JL = KIDIA,KFDIA |
396 |
|
25764480 |
ZRJ(JL,JAJ,JK)= MAX( ZRJ(JL,JAJ,JK) , REPLOG ) |
397 |
|
25790400 |
ZRK(JL,JAJ,JK)= MAX( ZRK(JL,JAJ,JK) , REPLOG ) |
398 |
|
|
ENDDO |
399 |
|
|
ENDDO |
400 |
|
|
ENDDO |
401 |
|
|
|
402 |
|
|
!* 4.2 EFFECTIVE ABSORBER AMOUNTS BY INVERSE LAPLACE |
403 |
|
|
! --------------------------------------------- |
404 |
|
|
|
405 |
✓✓ |
8856 |
DO JK = 1 , KLEV+1 |
406 |
|
|
JKKI = 1 |
407 |
✓✓ |
25920 |
DO JAJ = 1 , 2 |
408 |
|
17280 |
IIND2(1)=JAJ |
409 |
|
17280 |
IIND2(2)=JAJ |
410 |
✓✓ |
60480 |
DO JN = 1 , 2 |
411 |
|
34560 |
JN2J = JN + 2 * JAJ |
412 |
|
34560 |
JKKP4 = JKKI + 4 |
413 |
|
|
|
414 |
|
|
!* 4.2.1 EFFECTIVE ABSORBER AMOUNTS |
415 |
|
|
! -------------------------- |
416 |
|
|
|
417 |
✓✓ |
34387200 |
DO JL = KIDIA,KFDIA |
418 |
|
34352640 |
ZRR=1.0_JPRB/PAKI(JL,JAJ,KNU) |
419 |
|
34352640 |
ZRRJ=ZRJ(JL,JN,JK) / ZRJ(JL,JN2J,JK) |
420 |
|
34352640 |
ZRRK=ZRK(JL,JN,JK) / ZRK(JL,JN2J,JK) |
421 |
|
|
! ZW2(JL,1) = LOG( ZRRJ ) * ZRR |
422 |
|
|
! ZW2(JL,2) = LOG( ZRRK ) * ZRR |
423 |
|
|
!--correction Olivier Boucher based on ECMWF code |
424 |
|
34352640 |
ZW2(JL,1) = LOG( MAX(1.0_JPRB,ZRRJ) ) * ZRR |
425 |
|
34387200 |
ZW2(JL,2) = LOG( MAX(1.0_JPRB,ZRRK) ) * ZRR |
426 |
|
|
ENDDO |
427 |
|
|
|
428 |
|
|
!* 4.2.2 TRANSMISSION FUNCTION |
429 |
|
|
! --------------------- |
430 |
|
|
|
431 |
|
|
CALL SWTT1 ( KIDIA,KFDIA,KLON, KNU, 2, IIND2,& |
432 |
|
|
& ZW2,& |
433 |
|
34560 |
& ZR2 ) |
434 |
|
|
|
435 |
✓✓ |
34387200 |
DO JL = KIDIA,KFDIA |
436 |
|
34352640 |
ZRL(JL,JKKI) = ZR2(JL,1) |
437 |
|
34352640 |
ZRUEF(JL,JKKI) = ZW2(JL,1) |
438 |
|
34352640 |
ZRL(JL,JKKP4) = ZR2(JL,2) |
439 |
|
34387200 |
ZRUEF(JL,JKKP4) = ZW2(JL,2) |
440 |
|
|
ENDDO |
441 |
|
|
|
442 |
|
51840 |
JKKI=JKKI+1 |
443 |
|
|
ENDDO |
444 |
|
|
ENDDO |
445 |
|
|
|
446 |
|
|
!* 4.3 UPWARD AND DOWNWARD FLUXES WITH H2O AND UMG ABSORPTION |
447 |
|
|
! ------------------------------------------------------ |
448 |
|
|
|
449 |
✓✓ |
8597016 |
DO JL = KIDIA,KFDIA |
450 |
|
|
PFDOWN(JL,JK) = ZRJ(JL,1,JK) * ZRL(JL,1) * ZRL(JL,3)& |
451 |
|
8588160 |
& + ZRJ(JL,2,JK) * ZRL(JL,2) * ZRL(JL,4) |
452 |
|
|
PFUP(JL,JK) = ZRK(JL,1,JK) * ZRL(JL,5) * ZRL(JL,7)& |
453 |
|
8596800 |
& + ZRK(JL,2,JK) * ZRL(JL,6) * ZRL(JL,8) |
454 |
|
|
ENDDO |
455 |
|
|
! WRITE(*,'("---> Dans SWNI: ZRK1 ZRK2 ",2E12.5)') ZRK(1,1,JK),ZRK(1,2,JK) |
456 |
|
|
! WRITE(*,'("ZRK1 ZRL5 ZRL7 ",3E12.5)') ZRK(1,1,JK),ZRL(1,5),ZRL(1,7) |
457 |
|
|
! WRITE(*,'("ZRK2 ZRL6 ZRL8 ",3E12.5)') ZRK(1,2,JK),ZRL(1,6),ZRL(1,8) |
458 |
|
|
ENDDO |
459 |
|
|
|
460 |
|
|
! ------------------------------------------------------------------ |
461 |
|
|
|
462 |
|
|
!* 5. MOLECULAR ABSORPTION ON CLEAR-SKY FLUXES |
463 |
|
|
! ---------------------------------------- |
464 |
|
|
|
465 |
|
|
!* 5.1 DOWNWARD FLUXES |
466 |
|
|
! --------------- |
467 |
|
|
|
468 |
|
|
JAJ = 2 |
469 |
|
216 |
IIND3(1)=1 |
470 |
|
216 |
IIND3(2)=2 |
471 |
|
216 |
IIND3(3)=3 |
472 |
|
216 |
IIND3(4)=1 |
473 |
|
216 |
IIND3(5)=2 |
474 |
|
216 |
IIND3(6)=3 |
475 |
|
|
|
476 |
✓✓ |
214920 |
DO JL = KIDIA,KFDIA |
477 |
|
214704 |
ZW3(JL,1)=0.0_JPRB |
478 |
|
214704 |
ZW3(JL,2)=0.0_JPRB |
479 |
|
214704 |
ZW3(JL,3)=0.0_JPRB |
480 |
|
214704 |
ZW3(JL,4)=0.0_JPRB |
481 |
|
214704 |
ZW3(JL,5)=0.0_JPRB |
482 |
|
214704 |
ZW3(JL,6)=0.0_JPRB |
483 |
|
|
|
484 |
|
214704 |
ZW4(JL,1)=0.0_JPRB |
485 |
|
214704 |
ZW5(JL,1)=0.0_JPRB |
486 |
|
214704 |
ZR4(JL,1)=1.0_JPRB |
487 |
|
214704 |
ZW4(JL,2)=0.0_JPRB |
488 |
|
214704 |
ZW5(JL,2)=0.0_JPRB |
489 |
|
214704 |
ZR4(JL,2)=1.0_JPRB |
490 |
|
214920 |
ZFD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1) |
491 |
|
|
ENDDO |
492 |
✓✓ |
8640 |
DO JK = 1 , KLEV |
493 |
|
8424 |
IKL = KLEV+1-JK |
494 |
✓✓ |
8381880 |
DO JL = KIDIA,KFDIA |
495 |
|
8373456 |
ZRR=1.0_JPRB/ZRMU0(JL,IKL) |
496 |
|
8373456 |
ZW3(JL,1)=ZW3(JL,1)+PUD(JL,1,IKL)*ZRR |
497 |
|
8373456 |
ZW3(JL,2)=ZW3(JL,2)+PUD(JL,2,IKL)*ZRR |
498 |
|
8373456 |
ZW3(JL,3)=ZW3(JL,3)+POZ(JL, IKL)*ZRR |
499 |
|
8373456 |
ZW4(JL,1)=ZW4(JL,1)+PUD(JL,4,IKL)*ZRR |
500 |
|
8373456 |
ZW5(JL,1)=ZW5(JL,1)+PUD(JL,5,IKL)*ZRR |
501 |
|
|
|
502 |
|
8373456 |
ZRR=1.0_JPRB/ZRMUE(JL,IKL) |
503 |
|
8373456 |
ZW3(JL,4)=ZW3(JL,4)+PUD(JL,1,IKL)*ZRR |
504 |
|
8373456 |
ZW3(JL,5)=ZW3(JL,5)+PUD(JL,2,IKL)*ZRR |
505 |
|
8373456 |
ZW3(JL,6)=ZW3(JL,6)+POZ(JL, IKL)*ZRR |
506 |
|
8373456 |
ZW4(JL,2)=ZW4(JL,2)+PUD(JL,4,IKL)*ZRR |
507 |
|
8381880 |
ZW5(JL,2)=ZW5(JL,2)+PUD(JL,5,IKL)*ZRR |
508 |
|
|
ENDDO |
509 |
|
|
|
510 |
|
|
CALL SWTT1 ( KIDIA,KFDIA,KLON, KNU, 6, IIND3,& |
511 |
|
|
& ZW3,& |
512 |
|
8424 |
& ZR3 ) |
513 |
|
|
|
514 |
✓✓ |
8382096 |
DO JL = KIDIA,KFDIA |
515 |
|
8373456 |
ZR4(JL,1) = EXP(-RSWCE(KNU)*ZW4(JL,1)-RSWCP(KNU)*ZW5(JL,1)) |
516 |
|
8373456 |
ZR4(JL,2) = EXP(-RSWCE(KNU)*ZW4(JL,2)-RSWCP(KNU)*ZW5(JL,2)) |
517 |
|
8381880 |
ZFD(JL,IKL) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL,1)* ZRJ0(JL,JAJ,IKL) |
518 |
|
|
ENDDO |
519 |
|
|
ENDDO |
520 |
|
|
IF(LLDEBUG) THEN |
521 |
|
|
call writefield_phy('swni_zfd'//str1,ZFD,KLEV+1) |
522 |
|
|
call writefield_phy('swni_zrj0'//str1,ZRJ0(:,jaj,:),KLEV+1) |
523 |
|
|
ENDIF |
524 |
|
|
|
525 |
✓✓ |
214920 |
DO JL=KIDIA,KFDIA |
526 |
|
214704 |
ZDIFF(JL) = ZR3(JL,4)*ZR3(JL,5)*ZR3(JL,6)*ZR4(JL,2)*ZTRCLD(JL) |
527 |
|
214704 |
ZDIRF(JL) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL,1)*ZTRCLR(JL) |
528 |
|
|
PSUDU2(JL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)& |
529 |
|
214920 |
& +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU) |
530 |
|
|
ENDDO |
531 |
|
|
|
532 |
|
|
!* 5.2 UPWARD FLUXES |
533 |
|
|
! ------------- |
534 |
|
|
|
535 |
✓✓ |
214920 |
DO JL = KIDIA,KFDIA |
536 |
|
214920 |
ZFU(JL,1) = ZFD(JL,1)*PALBP(JL,KNU) |
537 |
|
|
ENDDO |
538 |
|
|
|
539 |
✓✓ |
8640 |
DO JK = 2 , KLEV+1 |
540 |
|
8424 |
IKM1=JK-1 |
541 |
✓✓ |
8381880 |
DO JL = KIDIA,KFDIA |
542 |
|
8373456 |
ZW3(JL,1)=ZW3(JL,1)+PUD(JL,1,IKM1)*1.66_JPRB |
543 |
|
8373456 |
ZW3(JL,2)=ZW3(JL,2)+PUD(JL,2,IKM1)*1.66_JPRB |
544 |
|
8373456 |
ZW3(JL,3)=ZW3(JL,3)+POZ(JL, IKM1)*1.66_JPRB |
545 |
|
8373456 |
ZW4(JL,1)=ZW4(JL,1)+PUD(JL,4,IKM1)*1.66_JPRB |
546 |
|
8381880 |
ZW5(JL,1)=ZW5(JL,1)+PUD(JL,5,IKM1)*1.66_JPRB |
547 |
|
|
ENDDO |
548 |
|
|
|
549 |
|
|
CALL SWTT1 ( KIDIA,KFDIA,KLON, KNU, 3, IIND3,& |
550 |
|
|
& ZW3,& |
551 |
|
8424 |
& ZR3 ) |
552 |
|
|
|
553 |
✓✓ |
8382096 |
DO JL = KIDIA,KFDIA |
554 |
|
8373456 |
ZR4(JL,1) = EXP(-RSWCE(KNU)*ZW4(JL,1)-RSWCP(KNU)*ZW5(JL,1)) |
555 |
|
8381880 |
ZFU(JL,JK) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL,1)* ZRK0(JL,JAJ,JK) |
556 |
|
|
ENDDO |
557 |
|
|
ENDDO |
558 |
|
|
|
559 |
|
|
! ------------------------------------------------------------------ |
560 |
|
|
|
561 |
|
|
!* 6. INTRODUCTION OF OZONE AND H2O CONTINUUM ABSORPTION |
562 |
|
|
! -------------------------------------------------- |
563 |
|
|
|
564 |
|
216 |
IABS=3 |
565 |
|
|
|
566 |
|
|
!* 6.1 DOWNWARD FLUXES |
567 |
|
|
! --------------- |
568 |
|
|
|
569 |
✓✓ |
214920 |
DO JL = KIDIA,KFDIA |
570 |
|
214704 |
ZW1(JL)=0.0_JPRB |
571 |
|
214704 |
ZW4(JL,1)=0.0_JPRB |
572 |
|
214704 |
ZW5(JL,1)=0.0_JPRB |
573 |
|
214704 |
ZR1(JL)=0.0_JPRB |
574 |
|
|
PFDOWN(JL,KLEV+1) = ((1.0_JPRB-PCLEAR(JL))*PFDOWN(JL,KLEV+1)& |
575 |
|
214704 |
& + PCLEAR(JL) * ZFD(JL,KLEV+1)) * RSUN(KNU) |
576 |
|
214920 |
PCDOWN(JL,KLEV+1) = ZFD(JL,KLEV+1) * RSUN(KNU) |
577 |
|
|
ENDDO |
578 |
|
|
|
579 |
✓✓ |
8640 |
DO JK = 1 , KLEV |
580 |
|
8424 |
IKL=KLEV+1-JK |
581 |
✓✓ |
8381880 |
DO JL = KIDIA,KFDIA |
582 |
|
8373456 |
ZRR=1.0_JPRB/ZRMUE(JL,IKL) |
583 |
|
8373456 |
ZW1(JL) = ZW1(JL)+POZ(JL, IKL) * ZRR |
584 |
|
8373456 |
ZW4(JL,1) = ZW4(JL,1)+PUD(JL,4,IKL) * ZRR |
585 |
|
8373456 |
ZW5(JL,1) = ZW5(JL,1)+PUD(JL,5,IKL) * ZRR |
586 |
|
8381880 |
ZR4(JL,1) = EXP(-RSWCE(KNU)*ZW4(JL,1)-RSWCP(KNU)*ZW5(JL,1)) |
587 |
|
|
ENDDO |
588 |
|
|
|
589 |
|
8424 |
CALL SWTT ( KIDIA,KFDIA,KLON, KNU, IABS, ZW1, ZR1 ) |
590 |
|
|
|
591 |
✓✓ |
8382096 |
DO JL = KIDIA,KFDIA |
592 |
|
8373456 |
PDIFF(JL,IKL)=ZR1(JL)*ZR4(JL,1)*PFDOWN(JL,IKL)*RSUN(KNU)*(1.0_JPRB-PCLEAR(JL)) |
593 |
|
8373456 |
PDIRF(JL,IKL)=ZFD(JL,IKL)*RSUN(KNU)* PCLEAR(JL) |
594 |
|
|
PFDOWN(JL,IKL) = ((1.0_JPRB-PCLEAR(JL))*ZR1(JL)*ZR4(JL,1)*PFDOWN(JL,IKL)& |
595 |
|
8373456 |
& +PCLEAR(JL)*ZFD(JL,IKL)) * RSUN(KNU) |
596 |
|
8381880 |
PCDOWN(JL,IKL) = ZFD(JL,IKL) * RSUN(KNU) |
597 |
|
|
ENDDO |
598 |
|
|
ENDDO |
599 |
|
|
|
600 |
|
|
!* 6.2 UPWARD FLUXES |
601 |
|
|
! ------------- |
602 |
|
|
|
603 |
✓✓ |
214920 |
DO JL = KIDIA,KFDIA |
604 |
|
|
PFUP(JL,1) = ((1.0_JPRB-PCLEAR(JL))*ZR1(JL)*ZR4(JL,1) * PFUP(JL,1)& |
605 |
|
214704 |
& +PCLEAR(JL)*ZFU(JL,1)) * RSUN(KNU) |
606 |
|
214920 |
PCUP(JL,1) = ZFU(JL,1) * RSUN(KNU) |
607 |
|
|
ENDDO |
608 |
|
|
|
609 |
✓✓ |
8640 |
DO JK = 2 , KLEV+1 |
610 |
|
8424 |
IKM1=JK-1 |
611 |
✓✓ |
8381880 |
DO JL = KIDIA,KFDIA |
612 |
|
8373456 |
ZW1(JL) = ZW1(JL)+POZ(JL ,IKM1)*1.66_JPRB |
613 |
|
8373456 |
ZW4(JL,1) = ZW4(JL,1)+PUD(JL,4,IKM1)*1.66_JPRB |
614 |
|
8373456 |
ZW5(JL,1) = ZW5(JL,1)+PUD(JL,5,IKM1)*1.66_JPRB |
615 |
|
8381880 |
ZR4(JL,1) = EXP(-RSWCE(KNU)*ZW4(JL,1)-RSWCP(KNU)*ZW5(JL,1)) |
616 |
|
|
ENDDO |
617 |
|
|
|
618 |
|
8424 |
CALL SWTT ( KIDIA,KFDIA,KLON, KNU, IABS, ZW1, ZR1 ) |
619 |
|
|
|
620 |
✓✓ |
8382096 |
DO JL = KIDIA,KFDIA |
621 |
|
|
PFUP(JL,JK) = ((1.0_JPRB-PCLEAR(JL))*ZR1(JL)*ZR4(JL,1) * PFUP(JL,JK)& |
622 |
|
8373456 |
& +PCLEAR(JL)*ZFU(JL,JK)) * RSUN(KNU) |
623 |
|
8381880 |
PCUP(JL,JK) = ZFU(JL,JK) * RSUN(KNU) |
624 |
|
|
ENDDO |
625 |
|
|
ENDDO |
626 |
|
|
|
627 |
|
|
IF(LLDEBUG) THEN |
628 |
|
|
call writefield_phy('swni_zfd_fin'//str1,ZFD,KLEV+1) |
629 |
|
|
call writefield_phy('swni_pcdown'//str1,PCDOWN,KLEV+1) |
630 |
|
|
ENDIF |
631 |
|
|
! ------------------------------------------------------------------ |
632 |
|
|
|
633 |
✓✗ |
216 |
IF (LHOOK) CALL DR_HOOK('SWNI',1,ZHOOK_HANDLE) |
634 |
|
216 |
END SUBROUTINE SWNI |