GCC Code Coverage Report


Directory: ./
File: rad/srtm_spcvrt.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 102 0.0%
Branches: 0 44 0.0%

Line Branch Exec Source
1 SUBROUTINE SRTM_SPCVRT &
2 & ( KLEV , KMOL , KSW , PONEMINUS, &
3 & PAVEL , PTAVEL , PZ , PTZ , PTBOUND , PALBD , PALBP, &
4 & PFRCL , PTAUC , PASYC , POMGC , PTAUA , PASYA , POMGA , PRMU0, &
5 & PCOLDRY , PWKL, &
6 & KLAYTROP, KLAYSWTCH, KLAYLOW ,&
7 & PCO2MULT, PCOLCH4 , PCOLCO2 , PCOLH2O , PCOLMOL , PCOLN2O , PCOLO2 , PCOLO3 ,&
8 & PFORFAC , PFORFRAC , KINDFOR , PSELFFAC, PSELFFRAC, KINDSELF ,&
9 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
10 & KJP , KJT , KJT1 ,&
11 !-- output arrays
12 & PBBFD, PBBFU, PUVFD, PUVFU, PVSFD, PVSFU , PNIFD , PNIFU ,&
13 & PBBCD, PBBCU, PUVCD, PUVCU, PVSCD, PVSCU , PNICD , PNICU &
14 & )
15
16 !**** *SRTM_SPCVRT* - SPECTRAL LOOP TO COMPUTE THE SHORTWAVE RADIATION FLUXES.
17
18 ! PURPOSE.
19 ! --------
20
21 ! THIS ROUTINE COMPUTES THE TWO-STREAM METHOD OF BARKER
22
23 !** INTERFACE.
24 ! ----------
25
26 ! *SRTM_SPCVRT* IS CALLED FROM *SRTM_SRTM_224GP*
27
28 ! IMPLICIT ARGUMENTS :
29 ! --------------------
30
31 ! ==== INPUTS ===
32 ! ==== OUTPUTS ===
33
34 ! METHOD.
35 ! -------
36
37 ! EXTERNALS.
38 ! ----------
39
40 ! *SWVRTQDR*
41
42 ! REFERENCE.
43 ! ----------
44
45 ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
46 ! DOCUMENTATION
47 ! AUTHOR.
48 ! -------
49 ! from Howard Barker
50 ! JEAN-JACQUES MORCRETTE *ECMWF*
51
52 ! MODIFICATIONS.
53 ! --------------
54 ! ORIGINAL : 03-02-27
55 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
56 ! ------------------------------------------------------------------
57
58 USE PARKIND1 ,ONLY : JPIM ,JPRB
59 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
60
61 USE PARSRTM , ONLY : JPLAY, JPB1, JPB2, JPGPT
62
63 USE YOESRTWN , ONLY : NGC
64 USE YOERDI , ONLY : REPCLC
65
66 !USE YOERAD , ONLY : NSW
67 !USE YOERDU , ONLY : RCDAY
68 !USE YOESWN , ONLY : NTBANDS, NBANDS, NGS, NUV, NVS, RWGT, NDBUG
69
70 IMPLICIT NONE
71
72 ! ------------------------------------------------------------------
73
74 !* 0.1 ARGUMENTS
75 ! ---------
76
77 INTEGER(KIND=JPIM),INTENT(IN) :: KSW
78 INTEGER(KIND=JPIM) :: KLEV ! UNDETERMINED INTENT
79 INTEGER(KIND=JPIM) :: KMOL ! Argument NOT used
80 REAL(KIND=JPRB) :: PONEMINUS ! UNDETERMINED INTENT
81 REAL(KIND=JPRB) :: PAVEL(JPLAY) ! Argument NOT used
82 REAL(KIND=JPRB) :: PTAVEL(JPLAY) ! Argument NOT used
83 REAL(KIND=JPRB) :: PZ(0:JPLAY) ! Argument NOT used
84 REAL(KIND=JPRB) :: PTZ(0:JPLAY) ! Argument NOT used
85 REAL(KIND=JPRB) :: PTBOUND ! Argument NOT used
86 REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KSW)
87 REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KSW)
88 REAL(KIND=JPRB) ,INTENT(IN) :: PFRCL(JPLAY) ! bottom to top
89 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUC(JPLAY,KSW) ! bottom to top
90 REAL(KIND=JPRB) ,INTENT(IN) :: PASYC(JPLAY,KSW) ! bottom to top
91 REAL(KIND=JPRB) ,INTENT(IN) :: POMGC(JPLAY,KSW) ! bottom to top
92 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUA(JPLAY,KSW) ! bottom to top
93 REAL(KIND=JPRB) ,INTENT(IN) :: PASYA(JPLAY,KSW) ! bottom to top
94 REAL(KIND=JPRB) ,INTENT(IN) :: POMGA(JPLAY,KSW) ! bottom to top
95 REAL(KIND=JPRB) :: PRMU0 ! UNDETERMINED INTENT
96 REAL(KIND=JPRB) :: PCOLDRY(JPLAY) ! Argument NOT used
97 REAL(KIND=JPRB) :: PWKL(35,JPLAY) ! Argument NOT used
98 INTEGER(KIND=JPIM) :: KLAYTROP ! UNDETERMINED INTENT
99 INTEGER(KIND=JPIM) :: KLAYSWTCH ! Argument NOT used
100 INTEGER(KIND=JPIM) :: KLAYLOW ! Argument NOT used
101 REAL(KIND=JPRB) :: PCO2MULT(JPLAY) ! Argument NOT used
102 REAL(KIND=JPRB) :: PCOLCH4(JPLAY) ! UNDETERMINED INTENT
103 REAL(KIND=JPRB) :: PCOLCO2(JPLAY) ! UNDETERMINED INTENT
104 REAL(KIND=JPRB) :: PCOLH2O(JPLAY) ! UNDETERMINED INTENT
105 REAL(KIND=JPRB) :: PCOLMOL(JPLAY) ! UNDETERMINED INTENT
106 REAL(KIND=JPRB) :: PCOLN2O(JPLAY) ! Argument NOT used
107 REAL(KIND=JPRB) :: PCOLO2(JPLAY) ! UNDETERMINED INTENT
108 REAL(KIND=JPRB) :: PCOLO3(JPLAY) ! UNDETERMINED INTENT
109 REAL(KIND=JPRB) :: PFORFAC(JPLAY) ! UNDETERMINED INTENT
110 REAL(KIND=JPRB) :: PFORFRAC(JPLAY) ! UNDETERMINED INTENT
111 INTEGER(KIND=JPIM) :: KINDFOR(JPLAY) ! UNDETERMINED INTENT
112 REAL(KIND=JPRB) :: PSELFFAC(JPLAY) ! UNDETERMINED INTENT
113 REAL(KIND=JPRB) :: PSELFFRAC(JPLAY) ! UNDETERMINED INTENT
114 INTEGER(KIND=JPIM) :: KINDSELF(JPLAY) ! UNDETERMINED INTENT
115 REAL(KIND=JPRB) :: PFAC00(JPLAY) ! UNDETERMINED INTENT
116 REAL(KIND=JPRB) :: PFAC01(JPLAY) ! UNDETERMINED INTENT
117 REAL(KIND=JPRB) :: PFAC10(JPLAY) ! UNDETERMINED INTENT
118 REAL(KIND=JPRB) :: PFAC11(JPLAY) ! UNDETERMINED INTENT
119 INTEGER(KIND=JPIM) :: KJP(JPLAY) ! UNDETERMINED INTENT
120 INTEGER(KIND=JPIM) :: KJT(JPLAY) ! UNDETERMINED INTENT
121 INTEGER(KIND=JPIM) :: KJT1(JPLAY) ! UNDETERMINED INTENT
122 REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBFD(JPLAY+1)
123 REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBFU(JPLAY+1)
124 REAL(KIND=JPRB) :: PUVFD(JPLAY+1) ! Argument NOT used
125 REAL(KIND=JPRB) :: PUVFU(JPLAY+1) ! Argument NOT used
126 REAL(KIND=JPRB) :: PVSFD(JPLAY+1) ! Argument NOT used
127 REAL(KIND=JPRB) :: PVSFU(JPLAY+1) ! Argument NOT used
128 REAL(KIND=JPRB) :: PNIFD(JPLAY+1) ! Argument NOT used
129 REAL(KIND=JPRB) :: PNIFU(JPLAY+1) ! Argument NOT used
130 REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBCD(JPLAY+1)
131 REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBCU(JPLAY+1)
132 REAL(KIND=JPRB) :: PUVCD(JPLAY+1) ! Argument NOT used
133 REAL(KIND=JPRB) :: PUVCU(JPLAY+1) ! Argument NOT used
134 REAL(KIND=JPRB) :: PVSCD(JPLAY+1) ! Argument NOT used
135 REAL(KIND=JPRB) :: PVSCU(JPLAY+1) ! Argument NOT used
136 REAL(KIND=JPRB) :: PNICD(JPLAY+1) ! Argument NOT used
137 REAL(KIND=JPRB) :: PNICU(JPLAY+1) ! Argument NOT used
138 ! ------------------------------------------------------------------
139
140 ! ------------
141
142 LOGICAL :: LLRTCHK(JPLAY)
143
144 REAL(KIND=JPRB) :: &
145 & ZCLEAR , ZCLOUD &
146 & , ZDBT(JPLAY+1) &
147 & , ZGCC(JPLAY) , ZGCO(JPLAY) &
148 & , ZOMCC(JPLAY) , ZOMCO(JPLAY) &
149 & , ZRDND(JPLAY+1), ZRDNDC(JPLAY+1)&
150 & , ZREF(JPLAY+1) , ZREFC(JPLAY+1) , ZREFO(JPLAY+1) &
151 & , ZREFD(JPLAY+1), ZREFDC(JPLAY+1), ZREFDO(JPLAY+1) &
152 & , ZRUP(JPLAY+1) , ZRUPD(JPLAY+1) &
153 & , ZRUPC(JPLAY+1), ZRUPDC(JPLAY+1)&
154 & , ZTAUC(JPLAY) , ZTAUO(JPLAY) &
155 & , ZTDBT(JPLAY+1) &
156 & , ZTRA(JPLAY+1) , ZTRAC(JPLAY+1) , ZTRAO(JPLAY+1) &
157 & , ZTRAD(JPLAY+1), ZTRADC(JPLAY+1), ZTRADO(JPLAY+1)
158 REAL(KIND=JPRB) :: &
159 & ZDBTC(JPLAY+1), ZTDBTC(JPLAY+1), ZINCFLX(JPGPT) &
160 & , ZINCF14(14) , ZINCTOT
161
162 INTEGER(KIND=JPIM) :: IB1, IB2, IBM, IGT, IKL, IW, JB, JG, JK, I_KMODTS
163
164 REAL(KIND=JPRB) :: ZDBTMC, ZDBTMO, ZF, ZINCFLUX, ZWF
165
166 !-- Output of SRTM_TAUMOLn routines
167
168 REAL(KIND=JPRB) :: ZTAUG(JPLAY,16), ZTAUR(JPLAY,16), ZSFLXZEN(16)
169
170 !-- Output of SRTM_VRTQDR routine
171 REAL(KIND=JPRB) :: &
172 & ZCD(JPLAY+1,JPGPT), ZCU(JPLAY+1,JPGPT) &
173 & , ZFD(JPLAY+1,JPGPT), ZFU(JPLAY+1,JPGPT)
174 REAL(KIND=JPRB) :: ZHOOK_HANDLE
175
176
177 INTERFACE
178 SUBROUTINE SRTM_TAUMOL16&
179 & ( KLEV,&
180 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
181 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
182 & P_COLH2O , P_COLCH4 , P_COLMOL,&
183 & K_LAYTROP , P_SELFFAC , P_SELFFRAC, K_INDSELF , P_FORFAC , P_FORFRAC, K_INDFOR,&
184 & P_SFLUXZEN, P_TAUG , P_TAUR&
185 & )
186 USE PARKIND1 ,ONLY : JPIM ,JPRB
187 USE PARSRTM , ONLY : JPLAY, JPG, NG16
188 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
189 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
190 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
191 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
192 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
193 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
194 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
195 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
196 REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
197 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
198 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCH4(JPLAY)
199 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
200 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
201 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
202 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
203 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
204 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
205 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(JPLAY)
206 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(JPLAY)
207 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
208 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
209 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
210 END SUBROUTINE SRTM_TAUMOL16
211 END INTERFACE
212 INTERFACE
213 SUBROUTINE SRTM_TAUMOL17&
214 & ( KLEV,&
215 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
216 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
217 & P_COLH2O , P_COLCO2 , P_COLMOL,&
218 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
219 & P_SFLUXZEN, P_TAUG , P_TAUR&
220 & )
221 USE PARKIND1 ,ONLY : JPIM ,JPRB
222 USE PARSRTM , ONLY : JPLAY, JPG, NG17
223 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
224 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
225 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
226 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
227 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
228 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
229 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
230 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
231 REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
232 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
233 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(JPLAY)
234 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
235 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
236 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
237 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
238 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
239 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
240 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(JPLAY)
241 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(JPLAY)
242 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
243 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
244 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
245 END SUBROUTINE SRTM_TAUMOL17
246 END INTERFACE
247 INTERFACE
248 SUBROUTINE SRTM_TAUMOL18&
249 & ( KLEV,&
250 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
251 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
252 & P_COLH2O , P_COLCH4 , P_COLMOL,&
253 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
254 & P_SFLUXZEN, P_TAUG , P_TAUR&
255 & )
256 USE PARKIND1 ,ONLY : JPIM ,JPRB
257 USE PARSRTM , ONLY : JPLAY, JPG, NG18
258 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
259 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
260 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
261 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
262 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
263 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
264 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
265 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
266 REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
267 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
268 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCH4(JPLAY)
269 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
270 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
271 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
272 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
273 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
274 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
275 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(JPLAY)
276 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(JPLAY)
277 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
278 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
279 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
280 END SUBROUTINE SRTM_TAUMOL18
281 END INTERFACE
282 INTERFACE
283 SUBROUTINE SRTM_TAUMOL19&
284 & ( KLEV,&
285 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
286 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
287 & P_COLH2O , P_COLCO2 , P_COLMOL,&
288 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
289 & P_SFLUXZEN, P_TAUG , P_TAUR&
290 & )
291 USE PARKIND1 ,ONLY : JPIM ,JPRB
292 USE PARSRTM , ONLY : JPLAY, JPG, NG19
293 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
294 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
295 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
296 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
297 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
298 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
299 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
300 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
301 REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
302 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
303 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(JPLAY)
304 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
305 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
306 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
307 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
308 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
309 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
310 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(JPLAY)
311 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(JPLAY)
312 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
313 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
314 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
315 END SUBROUTINE SRTM_TAUMOL19
316 END INTERFACE
317 INTERFACE
318 SUBROUTINE SRTM_TAUMOL20&
319 & ( KLEV,&
320 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
321 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
322 & P_COLH2O , P_COLCH4 , P_COLMOL,&
323 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
324 & P_SFLUXZEN, P_TAUG , P_TAUR&
325 & )
326 USE PARKIND1 ,ONLY : JPIM ,JPRB
327 USE PARSRTM , ONLY : JPLAY, JPG, NG20
328 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
329 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
330 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
331 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
332 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
333 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
334 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
335 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
336 REAL(KIND=JPRB) :: P_ONEMINUS
337 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
338 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCH4(JPLAY)
339 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
340 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
341 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
342 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
343 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
344 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
345 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(JPLAY)
346 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(JPLAY)
347 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
348 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
349 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
350 END SUBROUTINE SRTM_TAUMOL20
351 END INTERFACE
352 INTERFACE
353 SUBROUTINE SRTM_TAUMOL21&
354 & ( KLEV,&
355 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
356 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
357 & P_COLH2O , P_COLCO2 , P_COLMOL,&
358 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
359 & P_SFLUXZEN, P_TAUG , P_TAUR&
360 & )
361 USE PARKIND1 ,ONLY : JPIM ,JPRB
362 USE PARSRTM , ONLY : JPLAY, JPG, NG21
363 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
364 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
365 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
366 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
367 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
368 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
369 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
370 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
371 REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
372 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
373 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(JPLAY)
374 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
375 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
376 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
377 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
378 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
379 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
380 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(JPLAY)
381 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(JPLAY)
382 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
383 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
384 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
385 END SUBROUTINE SRTM_TAUMOL21
386 END INTERFACE
387 INTERFACE
388 SUBROUTINE SRTM_TAUMOL22&
389 & ( KLEV,&
390 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
391 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
392 & P_COLH2O , P_COLMOL , P_COLO2,&
393 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
394 & P_SFLUXZEN, P_TAUG , P_TAUR&
395 & )
396 USE PARKIND1 ,ONLY : JPIM ,JPRB
397 USE PARSRTM , ONLY : JPLAY, JPG, NG22
398 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
399 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
400 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
401 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
402 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
403 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
404 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
405 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
406 REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
407 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
408 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
409 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO2(JPLAY)
410 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
411 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
412 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
413 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
414 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
415 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(JPLAY)
416 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(JPLAY)
417 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
418 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
419 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
420 END SUBROUTINE SRTM_TAUMOL22
421 END INTERFACE
422 INTERFACE
423 SUBROUTINE SRTM_TAUMOL23&
424 & ( KLEV,&
425 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
426 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
427 & P_COLH2O , P_COLMOL,&
428 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
429 & P_SFLUXZEN, P_TAUG , P_TAUR&
430 & )
431 USE PARKIND1 ,ONLY : JPIM ,JPRB
432 USE PARSRTM , ONLY : JPLAY, JPG, NG23
433 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
434 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
435 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
436 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
437 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
438 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
439 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
440 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
441 REAL(KIND=JPRB) :: P_ONEMINUS
442 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
443 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
444 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
445 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
446 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
447 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
448 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
449 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(JPLAY)
450 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(JPLAY)
451 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
452 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
453 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
454 END SUBROUTINE SRTM_TAUMOL23
455 END INTERFACE
456 INTERFACE
457 SUBROUTINE SRTM_TAUMOL24&
458 & ( KLEV,&
459 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
460 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
461 & P_COLH2O , P_COLMOL , P_COLO2 , P_COLO3,&
462 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
463 & P_SFLUXZEN, P_TAUG , P_TAUR&
464 & )
465 USE PARKIND1 ,ONLY : JPIM ,JPRB
466 USE PARSRTM , ONLY : JPLAY, JPG, NG24
467 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
468 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
469 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
470 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
471 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
472 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
473 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
474 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
475 REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
476 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
477 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
478 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO2(JPLAY)
479 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(JPLAY)
480 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
481 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
482 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
483 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
484 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
485 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(JPLAY)
486 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(JPLAY)
487 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
488 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
489 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
490 END SUBROUTINE SRTM_TAUMOL24
491 END INTERFACE
492 INTERFACE
493 SUBROUTINE SRTM_TAUMOL25&
494 & ( KLEV,&
495 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
496 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
497 & P_COLH2O , P_COLMOL , P_COLO3,&
498 & K_LAYTROP,&
499 & P_SFLUXZEN, P_TAUG , P_TAUR&
500 & )
501 USE PARKIND1 ,ONLY : JPIM ,JPRB
502 USE PARSRTM , ONLY : JPLAY, JPG, NG25
503 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
504 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
505 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
506 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
507 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
508 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
509 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
510 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
511 REAL(KIND=JPRB) :: P_ONEMINUS
512 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
513 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
514 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(JPLAY)
515 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
516 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
517 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
518 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
519 END SUBROUTINE SRTM_TAUMOL25
520 END INTERFACE
521 INTERFACE
522 SUBROUTINE SRTM_TAUMOL26&
523 & ( KLEV,&
524 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
525 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
526 & P_COLH2O , P_COLCO2 , P_COLMOL,&
527 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
528 & P_SFLUXZEN, P_TAUG , P_TAUR&
529 & )
530 USE PARKIND1 ,ONLY : JPIM ,JPRB
531 USE PARSRTM , ONLY : JPLAY, JPG, NG26
532 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
533 REAL(KIND=JPRB) :: P_FAC00(JPLAY)
534 REAL(KIND=JPRB) :: P_FAC01(JPLAY)
535 REAL(KIND=JPRB) :: P_FAC10(JPLAY)
536 REAL(KIND=JPRB) :: P_FAC11(JPLAY)
537 INTEGER(KIND=JPIM) :: K_JP(JPLAY)
538 INTEGER(KIND=JPIM) :: K_JT(JPLAY)
539 INTEGER(KIND=JPIM) :: K_JT1(JPLAY)
540 REAL(KIND=JPRB) :: P_ONEMINUS
541 REAL(KIND=JPRB) :: P_COLH2O(JPLAY)
542 REAL(KIND=JPRB) :: P_COLCO2(JPLAY)
543 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
544 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
545 REAL(KIND=JPRB) :: P_SELFFAC(JPLAY)
546 REAL(KIND=JPRB) :: P_SELFFRAC(JPLAY)
547 INTEGER(KIND=JPIM) :: K_INDSELF(JPLAY)
548 REAL(KIND=JPRB) :: P_FORFAC(JPLAY)
549 REAL(KIND=JPRB) :: P_FORFRAC(JPLAY)
550 INTEGER(KIND=JPIM) :: K_INDFOR(JPLAY)
551 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
552 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
553 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
554 END SUBROUTINE SRTM_TAUMOL26
555 END INTERFACE
556 INTERFACE
557 SUBROUTINE SRTM_TAUMOL27&
558 & ( KLEV,&
559 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
560 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
561 & P_COLMOL , P_COLO3,&
562 & K_LAYTROP,&
563 & P_SFLUXZEN, P_TAUG , P_TAUR&
564 & )
565 USE PARKIND1 ,ONLY : JPIM ,JPRB
566 USE PARSRTM , ONLY : JPLAY, JPG, NG27
567 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
568 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
569 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
570 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
571 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
572 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
573 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
574 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
575 REAL(KIND=JPRB) :: P_ONEMINUS
576 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
577 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(JPLAY)
578 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
579 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
580 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
581 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
582 END SUBROUTINE SRTM_TAUMOL27
583 END INTERFACE
584 INTERFACE
585 SUBROUTINE SRTM_TAUMOL28&
586 & ( KLEV,&
587 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
588 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
589 & P_COLMOL , P_COLO2 , P_COLO3,&
590 & K_LAYTROP,&
591 & P_SFLUXZEN, P_TAUG , P_TAUR&
592 & )
593 USE PARKIND1 ,ONLY : JPIM ,JPRB
594 USE PARSRTM , ONLY : JPLAY, JPG, NG28
595 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
596 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
597 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
598 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
599 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
600 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
601 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
602 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
603 REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
604 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
605 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO2(JPLAY)
606 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(JPLAY)
607 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
608 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
609 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
610 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
611 END SUBROUTINE SRTM_TAUMOL28
612 END INTERFACE
613 INTERFACE
614 SUBROUTINE SRTM_TAUMOL29&
615 & ( KLEV,&
616 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
617 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
618 & P_COLH2O , P_COLCO2 , P_COLMOL,&
619 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
620 & P_SFLUXZEN, P_TAUG , P_TAUR&
621 & )
622 USE PARKIND1 ,ONLY : JPIM ,JPRB
623 USE PARSRTM , ONLY : JPLAY, JPG, NG29
624 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
625 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
626 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
627 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
628 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
629 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
630 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
631 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
632 REAL(KIND=JPRB) :: P_ONEMINUS
633 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
634 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(JPLAY)
635 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
636 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
637 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
638 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
639 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
640 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
641 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(JPLAY)
642 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(JPLAY)
643 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
644 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
645 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
646 END SUBROUTINE SRTM_TAUMOL29
647 END INTERFACE
648 INTERFACE
649 SUBROUTINE SRTM_REFTRA&
650 & ( KLEV , KMODTS,&
651 & LDRTCHK,&
652 & PGG , PRMUZ, PTAU , PW,&
653 & PREF , PREFD, PTRA , PTRAD&
654 & )
655 USE PARKIND1 ,ONLY : JPIM ,JPRB
656 USE PARSRTM , ONLY : JPLAY
657 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
658 INTEGER(KIND=JPIM),INTENT(OUT) :: KMODTS
659 LOGICAL ,INTENT(IN) :: LDRTCHK(JPLAY)
660 REAL(KIND=JPRB) ,INTENT(IN) :: PGG(JPLAY)
661 REAL(KIND=JPRB) ,INTENT(IN) :: PRMUZ
662 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU(JPLAY)
663 REAL(KIND=JPRB) ,INTENT(IN) :: PW(JPLAY)
664 REAL(KIND=JPRB) ,INTENT(INOUT) :: PREF(JPLAY)
665 REAL(KIND=JPRB) ,INTENT(INOUT) :: PREFD(JPLAY)
666 REAL(KIND=JPRB) ,INTENT(INOUT) :: PTRA(JPLAY)
667 REAL(KIND=JPRB) ,INTENT(INOUT) :: PTRAD(JPLAY)
668 END SUBROUTINE SRTM_REFTRA
669 END INTERFACE
670 INTERFACE
671 SUBROUTINE SRTM_VRTQDR&
672 & ( KLEV , KW,&
673 & PREF , PREFD, PTRA , PTRAD,&
674 & PDBT , PRDND, PRUP , PRUPD , PTDBT,&
675 & PFD , PFU&
676 & )
677 USE PARKIND1 ,ONLY : JPIM ,JPRB
678 USE PARSRTM , ONLY : JPLAY, JPGPT
679 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
680 INTEGER(KIND=JPIM),INTENT(IN) :: KW
681 REAL(KIND=JPRB) ,INTENT(IN) :: PREF(JPLAY+1)
682 REAL(KIND=JPRB) ,INTENT(IN) :: PREFD(JPLAY+1)
683 REAL(KIND=JPRB) ,INTENT(IN) :: PTRA(JPLAY+1)
684 REAL(KIND=JPRB) ,INTENT(IN) :: PTRAD(JPLAY+1)
685 REAL(KIND=JPRB) ,INTENT(IN) :: PDBT(JPLAY+1)
686 REAL(KIND=JPRB) ,INTENT(OUT) :: PRDND(JPLAY+1)
687 REAL(KIND=JPRB) ,INTENT(INOUT) :: PRUP(JPLAY+1)
688 REAL(KIND=JPRB) ,INTENT(INOUT) :: PRUPD(JPLAY+1)
689 REAL(KIND=JPRB) ,INTENT(IN) :: PTDBT(JPLAY+1)
690 REAL(KIND=JPRB) ,INTENT(INOUT) :: PFD(JPLAY+1,JPGPT)
691 REAL(KIND=JPRB) ,INTENT(INOUT) :: PFU(JPLAY+1,JPGPT)
692 END SUBROUTINE SRTM_VRTQDR
693 END INTERFACE
694 ! ------------------------------------------------------------------
695 IF (LHOOK) CALL DR_HOOK('SRTM_SPCVRT',0,ZHOOK_HANDLE)
696
697 !-- Two-stream model 1: Eddington, 2: PIFM, Zdunkowski et al., 3: discret ordinates
698 ! KMODTS is set in SWREFTRA
699 !NDBUG=4
700
701 IB1=JPB1
702 IB2=JPB2
703 !print *,'IB1, IB2, KSW, KMOL, KLEV: ', IB1,IB2,KSW,KMOL,KLEV
704
705 IW=0
706 ZINCFLUX=0.0_JPRB
707 ZINCTOT=0.0_JPRB
708
709 JB=IB1-1
710 DO JB = IB1, IB2
711 IBM = JB-15
712 IGT = NGC(IBM)
713 ZINCF14(IBM)=0.0_JPRB
714
715 ! print *,'=== spectral band === JB= ',JB,' ====== i.e. IBM= ',IBM,' with IGT= ',IGT
716
717 !-- for each band, computes the gaseous and Rayleigh optical thickness
718 ! for all g-points within the band
719
720 IF (JB == 16) THEN
721 CALL SRTM_TAUMOL16 &
722 & ( KLEV ,&
723 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
724 & KJP , KJT , KJT1 , PONEMINUS,&
725 & PCOLH2O , PCOLCH4 , PCOLMOL ,&
726 & KLAYTROP, PSELFFAC , PSELFFRAC, KINDSELF, PFORFAC , PFORFRAC, KINDFOR ,&
727 & ZSFLXZEN, ZTAUG , ZTAUR &
728 & )
729 ! print *,'After SRTM_TAUMOL16'
730
731 ELSEIF (JB == 17) THEN
732 CALL SRTM_TAUMOL17 &
733 & ( KLEV ,&
734 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
735 & KJP , KJT , KJT1 , PONEMINUS ,&
736 & PCOLH2O , PCOLCO2 , PCOLMOL ,&
737 & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
738 & ZSFLXZEN, ZTAUG , ZTAUR &
739 & )
740 ! print *,'After SRTM_TAUMOL17'
741
742 ELSEIF (JB == 18) THEN
743 CALL SRTM_TAUMOL18 &
744 & ( KLEV ,&
745 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
746 & KJP , KJT , KJT1 , PONEMINUS ,&
747 & PCOLH2O , PCOLCH4 , PCOLMOL ,&
748 & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
749 & ZSFLXZEN, ZTAUG , ZTAUR &
750 & )
751 ! print *,'After SRTM_TAUMOL18'
752
753 ELSEIF (JB == 19) THEN
754 CALL SRTM_TAUMOL19 &
755 & ( KLEV ,&
756 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
757 & KJP , KJT , KJT1 , PONEMINUS ,&
758 & PCOLH2O , PCOLCO2 , PCOLMOL ,&
759 & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
760 & ZSFLXZEN, ZTAUG , ZTAUR &
761 & )
762 ! print *,'After SRTM_TAUMOL19'
763
764 ELSEIF (JB == 20) THEN
765 CALL SRTM_TAUMOL20 &
766 & ( KLEV ,&
767 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
768 & KJP , KJT , KJT1 , PONEMINUS ,&
769 & PCOLH2O , PCOLCH4 , PCOLMOL ,&
770 & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
771 & ZSFLXZEN, ZTAUG , ZTAUR &
772 & )
773 ! print *,'After SRTM_TAUMOL20'
774
775 ELSEIF (JB == 21) THEN
776 CALL SRTM_TAUMOL21 &
777 & ( KLEV ,&
778 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
779 & KJP , KJT , KJT1 , PONEMINUS ,&
780 & PCOLH2O , PCOLCO2 , PCOLMOL ,&
781 & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
782 & ZSFLXZEN, ZTAUG , ZTAUR &
783 & )
784 ! print *,'After SRTM_TAUMOL21'
785
786 ELSEIF (JB == 22) THEN
787 CALL SRTM_TAUMOL22 &
788 & ( KLEV ,&
789 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
790 & KJP , KJT , KJT1 , PONEMINUS ,&
791 & PCOLH2O , PCOLMOL , PCOLO2 ,&
792 & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
793 & ZSFLXZEN, ZTAUG , ZTAUR &
794 & )
795 ! print *,'After SRTM_TAUMOL22'
796
797 ELSEIF (JB == 23) THEN
798 CALL SRTM_TAUMOL23 &
799 & ( KLEV ,&
800 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
801 & KJP , KJT , KJT1 , PONEMINUS ,&
802 & PCOLH2O , PCOLMOL ,&
803 & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
804 & ZSFLXZEN, ZTAUG , ZTAUR &
805 & )
806 ! print *,'After SRTM_TAUMOL23'
807
808 ELSEIF (JB == 24) THEN
809 CALL SRTM_TAUMOL24 &
810 & ( KLEV ,&
811 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
812 & KJP , KJT , KJT1 , PONEMINUS ,&
813 & PCOLH2O , PCOLMOL , PCOLO2 , PCOLO3 ,&
814 & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
815 & ZSFLXZEN, ZTAUG , ZTAUR &
816 & )
817 ! print *,'After SRTM_TAUMOL24'
818
819 ELSEIF (JB == 25) THEN
820 !--- visible 16000-22650 cm-1 0.4415 - 0.6250 um
821 CALL SRTM_TAUMOL25 &
822 & ( KLEV ,&
823 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
824 & KJP , KJT , KJT1 , PONEMINUS ,&
825 & PCOLH2O , PCOLMOL , PCOLO3 ,&
826 & KLAYTROP ,&
827 & ZSFLXZEN, ZTAUG , ZTAUR &
828 & )
829 ! print *,'After SRTM_TAUMOL25'
830
831 ELSEIF (JB == 26) THEN
832 !--- UV-A 22650-29000 cm-1 0.3448 - 0.4415 um
833 CALL SRTM_TAUMOL26 &
834 & ( KLEV ,&
835 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
836 & KJP , KJT , KJT1 , PONEMINUS ,&
837 & PCOLH2O , PCOLCO2 , PCOLMOL ,&
838 & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
839 & ZSFLXZEN, ZTAUG , ZTAUR &
840 & )
841 ! print *,'After SRTM_TAUMOL26'
842
843 ELSEIF (JB == 27) THEN
844 !--- UV-B 29000-38000 cm-1 0.2632 - 0.3448 um
845 CALL SRTM_TAUMOL27 &
846 & ( KLEV ,&
847 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
848 & KJP , KJT , KJT1 , PONEMINUS ,&
849 & PCOLMOL , PCOLO3 ,&
850 & KLAYTROP ,&
851 & ZSFLXZEN, ZTAUG , ZTAUR &
852 & )
853 ! print *,'After SRTM_TAUMOL27'
854
855 ELSEIF (JB == 28) THEN
856 !--- UV-C 38000-50000 cm-1 0.2000 - 0.2632 um
857 CALL SRTM_TAUMOL28 &
858 & ( KLEV ,&
859 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
860 & KJP , KJT , KJT1 , PONEMINUS ,&
861 & PCOLMOL , PCOLO2 , PCOLO3 ,&
862 & KLAYTROP ,&
863 & ZSFLXZEN, ZTAUG , ZTAUR &
864 & )
865 ! print *,'After SRTM_TAUMOL28'
866
867 ELSEIF (JB == 29) THEN
868 CALL SRTM_TAUMOL29 &
869 & ( KLEV ,&
870 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
871 & KJP , KJT , KJT1 , PONEMINUS ,&
872 & PCOLH2O , PCOLCO2 , PCOLMOL ,&
873 & KLAYTROP , PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
874 & ZSFLXZEN , ZTAUG , ZTAUR &
875 & )
876 ! print *,'After SRTM_TAUMOL29'
877
878 ENDIF
879
880 ! IF (NDBUG.LE.3) THEN
881 ! print *,'Incident Solar Flux'
882 ! PRINT 9010,(ZSFLXZEN(JG),JG=1,16)
883 9010 format(1x,'SolFlx ',16F8.4)
884 ! print *,'Optical thickness for molecular absorption for JB= ',JB
885 ! DO JK=1,KLEV
886 ! PRINT 9011,JK,(ZTAUG(JK,JG),JG=1,16)
887 9011 format(1x,'TauGas ',I3,16E9.2)
888 ! ENDDO
889 ! print *,'Optical thickness for Rayleigh scattering for JB= ',JB
890 ! DO JK=1,KLEV
891 ! PRINT 9012,JK,(ZTAUR(JK,JG),JG=1,16)
892 9012 format(1x,'TauRay ',I3,16E9.2)
893 ! ENDDO
894 ! print *,'Cloud optical properties for JB= ',JB
895 ! DO JK=1,KLEV
896 ! PRINT 9013,JK,PFRCL(JK),PTAUC(JK,IBM),POMGC(JK,IBM),PASYC(JK,IBM)
897 9013 format(1x,'Cloud optprop ',I3,f8.4,f8.3,2f8.5)
898 ! ENDDO
899 ! ENDIF
900
901 DO JG=1,IGT
902 IW=IW+1
903
904 ! IF (NDBUG.LE.1) THEN
905 ! print *,' === JG= ',JG,' === for JB= ',JB,' with IW, IBM, JPLAY, KLEV=',IW,IBM,JPLAY,KLEV
906 ! ENDIF
907
908 ZINCFLX(IW) =ZSFLXZEN(JG)*PRMU0
909 ZINCFLUX =ZINCFLUX+ZSFLXZEN(JG)*PRMU0
910 ZINCTOT =ZINCTOT+ZSFLXZEN(JG)
911 ZINCF14(IBM)=ZINCF14(IBM)+ZSFLXZEN(JG)
912
913 !-- CALL to compute layer reflectances and transmittances for direct
914 ! and diffuse sources, first clear then cloudy.
915 ! Use direct/parallel albedo for direct radiation and diffuse albedo
916 ! otherwise.
917
918 ! ZREFC(JK) direct albedo for clear
919 ! ZREFO(JK) direct albedo for cloud
920 ! ZREFDC(JK) diffuse albedo for clear
921 ! ZREFDO(JK) diffuse albedo for cloud
922 ! ZTRAC(JK) direct transmittance for clear
923 ! ZTRAO(JK) direct transmittance for cloudy
924 ! ZTRADC(JK) diffuse transmittance for clear
925 ! ZTRADO(JK) diffuse transmittance for cloudy
926
927 ! ZREF(JK) direct reflectance
928 ! ZREFD(JK) diffuse reflectance
929 ! ZTRA(JK) direct transmittance
930 ! ZTRAD(JK) diffuse transmittance
931
932 ! ZDBTC(JK) clear direct beam transmittance
933 ! ZDBTO(JK) cloudy direct beam transmittance
934 ! ZDBT(JK) layer mean direct beam transmittance
935 ! ZTDBT(JK) total direct beam transmittance at levels
936
937 !-- clear-sky
938 !----- TOA direct beam
939 ZTDBTC(1)=1._JPRB
940 !----- surface values
941 ZDBTC(KLEV+1) =0.0_JPRB
942 ZTRAC(KLEV+1) =0.0_JPRB
943 ZTRADC(KLEV+1)=0.0_JPRB
944 ZREFC(KLEV+1) =PALBP(IBM)
945 ZREFDC(KLEV+1)=PALBD(IBM)
946 ZRUPC(KLEV+1) =PALBP(IBM)
947 ZRUPDC(KLEV+1)=PALBD(IBM)
948
949 !-- total sky
950 !----- TOA direct beam
951 ZTDBT(1)=1._JPRB
952 !----- surface values
953 ZDBT(KLEV+1) =0.0_JPRB
954 ZTRA(KLEV+1) =0.0_JPRB
955 ZTRAD(KLEV+1)=0.0_JPRB
956 ZREF(KLEV+1) =PALBP(IBM)
957 ZREFD(KLEV+1)=PALBD(IBM)
958 ZRUP(KLEV+1) =PALBP(IBM)
959 ZRUPD(KLEV+1)=PALBD(IBM)
960 ! if (NDBUG < 2) print *,'SWSPCTRL after 1 with JB,JG,IBM and IW= ',JB,JG,IBM,IW
961
962 DO JK=1,KLEV
963
964 !-- NB: a two-stream calculations from top to bottom, but RRTM_SW quantities
965 ! are given bottom to top (argh!)
966 ! Inputs for clouds and aerosols are bottom to top as inputs
967
968 IKL=KLEV+1-JK
969
970 !-- clear-sky optical parameters
971 LLRTCHK(JK)=.TRUE.
972
973 ! print 9000,JK,JG,IKL,ZTAUR(IKL,JG),ZTAUG(IKL,JG),PTAUC(IKL,IBM)
974 9000 format(1x,'Cloud quantities ',3I4,3E12.5)
975
976 !-- original
977 ! ZTAUC(JK)=ZTAUR(IKL,JG)+ZTAUG(IKL,JG)
978 ! ZOMCC(JK)=ZTAUR(IKL,JG)/ZTAUC(JK)
979 ! ZGCC (JK)=0.0001_JPRB
980
981 !-- total sky optical parameters
982 ! ZTAUO(JK)=ZTAUR(IKL,JG)+ZTAUG(IKL,JG)+PTAUC(IKL,IBM)
983 ! ZOMCO(JK)=PTAUC(IKL,IBM)*POMGC(IKL,IBM)+ZTAUR(IKL,JG)
984 ! ZGCO (JK)=(PTAUC(IKL,IBM)*POMGC(IKL,IBM)*PASYC(IKL,IBM) &
985 ! & +ZTAUR(IKL,JG)*0.0001_JPRB)/ZOMCO(JK)
986 ! ZOMCO(JK)=ZOMCO(JK)/ZTAUO(JK)
987
988 !-- clear-sky optical parameters including aerosols
989 ZTAUC(JK) = ZTAUR(IKL,JG) + ZTAUG(IKL,JG) + PTAUA(IKL,IBM)
990 ZOMCC(JK) = ZTAUR(IKL,JG)*1.0_JPRB + PTAUA(IKL,IBM)*POMGA(IKL,IBM)
991 ZGCC (JK) = PASYA(IKL,IBM)*POMGA(IKL,IBM)*PTAUA(IKL,IBM) / ZOMCC(JK)
992 ZOMCC(JK) = ZOMCC(JK) / ZTAUC(JK)
993
994 !-- total sky optical parameters
995 ZTAUO(JK) = ZTAUR(IKL,JG) + ZTAUG(IKL,JG) + PTAUA(IKL,IBM) + PTAUC(IKL,IBM)
996 ZOMCO(JK) = PTAUA(IKL,IBM)*POMGA(IKL,IBM) + PTAUC(IKL,IBM)*POMGC(IKL,IBM) &
997 & + ZTAUR(IKL,JG)*1.0_JPRB
998 ZGCO (JK) = (PTAUC(IKL,IBM)*POMGC(IKL,IBM)*PASYC(IKL,IBM) &
999 & + PTAUA(IKL,IBM)*POMGA(IKL,IBM)*PASYA(IKL,IBM)) &
1000 & / ZOMCO(JK)
1001 ZOMCO(JK) = ZOMCO(JK) / ZTAUO(JK)
1002
1003 ! if (NDBUG <2) THEN
1004 ! print 9001,JK,JG,LRTCHK(JK),0.00,ZTAUC(JK),ZOMCC(JK),ZGCC(JK),ZTAUR(IKL,JG),ZTAUG(IKL,JG)
1005 9001 format(1x,'clear :',2I3,L4,7(1x,E13.6))
1006 ! print 9002,JK,JG,LRTCHK(JK),PFRCL(IKL),ZTAUO(JK),ZOMCO(JK),ZGCO(JK) &
1007 ! &,PTAUC(IKL,IBM),POMGC(IKL,IBM),PASYC(IKL,IBM)
1008 9002 format(1x,'total0:',2I3,L4,7(1x,E13.6))
1009 ! end if
1010 ENDDO
1011 ! if (NDBUG < 2) print *,'SWSPCTRL after 2'
1012
1013 !-- Delta scaling for clear-sky / aerosol optical quantities
1014 DO JK=1,KLEV
1015 ZF=ZGCC(JK)*ZGCC(JK)
1016 ZWF=ZOMCC(JK)*ZF
1017 ZTAUC(JK)=(1._JPRB-ZWF)*ZTAUC(JK)
1018 ZOMCC(JK)=(ZOMCC(JK)-ZWF)/(1.0_JPRB-ZWF)
1019 ZGCC (JK)=(ZGCC(JK)-ZF)/(1.0_JPRB-ZF)
1020 ENDDO
1021
1022 CALL SRTM_REFTRA ( KLEV, I_KMODTS ,&
1023 & LLRTCHK, ZGCC , PRMU0, ZTAUC , ZOMCC ,&
1024 & ZREFC , ZREFDC, ZTRAC, ZTRADC )
1025 ! if (NDBUG < 2) print *,'SWSPCTR after SWREFTRA for clear-sky'
1026
1027 !-- Delta scaling for cloudy quantities
1028 DO JK=1,KLEV
1029 IKL=KLEV+1-JK
1030 LLRTCHK(JK)=.FALSE.
1031 ZF=ZGCO(JK)*ZGCO(JK)
1032 ZWF=ZOMCO(JK)*ZF
1033 ZTAUO(JK)=(1._JPRB-ZWF)*ZTAUO(JK)
1034 ZOMCO(JK)=(ZOMCO(JK)-ZWF)/(1._JPRB-ZWF)
1035 ZGCO (JK)=(ZGCO(JK)-ZF)/(1._JPRB-ZF)
1036 LLRTCHK(JK)=(PFRCL(IKL) > REPCLC)
1037
1038 ! if (NDBUG < 2) THEN
1039 ! print 9003,JK,LRTCHK(JK),PFRCL(IKL),ZTAUO(JK),ZOMCO(JK),ZGCO(JK) &
1040 ! &,PTAUC(IKL,IBM),POMGC(IKL,IBM),PASYC(IKL,IBM)
1041 9003 format(1x,'totalD:',I3,L4,7(1x,E13.6))
1042 ! end if
1043
1044 ENDDO
1045 ! if (NDBUG < 2) print *,'SWSPCTR after Delta scaling'
1046
1047 CALL SRTM_REFTRA ( KLEV, I_KMODTS ,&
1048 & LLRTCHK, ZGCO , PRMU0, ZTAUO , ZOMCO ,&
1049 & ZREFO , ZREFDO, ZTRAO, ZTRADO )
1050 ! if (NDBUG < 2) print *,'SWSPCTR after SWREFTRA for cloudy'
1051
1052 DO JK=1,KLEV
1053
1054 !-- combine clear and cloudy contributions for total sky
1055
1056 IKL=KLEV+1-JK
1057 ZCLEAR = 1.0_JPRB - PFRCL(IKL)
1058 ZCLOUD = PFRCL(IKL)
1059
1060 ZREF(JK) = ZCLEAR*ZREFC(JK) + ZCLOUD*ZREFO(JK)
1061 ZREFD(JK)= ZCLEAR*ZREFDC(JK)+ ZCLOUD*ZREFDO(JK)
1062 ZTRA(JK) = ZCLEAR*ZTRAC(JK) + ZCLOUD*ZTRAO(JK)
1063 ZTRAD(JK)= ZCLEAR*ZTRADC(JK)+ ZCLOUD*ZTRADO(JK)
1064
1065 !-- direct beam transmittance
1066
1067 ZDBTMC = EXP(-ZTAUC(JK)/PRMU0)
1068 ZDBTMO = EXP(-ZTAUO(JK)/PRMU0)
1069 ZDBT(JK) = ZCLEAR*ZDBTMC+ZCLOUD*ZDBTMO
1070 ZTDBT(JK+1)= ZDBT(JK)*ZTDBT(JK)
1071
1072 !-- clear-sky
1073 ZDBTC(JK) =ZDBTMC
1074 ZTDBTC(JK+1)=ZDBTC(JK)*ZTDBTC(JK)
1075
1076 ! if (NDBUG < 2) print 9200,JK,ZREFC(JK),ZREFDC(JK),ZTRAC(JK),ZTRADC(JK),ZDBTC(JK),ZTDBTC(JK+1)
1077 ! if (NDBUG < 2) print 9199,JK,ZREF(JK),ZREFD(JK),ZTRA(JK),ZTRAD(JK),ZDBT(JK),ZTDBT(JK+1)
1078 9199 format(1x,'Comb total:',I3,6E13.6)
1079 9200 format(1x,'Comb clear:',I3,6E13.6)
1080
1081 ENDDO
1082 ! if (NDBUG < 2) print *,'SRTM_SPCVRT after combining clear and cloudy'
1083
1084 !-- vertical quadrature producing clear-sky fluxes
1085
1086 ! print *,'SRTM_SPCVRT after 3 before SRTM_VRTQDR clear'
1087
1088 CALL SRTM_VRTQDR ( KLEV, IW ,&
1089 & ZREFC, ZREFDC, ZTRAC , ZTRADC ,&
1090 & ZDBTC, ZRDNDC, ZRUPC , ZRUPDC, ZTDBTC ,&
1091 & ZCD , ZCU )
1092
1093 ! IF (NDBUG < 2) THEN
1094 ! print *,'SRTM_SPCVRT out of SRTM_VRTQDR for clear IW=',IW
1095 ! DO JK=1,KLEV+1
1096 ! print 9201,JK,ZCD(JK,IW),ZCU(JK,IW)
1097 9201 format(1x,'clear-sky contrib to fluxes',I3,2F12.4)
1098 ! ENDDO
1099 ! ENDIF
1100
1101 !-- vertical quadrature producing cloudy fluxes
1102
1103 ! print *,'SRTM_SPCVRT after 4 before SRTM_VRTQDR cloudy'
1104
1105 CALL SRTM_VRTQDR ( KLEV, IW ,&
1106 & ZREF , ZREFD , ZTRA , ZTRAD ,&
1107 & ZDBT , ZRDND , ZRUP , ZRUPD , ZTDBT ,&
1108 & ZFD , ZFU )
1109
1110 ! IF (NDBUG < 2) THEN
1111 ! print *,'SRTM_SPCVRT out of SRTM_VRTQDR for cloudy IW=',IW
1112 ! DO JK=1,KLEV+1
1113 ! print 9202,JK,ZFD(JK,IW),ZFU(JK,IW)
1114 9202 format(1x,'cloudy sky contrib to fluxes',I3,2F12.4)
1115 ! ENDDO
1116 ! ENDIF
1117
1118 !-- up and down-welling fluxes at levels
1119 DO JK=1,KLEV+1
1120 !-- accumulation of spectral fluxes
1121 PBBFU(JK) = PBBFU(JK) + ZINCFLX(IW)*ZFU(JK,IW)
1122 PBBFD(JK) = PBBFD(JK) + ZINCFLX(IW)*ZFD(JK,IW)
1123 PBBCU(JK) = PBBCU(JK) + ZINCFLX(IW)*ZCU(JK,IW)
1124 PBBCD(JK) = PBBCD(JK) + ZINCFLX(IW)*ZCD(JK,IW)
1125
1126 ! to get NIR, visible and UV quantities
1127
1128 ! PBBFU(JK)=PBBFU(JK)+RWGT(IW)*ZFU(JK,IW)
1129 ! PBBFD(JK)=PBBFD(JK)+RWGT(IW)*ZFD(JK,IW)
1130 ! PBBCU(JK)=PBBCU(JK)+RWGT(IW)*ZCU(JK,IW)
1131 ! PBBCD(JK)=PBBCD(JK)+RWGT(IW)*ZCD(JK,IW)
1132 ! IF (IW <= NUV) THEN
1133 ! PUVFD(JK)=PUVFD(JK)+RWGT(IW)*ZFD(JK,IW)
1134 ! PUVFU(JK)=PUVFU(JK)+RWGT(IW)*ZFU(JK,IW)
1135 ! PUVCD(JK)=PUVCD(JK)+RWGT(IW)*ZCD(JK,IW)
1136 ! PUVCU(JK)=PUVCU(JK)+RWGT(IW)*ZCU(JK,IW)
1137 ! ELSE IF (IW == NUV+1 .AND. IW <= NVS) THEN
1138 ! PVSFD(JK)=PVSFD(JK)+RWGT(IW)*ZFD(JK,IW)
1139 ! PVSFU(JK)=PVSFU(JK)+RWGT(IW)*ZFU(JK,IW)
1140 ! PVSCD(JK)=PVSCD(JK)+RWGT(IW)*ZCD(JK,IW)
1141 ! PVSCU(JK)=PVSCU(JK)+RWGT(IW)*ZCU(JK,IW)
1142 ! ELSE IF (IW > NVS) THEN
1143 ! PNIFD(JK)=PNIFD(JK)+RWGT(IW)*ZFD(JK,IW)
1144 ! PNIFU(JK)=PNIFU(JK)+RWGT(IW)*ZFU(JK,IW)
1145 ! PNICD(JK)=PNICD(JK)+RWGT(IW)*ZCD(JK,IW)
1146 ! PNICU(JK)=PNICU(JK)+RWGT(IW)*ZCU(JK,IW)
1147 ! ENDIF
1148 ! if (NDBUG < 2) then
1149 !! if (JG.EQ.IGT) THEN
1150 ! print 9206,JB,JG,JK,IW,PBBCU(JK),PBBCD(JK),PBBFU(JK),PBBFD(JK)
1151 9206 format(1x,'fluxes up to:',3I3,I4,6E13.6)
1152 ! end if
1153 ENDDO
1154
1155 ! if (NDBUG < 2) print *,'SRTM_SPCVRT end of JG=',JG,' for JB=',JB,' i.e. IW=',IW
1156 ENDDO
1157 !-- end loop on JG
1158
1159 ! print *,' --- JB= ',JB,' with IB1, IB2= ',IB1,IB2
1160 ENDDO
1161 !-- end loop on JB
1162 !if (NDBUG < 2) print *,'SRTM_SPCVRT about to come out'
1163
1164 !DO IBM=1,14
1165 ! print 9301,IBM,ZINCF14(IBM), ZINCTOT, ZINCF14(IBM)/ZINCTOT
1166 9301 format(1x,'Incident Spectral Flux: ',I3,2E15.8,F12.8)
1167 !ENDDO
1168
1169 ! ------------------------------------------------------------------
1170 IF (LHOOK) CALL DR_HOOK('SRTM_SPCVRT',1,ZHOOK_HANDLE)
1171 END SUBROUTINE SRTM_SPCVRT
1172