Line data Source code
1 : ! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_sw/src/rrtmg_sw_taumol.f90,v $
2 : ! author: $Author: mike $
3 : ! revision: $Revision: 1.2 $
4 : ! created: $Date: 2007/08/23 20:40:15 $
5 :
6 : module rrtmg_sw_taumol
7 :
8 : ! --------------------------------------------------------------------------
9 : ! | |
10 : ! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). |
11 : ! | This software may be used, copied, or redistributed as long as it is |
12 : ! | not sold and this copyright notice is reproduced on each copy made. |
13 : ! | This model is provided as is without any express or implied warranties. |
14 : ! | (http://www.rtweb.aer.com/) |
15 : ! | |
16 : ! --------------------------------------------------------------------------
17 :
18 : ! ------- Modules -------
19 :
20 : use shr_kind_mod, only: r8 => shr_kind_r8
21 :
22 : use rrsw_con, only: oneminus
23 : use rrsw_wvn, only: nspa, nspb
24 :
25 : implicit none
26 :
27 : contains
28 :
29 : !----------------------------------------------------------------------------
30 13824 : subroutine taumol_sw(nlayers, &
31 27648 : colh2o, colco2, colch4, colo2, colo3, colmol, &
32 13824 : laytrop, jp, jt, jt1, &
33 13824 : fac00, fac01, fac10, fac11, &
34 27648 : selffac, selffrac, indself, forfac, forfrac, indfor, &
35 27648 : sfluxzen, taug, taur)
36 : !----------------------------------------------------------------------------
37 :
38 : ! ******************************************************************************
39 : ! * *
40 : ! * Optical depths developed for the *
41 : ! * *
42 : ! * RAPID RADIATIVE TRANSFER MODEL (RRTM) *
43 : ! * *
44 : ! * *
45 : ! * ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC. *
46 : ! * 131 HARTWELL AVENUE *
47 : ! * LEXINGTON, MA 02421 *
48 : ! * *
49 : ! * *
50 : ! * ELI J. MLAWER *
51 : ! * JENNIFER DELAMERE *
52 : ! * STEVEN J. TAUBMAN *
53 : ! * SHEPARD A. CLOUGH *
54 : ! * *
55 : ! * *
56 : ! * *
57 : ! * *
58 : ! * email: mlawer@aer.com *
59 : ! * email: jdelamer@aer.com *
60 : ! * *
61 : ! * The authors wish to acknowledge the contributions of the *
62 : ! * following people: Patrick D. Brown, Michael J. Iacono, *
63 : ! * Ronald E. Farren, Luke Chen, Robert Bergstrom. *
64 : ! * *
65 : ! ******************************************************************************
66 : ! * TAUMOL *
67 : ! * *
68 : ! * This file contains the subroutines TAUGBn (where n goes from *
69 : ! * 1 to 28). TAUGBn calculates the optical depths and Planck fractions *
70 : ! * per g-value and layer for band n. *
71 : ! * *
72 : ! * Output: optical depths (unitless) *
73 : ! * fractions needed to compute Planck functions at every layer *
74 : ! * and g-value *
75 : ! * *
76 : ! * COMMON /TAUGCOM/ TAUG(MXLAY,MG) *
77 : ! * COMMON /PLANKG/ FRACS(MXLAY,MG) *
78 : ! * *
79 : ! * Input *
80 : ! * *
81 : ! * PARAMETER (MG=16, MXLAY=203, NBANDS=14) *
82 : ! * *
83 : ! * COMMON /FEATURES/ NG(NBANDS),NSPA(NBANDS),NSPB(NBANDS) *
84 : ! * COMMON /PRECISE/ ONEMINUS *
85 : ! * COMMON /PROFILE/ NLAYERS,PAVEL(MXLAY),TAVEL(MXLAY), *
86 : ! * & PZ(0:MXLAY),TZ(0:MXLAY),TBOUND *
87 : ! * COMMON /PROFDATA/ LAYTROP,LAYSWTCH,LAYLOW, *
88 : ! * & COLH2O(MXLAY),COLCO2(MXLAY), *
89 : ! * & COLO3(MXLAY),COLN2O(MXLAY),COLCH4(MXLAY), *
90 : ! * & COLO2(MXLAY),CO2MULT(MXLAY) *
91 : ! * COMMON /INTFAC/ FAC00(MXLAY),FAC01(MXLAY), *
92 : ! * & FAC10(MXLAY),FAC11(MXLAY) *
93 : ! * COMMON /INTIND/ JP(MXLAY),JT(MXLAY),JT1(MXLAY) *
94 : ! * COMMON /SELF/ SELFFAC(MXLAY), SELFFRAC(MXLAY), INDSELF(MXLAY) *
95 : ! * *
96 : ! * Description: *
97 : ! * NG(IBAND) - number of g-values in band IBAND *
98 : ! * NSPA(IBAND) - for the lower atmosphere, the number of reference *
99 : ! * atmospheres that are stored for band IBAND per *
100 : ! * pressure level and temperature. Each of these *
101 : ! * atmospheres has different relative amounts of the *
102 : ! * key species for the band (i.e. different binary *
103 : ! * species parameters). *
104 : ! * NSPB(IBAND) - same for upper atmosphere *
105 : ! * ONEMINUS - since problems are caused in some cases by interpolation *
106 : ! * parameters equal to or greater than 1, for these cases *
107 : ! * these parameters are set to this value, slightly < 1. *
108 : ! * PAVEL - layer pressures (mb) *
109 : ! * TAVEL - layer temperatures (degrees K) *
110 : ! * PZ - level pressures (mb) *
111 : ! * TZ - level temperatures (degrees K) *
112 : ! * LAYTROP - layer at which switch is made from one combination of *
113 : ! * key species to another *
114 : ! * COLH2O, COLCO2, COLO3, COLN2O, COLCH4 - column amounts of water *
115 : ! * vapor,carbon dioxide, ozone, nitrous ozide, methane, *
116 : ! * respectively (molecules/cm**2) *
117 : ! * CO2MULT - for bands in which carbon dioxide is implemented as a *
118 : ! * trace species, this is the factor used to multiply the *
119 : ! * band's average CO2 absorption coefficient to get the added *
120 : ! * contribution to the optical depth relative to 355 ppm. *
121 : ! * FACij(LAY) - for layer LAY, these are factors that are needed to *
122 : ! * compute the interpolation factors that multiply the *
123 : ! * appropriate reference k-values. A value of 0 (1) for *
124 : ! * i,j indicates that the corresponding factor multiplies *
125 : ! * reference k-value for the lower (higher) of the two *
126 : ! * appropriate temperatures, and altitudes, respectively. *
127 : ! * JP - the index of the lower (in altitude) of the two appropriate *
128 : ! * reference pressure levels needed for interpolation *
129 : ! * JT, JT1 - the indices of the lower of the two appropriate reference *
130 : ! * temperatures needed for interpolation (for pressure *
131 : ! * levels JP and JP+1, respectively) *
132 : ! * SELFFAC - scale factor needed to water vapor self-continuum, equals *
133 : ! * (water vapor density)/(atmospheric density at 296K and *
134 : ! * 1013 mb) *
135 : ! * SELFFRAC - factor needed for temperature interpolation of reference *
136 : ! * water vapor self-continuum data *
137 : ! * INDSELF - index of the lower of the two appropriate reference *
138 : ! * temperatures needed for the self-continuum interpolation *
139 : ! * *
140 : ! * Data input *
141 : ! * COMMON /Kn/ KA(NSPA(n),5,13,MG), KB(NSPB(n),5,13:59,MG), SELFREF(10,MG) *
142 : ! * (note: n is the band number) *
143 : ! * *
144 : ! * Description: *
145 : ! * KA - k-values for low reference atmospheres (no water vapor *
146 : ! * self-continuum) (units: cm**2/molecule) *
147 : ! * KB - k-values for high reference atmospheres (all sources) *
148 : ! * (units: cm**2/molecule) *
149 : ! * SELFREF - k-values for water vapor self-continuum for reference *
150 : ! * atmospheres (used below LAYTROP) *
151 : ! * (units: cm**2/molecule) *
152 : ! * *
153 : ! * DIMENSION ABSA(65*NSPA(n),MG), ABSB(235*NSPB(n),MG) *
154 : ! * EQUIVALENCE (KA,ABSA),(KB,ABSB) *
155 : ! * *
156 : ! *****************************************************************************
157 : !
158 : ! Modifications
159 : !
160 : ! Revised: Adapted to F90 coding, J.-J.Morcrette, ECMWF, Feb 2003
161 : ! Revised: Modified for g-point reduction, MJIacono, AER, Dec 2003
162 : ! Revised: Reformatted for consistency with rrtmg_lw, MJIacono, AER, Jul 2006
163 : !
164 : ! ------- Declarations -------
165 :
166 : ! ----- Input -----
167 : integer, intent(in) :: nlayers ! total number of layers
168 :
169 : integer, intent(in) :: laytrop ! tropopause layer index
170 : integer, intent(in) :: jp(:) !
171 : ! Dimensions: (nlayers)
172 : integer, intent(in) :: jt(:) !
173 : ! Dimensions: (nlayers)
174 : integer, intent(in) :: jt1(:) !
175 : ! Dimensions: (nlayers)
176 :
177 : real(kind=r8), intent(in) :: colh2o(:) ! column amount (h2o)
178 : ! Dimensions: (nlayers)
179 : real(kind=r8), intent(in) :: colco2(:) ! column amount (co2)
180 : ! Dimensions: (nlayers)
181 : real(kind=r8), intent(in) :: colo3(:) ! column amount (o3)
182 : ! Dimensions: (nlayers)
183 : real(kind=r8), intent(in) :: colch4(:) ! column amount (ch4)
184 : ! Dimensions: (nlayers)
185 : ! Dimensions: (nlayers)
186 : real(kind=r8), intent(in) :: colo2(:) ! column amount (o2)
187 : ! Dimensions: (nlayers)
188 : real(kind=r8), intent(in) :: colmol(:) !
189 : ! Dimensions: (nlayers)
190 :
191 : integer, intent(in) :: indself(:)
192 : ! Dimensions: (nlayers)
193 : integer, intent(in) :: indfor(:)
194 : ! Dimensions: (nlayers)
195 : real(kind=r8), intent(in) :: selffac(:)
196 : ! Dimensions: (nlayers)
197 : real(kind=r8), intent(in) :: selffrac(:)
198 : ! Dimensions: (nlayers)
199 : real(kind=r8), intent(in) :: forfac(:)
200 : ! Dimensions: (nlayers)
201 : real(kind=r8), intent(in) :: forfrac(:)
202 : ! Dimensions: (nlayers)
203 :
204 : real(kind=r8), intent(in) :: & !
205 : fac00(:), fac01(:), & ! Dimensions: (nlayers)
206 : fac10(:), fac11(:)
207 :
208 : ! ----- Output -----
209 : real(kind=r8), intent(out) :: sfluxzen(:) ! solar source function
210 : ! Dimensions: (ngptsw)
211 : real(kind=r8), intent(out) :: taug(:,:) ! gaseous optical depth
212 : ! Dimensions: (nlayers,ngptsw)
213 : real(kind=r8), intent(out) :: taur(:,:) ! Rayleigh
214 : ! Dimensions: (nlayers,ngptsw)
215 : ! real(kind=r8), intent(out) :: ssa(:,:) ! single scattering albedo (inactive)
216 : ! Dimensions: (nlayers,ngptsw)
217 :
218 : ! Calculate gaseous optical depth and planck fractions for each spectral band.
219 :
220 13824 : call taumol16
221 13824 : call taumol17
222 13824 : call taumol18
223 13824 : call taumol19
224 13824 : call taumol20
225 13824 : call taumol21
226 13824 : call taumol22
227 13824 : call taumol23
228 13824 : call taumol24
229 13824 : call taumol25
230 13824 : call taumol26
231 13824 : call taumol27
232 13824 : call taumol28
233 13824 : call taumol29
234 :
235 : !-------------
236 : contains
237 : !-------------
238 :
239 : !----------------------------------------------------------------------------
240 13824 : subroutine taumol16
241 : !----------------------------------------------------------------------------
242 : !
243 : ! band 16: 2600-3250 cm-1 (low - h2o,ch4; high - ch4)
244 : !
245 : !----------------------------------------------------------------------------
246 :
247 : ! ------- Modules -------
248 :
249 : use parrrsw, only : ng16
250 : use rrsw_kg16, only : absa, absb, forref, selfref, &
251 : sfluxref, rayl, layreffr, strrat1
252 :
253 : ! ------- Declarations -------
254 :
255 : ! Local
256 :
257 : integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
258 : real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, &
259 : fac110, fac111, fs, speccomb, specmult, specparm, &
260 : tauray
261 :
262 : ! Compute the optical depth by interpolating in ln(pressure),
263 : ! temperature, and appropriate species. Below LAYTROP, the water
264 : ! vapor self-continuum is interpolated (in temperature) separately.
265 :
266 : ! Lower atmosphere loop
267 317952 : do lay = 1, laytrop
268 304128 : speccomb = colh2o(lay) + strrat1*colch4(lay)
269 304128 : specparm = colh2o(lay)/speccomb
270 304128 : if (specparm .ge. oneminus) specparm = oneminus
271 304128 : specmult = 8._r8*(specparm)
272 304128 : js = 1 + int(specmult)
273 304128 : fs = mod(specmult, 1._r8 )
274 304128 : fac000 = (1._r8 - fs) * fac00(lay)
275 304128 : fac010 = (1._r8 - fs) * fac10(lay)
276 304128 : fac100 = fs * fac00(lay)
277 304128 : fac110 = fs * fac10(lay)
278 304128 : fac001 = (1._r8 - fs) * fac01(lay)
279 304128 : fac011 = (1._r8 - fs) * fac11(lay)
280 304128 : fac101 = fs * fac01(lay)
281 304128 : fac111 = fs * fac11(lay)
282 304128 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(16) + js
283 304128 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(16) + js
284 304128 : inds = indself(lay)
285 304128 : indf = indfor(lay)
286 304128 : tauray = colmol(lay) * rayl
287 :
288 2142720 : do ig = 1, ng16
289 1824768 : taug(lay,ig) = speccomb * &
290 3649536 : (fac000 * absa(ind0 ,ig) + &
291 1824768 : fac100 * absa(ind0 +1,ig) + &
292 1824768 : fac010 * absa(ind0 +9,ig) + &
293 1824768 : fac110 * absa(ind0+10,ig) + &
294 1824768 : fac001 * absa(ind1 ,ig) + &
295 1824768 : fac101 * absa(ind1 +1,ig) + &
296 1824768 : fac011 * absa(ind1 +9,ig) + &
297 1824768 : fac111 * absa(ind1+10,ig)) + &
298 1824768 : colh2o(lay) * &
299 3649536 : (selffac(lay) * (selfref(inds,ig) + &
300 1824768 : selffrac(lay) * &
301 1824768 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
302 3649536 : forfac(lay) * (forref(indf,ig) + &
303 1824768 : forfrac(lay) * &
304 23721984 : (forref(indf+1,ig) - forref(indf,ig))))
305 : ! ssa(lay,ig) = tauray/taug(lay,ig)
306 2128896 : taur(lay,ig) = tauray
307 : enddo
308 : enddo
309 :
310 13824 : laysolfr = nlayers
311 :
312 : ! Upper atmosphere loop
313 566784 : do lay = laytrop+1, nlayers
314 552960 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
315 13824 : laysolfr = lay
316 552960 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(16) + 1
317 552960 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(16) + 1
318 552960 : tauray = colmol(lay) * rayl
319 :
320 3884544 : do ig = 1, ng16
321 3317760 : taug(lay,ig) = colch4(lay) * &
322 6635520 : (fac00(lay) * absb(ind0 ,ig) + &
323 6635520 : fac10(lay) * absb(ind0+1,ig) + &
324 6635520 : fac01(lay) * absb(ind1 ,ig) + &
325 16588800 : fac11(lay) * absb(ind1+1,ig))
326 : ! ssa(lay,ig) = tauray/taug(lay,ig)
327 3317760 : if (lay .eq. laysolfr) sfluxzen(ig) = sfluxref(ig)
328 3870720 : taur(lay,ig) = tauray
329 : enddo
330 : enddo
331 :
332 13824 : end subroutine taumol16
333 :
334 : !----------------------------------------------------------------------------
335 13824 : subroutine taumol17
336 : !----------------------------------------------------------------------------
337 : !
338 : ! band 17: 3250-4000 cm-1 (low - h2o,co2; high - h2o,co2)
339 : !
340 : !----------------------------------------------------------------------------
341 :
342 : ! ------- Modules -------
343 :
344 : use parrrsw, only : ng17, ngs16
345 : use rrsw_kg17, only : absa, absb, forref, selfref, &
346 : sfluxref, rayl, layreffr, strrat
347 :
348 : ! ------- Declarations -------
349 :
350 : ! Local
351 :
352 : integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
353 : real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, &
354 : fac110, fac111, fs, speccomb, specmult, specparm, &
355 : tauray
356 :
357 : ! Compute the optical depth by interpolating in ln(pressure),
358 : ! temperature, and appropriate species. Below LAYTROP, the water
359 : ! vapor self-continuum is interpolated (in temperature) separately.
360 :
361 : ! Lower atmosphere loop
362 317952 : do lay = 1, laytrop
363 304128 : speccomb = colh2o(lay) + strrat*colco2(lay)
364 304128 : specparm = colh2o(lay)/speccomb
365 304128 : if (specparm .ge. oneminus) specparm = oneminus
366 304128 : specmult = 8._r8*(specparm)
367 304128 : js = 1 + int(specmult)
368 304128 : fs = mod(specmult, 1._r8 )
369 304128 : fac000 = (1._r8 - fs) * fac00(lay)
370 304128 : fac010 = (1._r8 - fs) * fac10(lay)
371 304128 : fac100 = fs * fac00(lay)
372 304128 : fac110 = fs * fac10(lay)
373 304128 : fac001 = (1._r8 - fs) * fac01(lay)
374 304128 : fac011 = (1._r8 - fs) * fac11(lay)
375 304128 : fac101 = fs * fac01(lay)
376 304128 : fac111 = fs * fac11(lay)
377 304128 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(17) + js
378 304128 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(17) + js
379 304128 : inds = indself(lay)
380 304128 : indf = indfor(lay)
381 304128 : tauray = colmol(lay) * rayl
382 :
383 3967488 : do ig = 1, ng17
384 3649536 : taug(lay,ngs16+ig) = speccomb * &
385 7299072 : (fac000 * absa(ind0,ig) + &
386 3649536 : fac100 * absa(ind0+1,ig) + &
387 3649536 : fac010 * absa(ind0+9,ig) + &
388 3649536 : fac110 * absa(ind0+10,ig) + &
389 3649536 : fac001 * absa(ind1,ig) + &
390 3649536 : fac101 * absa(ind1+1,ig) + &
391 3649536 : fac011 * absa(ind1+9,ig) + &
392 3649536 : fac111 * absa(ind1+10,ig)) + &
393 3649536 : colh2o(lay) * &
394 7299072 : (selffac(lay) * (selfref(inds,ig) + &
395 3649536 : selffrac(lay) * &
396 3649536 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
397 7299072 : forfac(lay) * (forref(indf,ig) + &
398 3649536 : forfrac(lay) * &
399 51093504 : (forref(indf+1,ig) - forref(indf,ig))))
400 : ! ssa(lay,ngs16+ig) = tauray/taug(lay,ngs16+ig)
401 3953664 : taur(lay,ngs16+ig) = tauray
402 : enddo
403 : enddo
404 :
405 13824 : laysolfr = nlayers
406 :
407 : ! Upper atmosphere loop
408 566784 : do lay = laytrop+1, nlayers
409 552960 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
410 13824 : laysolfr = lay
411 552960 : speccomb = colh2o(lay) + strrat*colco2(lay)
412 552960 : specparm = colh2o(lay)/speccomb
413 552960 : if (specparm .ge. oneminus) specparm = oneminus
414 552960 : specmult = 4._r8*(specparm)
415 552960 : js = 1 + int(specmult)
416 552960 : fs = mod(specmult, 1._r8 )
417 552960 : fac000 = (1._r8 - fs) * fac00(lay)
418 552960 : fac010 = (1._r8 - fs) * fac10(lay)
419 552960 : fac100 = fs * fac00(lay)
420 552960 : fac110 = fs * fac10(lay)
421 552960 : fac001 = (1._r8 - fs) * fac01(lay)
422 552960 : fac011 = (1._r8 - fs) * fac11(lay)
423 552960 : fac101 = fs * fac01(lay)
424 552960 : fac111 = fs * fac11(lay)
425 552960 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(17) + js
426 552960 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(17) + js
427 552960 : indf = indfor(lay)
428 552960 : tauray = colmol(lay) * rayl
429 :
430 7202304 : do ig = 1, ng17
431 6635520 : taug(lay,ngs16+ig) = speccomb * &
432 13271040 : (fac000 * absb(ind0,ig) + &
433 6635520 : fac100 * absb(ind0+1,ig) + &
434 6635520 : fac010 * absb(ind0+5,ig) + &
435 6635520 : fac110 * absb(ind0+6,ig) + &
436 6635520 : fac001 * absb(ind1,ig) + &
437 6635520 : fac101 * absb(ind1+1,ig) + &
438 6635520 : fac011 * absb(ind1+5,ig) + &
439 6635520 : fac111 * absb(ind1+6,ig)) + &
440 6635520 : colh2o(lay) * &
441 13271040 : forfac(lay) * (forref(indf,ig) + &
442 6635520 : forfrac(lay) * &
443 79626240 : (forref(indf+1,ig) - forref(indf,ig)))
444 : ! ssa(lay,ngs16+ig) = tauray/taug(lay,ngs16+ig)
445 6801408 : if (lay .eq. laysolfr) sfluxzen(ngs16+ig) = sfluxref(ig,js) &
446 331776 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
447 7188480 : taur(lay,ngs16+ig) = tauray
448 : enddo
449 : enddo
450 :
451 13824 : end subroutine taumol17
452 :
453 : !----------------------------------------------------------------------------
454 13824 : subroutine taumol18
455 : !----------------------------------------------------------------------------
456 : !
457 : ! band 18: 4000-4650 cm-1 (low - h2o,ch4; high - ch4)
458 : !
459 : !----------------------------------------------------------------------------
460 :
461 : ! ------- Modules -------
462 :
463 : use parrrsw, only : ng18, ngs17
464 : use rrsw_kg18, only : absa, absb, forref, selfref, &
465 : sfluxref, rayl, layreffr, strrat
466 :
467 : ! ------- Declarations -------
468 :
469 : ! Local
470 :
471 : integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
472 : real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, &
473 : fac110, fac111, fs, speccomb, specmult, specparm, &
474 : tauray
475 :
476 : ! Compute the optical depth by interpolating in ln(pressure),
477 : ! temperature, and appropriate species. Below LAYTROP, the water
478 : ! vapor self-continuum is interpolated (in temperature) separately.
479 :
480 13824 : laysolfr = laytrop
481 :
482 : ! Lower atmosphere loop
483 317952 : do lay = 1, laytrop
484 304128 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
485 13824 : laysolfr = min(lay+1,laytrop)
486 304128 : speccomb = colh2o(lay) + strrat*colch4(lay)
487 304128 : specparm = colh2o(lay)/speccomb
488 304128 : if (specparm .ge. oneminus) specparm = oneminus
489 304128 : specmult = 8._r8*(specparm)
490 304128 : js = 1 + int(specmult)
491 304128 : fs = mod(specmult, 1._r8 )
492 304128 : fac000 = (1._r8 - fs) * fac00(lay)
493 304128 : fac010 = (1._r8 - fs) * fac10(lay)
494 304128 : fac100 = fs * fac00(lay)
495 304128 : fac110 = fs * fac10(lay)
496 304128 : fac001 = (1._r8 - fs) * fac01(lay)
497 304128 : fac011 = (1._r8 - fs) * fac11(lay)
498 304128 : fac101 = fs * fac01(lay)
499 304128 : fac111 = fs * fac11(lay)
500 304128 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(18) + js
501 304128 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(18) + js
502 304128 : inds = indself(lay)
503 304128 : indf = indfor(lay)
504 304128 : tauray = colmol(lay) * rayl
505 :
506 2750976 : do ig = 1, ng18
507 2433024 : taug(lay,ngs17+ig) = speccomb * &
508 4866048 : (fac000 * absa(ind0,ig) + &
509 2433024 : fac100 * absa(ind0+1,ig) + &
510 2433024 : fac010 * absa(ind0+9,ig) + &
511 2433024 : fac110 * absa(ind0+10,ig) + &
512 2433024 : fac001 * absa(ind1,ig) + &
513 2433024 : fac101 * absa(ind1+1,ig) + &
514 2433024 : fac011 * absa(ind1+9,ig) + &
515 2433024 : fac111 * absa(ind1+10,ig)) + &
516 2433024 : colh2o(lay) * &
517 4866048 : (selffac(lay) * (selfref(inds,ig) + &
518 2433024 : selffrac(lay) * &
519 2433024 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
520 4866048 : forfac(lay) * (forref(indf,ig) + &
521 2433024 : forfrac(lay) * &
522 34062336 : (forref(indf+1,ig) - forref(indf,ig))))
523 : ! ssa(lay,ngs17+ig) = tauray/taug(lay,ngs17+ig)
524 2543616 : if (lay .eq. laysolfr) sfluxzen(ngs17+ig) = sfluxref(ig,js) &
525 221184 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
526 2737152 : taur(lay,ngs17+ig) = tauray
527 : enddo
528 : enddo
529 :
530 : ! Upper atmosphere loop
531 566784 : do lay = laytrop+1, nlayers
532 552960 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(18) + 1
533 552960 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(18) + 1
534 552960 : tauray = colmol(lay) * rayl
535 :
536 4990464 : do ig = 1, ng18
537 4423680 : taug(lay,ngs17+ig) = colch4(lay) * &
538 13271040 : (fac00(lay) * absb(ind0,ig) + &
539 8847360 : fac10(lay) * absb(ind0+1,ig) + &
540 8847360 : fac01(lay) * absb(ind1,ig) + &
541 26542080 : fac11(lay) * absb(ind1+1,ig))
542 : ! ssa(lay,ngs17+ig) = tauray/taug(lay,ngs17+ig)
543 4976640 : taur(lay,ngs17+ig) = tauray
544 : enddo
545 : enddo
546 :
547 13824 : end subroutine taumol18
548 :
549 : !----------------------------------------------------------------------------
550 13824 : subroutine taumol19
551 : !----------------------------------------------------------------------------
552 : !
553 : ! band 19: 4650-5150 cm-1 (low - h2o,co2; high - co2)
554 : !
555 : !----------------------------------------------------------------------------
556 :
557 : ! ------- Modules -------
558 :
559 : use parrrsw, only : ng19, ngs18
560 : use rrsw_kg19, only : absa, absb, forref, selfref, &
561 : sfluxref, rayl, layreffr, strrat
562 :
563 : ! ------- Declarations -------
564 :
565 : ! Local
566 :
567 : integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
568 : real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, &
569 : fac110, fac111, fs, speccomb, specmult, specparm, &
570 : tauray
571 :
572 : ! Compute the optical depth by interpolating in ln(pressure),
573 : ! temperature, and appropriate species. Below LAYTROP, the water
574 : ! vapor self-continuum is interpolated (in temperature) separately.
575 :
576 13824 : laysolfr = laytrop
577 :
578 : ! Lower atmosphere loop
579 317952 : do lay = 1, laytrop
580 304128 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
581 12528 : laysolfr = min(lay+1,laytrop)
582 304128 : speccomb = colh2o(lay) + strrat*colco2(lay)
583 304128 : specparm = colh2o(lay)/speccomb
584 304128 : if (specparm .ge. oneminus) specparm = oneminus
585 304128 : specmult = 8._r8*(specparm)
586 304128 : js = 1 + int(specmult)
587 304128 : fs = mod(specmult, 1._r8 )
588 304128 : fac000 = (1._r8 - fs) * fac00(lay)
589 304128 : fac010 = (1._r8 - fs) * fac10(lay)
590 304128 : fac100 = fs * fac00(lay)
591 304128 : fac110 = fs * fac10(lay)
592 304128 : fac001 = (1._r8 - fs) * fac01(lay)
593 304128 : fac011 = (1._r8 - fs) * fac11(lay)
594 304128 : fac101 = fs * fac01(lay)
595 304128 : fac111 = fs * fac11(lay)
596 304128 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(19) + js
597 304128 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(19) + js
598 304128 : inds = indself(lay)
599 304128 : indf = indfor(lay)
600 304128 : tauray = colmol(lay) * rayl
601 :
602 2750976 : do ig = 1 , ng19
603 2433024 : taug(lay,ngs18+ig) = speccomb * &
604 4866048 : (fac000 * absa(ind0,ig) + &
605 2433024 : fac100 * absa(ind0+1,ig) + &
606 2433024 : fac010 * absa(ind0+9,ig) + &
607 2433024 : fac110 * absa(ind0+10,ig) + &
608 2433024 : fac001 * absa(ind1,ig) + &
609 2433024 : fac101 * absa(ind1+1,ig) + &
610 2433024 : fac011 * absa(ind1+9,ig) + &
611 2433024 : fac111 * absa(ind1+10,ig)) + &
612 2433024 : colh2o(lay) * &
613 4866048 : (selffac(lay) * (selfref(inds,ig) + &
614 2433024 : selffrac(lay) * &
615 2433024 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
616 4866048 : forfac(lay) * (forref(indf,ig) + &
617 2433024 : forfrac(lay) * &
618 34062336 : (forref(indf+1,ig) - forref(indf,ig))))
619 : ! ssa(lay,ngs18+ig) = tauray/taug(lay,ngs18+ig)
620 2543616 : if (lay .eq. laysolfr) sfluxzen(ngs18+ig) = sfluxref(ig,js) &
621 221184 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
622 2737152 : taur(lay,ngs18+ig) = tauray
623 : enddo
624 : enddo
625 :
626 : ! Upper atmosphere loop
627 566784 : do lay = laytrop+1, nlayers
628 552960 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(19) + 1
629 552960 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(19) + 1
630 552960 : tauray = colmol(lay) * rayl
631 :
632 4990464 : do ig = 1 , ng19
633 4423680 : taug(lay,ngs18+ig) = colco2(lay) * &
634 13271040 : (fac00(lay) * absb(ind0,ig) + &
635 8847360 : fac10(lay) * absb(ind0+1,ig) + &
636 8847360 : fac01(lay) * absb(ind1,ig) + &
637 26542080 : fac11(lay) * absb(ind1+1,ig))
638 : ! ssa(lay,ngs18+ig) = tauray/taug(lay,ngs18+ig)
639 4976640 : taur(lay,ngs18+ig) = tauray
640 : enddo
641 : enddo
642 :
643 13824 : end subroutine taumol19
644 :
645 : !----------------------------------------------------------------------------
646 13824 : subroutine taumol20
647 : !----------------------------------------------------------------------------
648 : !
649 : ! band 20: 5150-6150 cm-1 (low - h2o; high - h2o)
650 : !
651 : !----------------------------------------------------------------------------
652 :
653 : ! ------- Modules -------
654 :
655 : use parrrsw, only : ng20, ngs19
656 : use rrsw_kg20, only : absa, absb, forref, selfref, &
657 : sfluxref, absch4, rayl, layreffr
658 :
659 : implicit none
660 :
661 : ! ------- Declarations -------
662 :
663 : ! Local
664 :
665 : integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
666 : real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, &
667 : fac110, fac111, fs, speccomb, specmult, specparm, &
668 : tauray
669 :
670 : ! Compute the optical depth by interpolating in ln(pressure),
671 : ! temperature, and appropriate species. Below LAYTROP, the water
672 : ! vapor self-continuum is interpolated (in temperature) separately.
673 :
674 13824 : laysolfr = laytrop
675 :
676 : ! Lower atmosphere loop
677 317952 : do lay = 1, laytrop
678 304128 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
679 12528 : laysolfr = min(lay+1,laytrop)
680 304128 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(20) + 1
681 304128 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(20) + 1
682 304128 : inds = indself(lay)
683 304128 : indf = indfor(lay)
684 304128 : tauray = colmol(lay) * rayl
685 :
686 3359232 : do ig = 1, ng20
687 3041280 : taug(lay,ngs19+ig) = colh2o(lay) * &
688 9123840 : ((fac00(lay) * absa(ind0,ig) + &
689 6082560 : fac10(lay) * absa(ind0+1,ig) + &
690 6082560 : fac01(lay) * absa(ind1,ig) + &
691 6082560 : fac11(lay) * absa(ind1+1,ig)) + &
692 6082560 : selffac(lay) * (selfref(inds,ig) + &
693 3041280 : selffrac(lay) * &
694 3041280 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
695 6082560 : forfac(lay) * (forref(indf,ig) + &
696 3041280 : forfrac(lay) * &
697 3041280 : (forref(indf+1,ig) - forref(indf,ig)))) &
698 33454080 : + colch4(lay) * absch4(ig)
699 : ! ssa(lay,ngs19+ig) = tauray/taug(lay,ngs19+ig)
700 3041280 : taur(lay,ngs19+ig) = tauray
701 3345408 : if (lay .eq. laysolfr) sfluxzen(ngs19+ig) = sfluxref(ig)
702 : enddo
703 : enddo
704 :
705 : ! Upper atmosphere loop
706 566784 : do lay = laytrop+1, nlayers
707 552960 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(20) + 1
708 552960 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(20) + 1
709 552960 : indf = indfor(lay)
710 552960 : tauray = colmol(lay) * rayl
711 :
712 6096384 : do ig = 1, ng20
713 5529600 : taug(lay,ngs19+ig) = colh2o(lay) * &
714 16588800 : (fac00(lay) * absb(ind0,ig) + &
715 11059200 : fac10(lay) * absb(ind0+1,ig) + &
716 11059200 : fac01(lay) * absb(ind1,ig) + &
717 11059200 : fac11(lay) * absb(ind1+1,ig) + &
718 11059200 : forfac(lay) * (forref(indf,ig) + &
719 5529600 : forfrac(lay) * &
720 5529600 : (forref(indf+1,ig) - forref(indf,ig)))) + &
721 49766400 : colch4(lay) * absch4(ig)
722 : ! ssa(lay,ngs19+ig) = tauray/taug(lay,ngs19+ig)
723 6082560 : taur(lay,ngs19+ig) = tauray
724 : enddo
725 : enddo
726 :
727 13824 : end subroutine taumol20
728 :
729 : !----------------------------------------------------------------------------
730 13824 : subroutine taumol21
731 : !----------------------------------------------------------------------------
732 : !
733 : ! band 21: 6150-7700 cm-1 (low - h2o,co2; high - h2o,co2)
734 : !
735 : !----------------------------------------------------------------------------
736 :
737 : ! ------- Modules -------
738 :
739 : use parrrsw, only : ng21, ngs20
740 : use rrsw_kg21, only : absa, absb, forref, selfref, &
741 : sfluxref, rayl, layreffr, strrat
742 :
743 : ! ------- Declarations -------
744 :
745 : ! Local
746 :
747 : integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
748 : real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, &
749 : fac110, fac111, fs, speccomb, specmult, specparm, &
750 : tauray
751 :
752 : ! Compute the optical depth by interpolating in ln(pressure),
753 : ! temperature, and appropriate species. Below LAYTROP, the water
754 : ! vapor self-continuum is interpolated (in temperature) separately.
755 :
756 13824 : laysolfr = laytrop
757 :
758 : ! Lower atmosphere loop
759 317952 : do lay = 1, laytrop
760 304128 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
761 13824 : laysolfr = min(lay+1,laytrop)
762 304128 : speccomb = colh2o(lay) + strrat*colco2(lay)
763 304128 : specparm = colh2o(lay)/speccomb
764 304128 : if (specparm .ge. oneminus) specparm = oneminus
765 304128 : specmult = 8._r8*(specparm)
766 304128 : js = 1 + int(specmult)
767 304128 : fs = mod(specmult, 1._r8 )
768 304128 : fac000 = (1._r8 - fs) * fac00(lay)
769 304128 : fac010 = (1._r8 - fs) * fac10(lay)
770 304128 : fac100 = fs * fac00(lay)
771 304128 : fac110 = fs * fac10(lay)
772 304128 : fac001 = (1._r8 - fs) * fac01(lay)
773 304128 : fac011 = (1._r8 - fs) * fac11(lay)
774 304128 : fac101 = fs * fac01(lay)
775 304128 : fac111 = fs * fac11(lay)
776 304128 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(21) + js
777 304128 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(21) + js
778 304128 : inds = indself(lay)
779 304128 : indf = indfor(lay)
780 304128 : tauray = colmol(lay) * rayl
781 :
782 3359232 : do ig = 1, ng21
783 3041280 : taug(lay,ngs20+ig) = speccomb * &
784 6082560 : (fac000 * absa(ind0,ig) + &
785 3041280 : fac100 * absa(ind0+1,ig) + &
786 3041280 : fac010 * absa(ind0+9,ig) + &
787 3041280 : fac110 * absa(ind0+10,ig) + &
788 3041280 : fac001 * absa(ind1,ig) + &
789 3041280 : fac101 * absa(ind1+1,ig) + &
790 3041280 : fac011 * absa(ind1+9,ig) + &
791 3041280 : fac111 * absa(ind1+10,ig)) + &
792 3041280 : colh2o(lay) * &
793 6082560 : (selffac(lay) * (selfref(inds,ig) + &
794 3041280 : selffrac(lay) * &
795 3041280 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
796 6082560 : forfac(lay) * (forref(indf,ig) + &
797 3041280 : forfrac(lay) * &
798 42577920 : (forref(indf+1,ig) - forref(indf,ig))))
799 : ! ssa(lay,ngs20+ig) = tauray/taug(lay,ngs20+ig)
800 3179520 : if (lay .eq. laysolfr) sfluxzen(ngs20+ig) = sfluxref(ig,js) &
801 276480 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
802 3345408 : taur(lay,ngs20+ig) = tauray
803 : enddo
804 : enddo
805 :
806 : ! Upper atmosphere loop
807 566784 : do lay = laytrop+1, nlayers
808 552960 : speccomb = colh2o(lay) + strrat*colco2(lay)
809 552960 : specparm = colh2o(lay)/speccomb
810 552960 : if (specparm .ge. oneminus) specparm = oneminus
811 552960 : specmult = 4._r8*(specparm)
812 552960 : js = 1 + int(specmult)
813 552960 : fs = mod(specmult, 1._r8 )
814 552960 : fac000 = (1._r8 - fs) * fac00(lay)
815 552960 : fac010 = (1._r8 - fs) * fac10(lay)
816 552960 : fac100 = fs * fac00(lay)
817 552960 : fac110 = fs * fac10(lay)
818 552960 : fac001 = (1._r8 - fs) * fac01(lay)
819 552960 : fac011 = (1._r8 - fs) * fac11(lay)
820 552960 : fac101 = fs * fac01(lay)
821 552960 : fac111 = fs * fac11(lay)
822 552960 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(21) + js
823 552960 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(21) + js
824 552960 : indf = indfor(lay)
825 552960 : tauray = colmol(lay) * rayl
826 :
827 6096384 : do ig = 1, ng21
828 5529600 : taug(lay,ngs20+ig) = speccomb * &
829 11059200 : (fac000 * absb(ind0,ig) + &
830 5529600 : fac100 * absb(ind0+1,ig) + &
831 5529600 : fac010 * absb(ind0+5,ig) + &
832 5529600 : fac110 * absb(ind0+6,ig) + &
833 5529600 : fac001 * absb(ind1,ig) + &
834 5529600 : fac101 * absb(ind1+1,ig) + &
835 5529600 : fac011 * absb(ind1+5,ig) + &
836 5529600 : fac111 * absb(ind1+6,ig)) + &
837 5529600 : colh2o(lay) * &
838 11059200 : forfac(lay) * (forref(indf,ig) + &
839 5529600 : forfrac(lay) * &
840 66355200 : (forref(indf+1,ig) - forref(indf,ig)))
841 : ! ssa(lay,ngs20+ig) = tauray/taug(lay,ngs20+ig)
842 6082560 : taur(lay,ngs20+ig) = tauray
843 : enddo
844 : enddo
845 :
846 13824 : end subroutine taumol21
847 :
848 : !----------------------------------------------------------------------------
849 13824 : subroutine taumol22
850 : !----------------------------------------------------------------------------
851 : !
852 : ! band 22: 7700-8050 cm-1 (low - h2o,o2; high - o2)
853 : !
854 : !----------------------------------------------------------------------------
855 :
856 : ! ------- Modules -------
857 :
858 : use parrrsw, only : ng22, ngs21
859 : use rrsw_kg22, only : absa, absb, forref, selfref, &
860 : sfluxref, rayl, layreffr, strrat
861 :
862 : ! ------- Declarations -------
863 :
864 : ! Local
865 :
866 : integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
867 : real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, &
868 : fac110, fac111, fs, speccomb, specmult, specparm, &
869 : tauray, o2adj, o2cont
870 :
871 : ! The following factor is the ratio of total O2 band intensity (lines
872 : ! and Mate continuum) to O2 band intensity (line only). It is needed
873 : ! to adjust the optical depths since the k's include only lines.
874 13824 : o2adj = 1.6_r8
875 :
876 : ! Compute the optical depth by interpolating in ln(pressure),
877 : ! temperature, and appropriate species. Below LAYTROP, the water
878 : ! vapor self-continuum is interpolated (in temperature) separately.
879 :
880 13824 : laysolfr = laytrop
881 :
882 : ! Lower atmosphere loop
883 317952 : do lay = 1, laytrop
884 304128 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
885 11408 : laysolfr = min(lay+1,laytrop)
886 304128 : o2cont = 4.35e-4_r8*colo2(lay)/(350.0_r8*2.0_r8)
887 304128 : speccomb = colh2o(lay) + o2adj*strrat*colo2(lay)
888 304128 : specparm = colh2o(lay)/speccomb
889 304128 : if (specparm .ge. oneminus) specparm = oneminus
890 304128 : specmult = 8._r8*(specparm)
891 : ! odadj = specparm + o2adj * (1._r8 - specparm)
892 304128 : js = 1 + int(specmult)
893 304128 : fs = mod(specmult, 1._r8 )
894 304128 : fac000 = (1._r8 - fs) * fac00(lay)
895 304128 : fac010 = (1._r8 - fs) * fac10(lay)
896 304128 : fac100 = fs * fac00(lay)
897 304128 : fac110 = fs * fac10(lay)
898 304128 : fac001 = (1._r8 - fs) * fac01(lay)
899 304128 : fac011 = (1._r8 - fs) * fac11(lay)
900 304128 : fac101 = fs * fac01(lay)
901 304128 : fac111 = fs * fac11(lay)
902 304128 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(22) + js
903 304128 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(22) + js
904 304128 : inds = indself(lay)
905 304128 : indf = indfor(lay)
906 304128 : tauray = colmol(lay) * rayl
907 :
908 926208 : do ig = 1, ng22
909 608256 : taug(lay,ngs21+ig) = speccomb * &
910 1216512 : (fac000 * absa(ind0,ig) + &
911 608256 : fac100 * absa(ind0+1,ig) + &
912 608256 : fac010 * absa(ind0+9,ig) + &
913 608256 : fac110 * absa(ind0+10,ig) + &
914 608256 : fac001 * absa(ind1,ig) + &
915 608256 : fac101 * absa(ind1+1,ig) + &
916 608256 : fac011 * absa(ind1+9,ig) + &
917 608256 : fac111 * absa(ind1+10,ig)) + &
918 608256 : colh2o(lay) * &
919 1216512 : (selffac(lay) * (selfref(inds,ig) + &
920 608256 : selffrac(lay) * &
921 608256 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
922 1216512 : forfac(lay) * (forref(indf,ig) + &
923 608256 : forfrac(lay) * &
924 608256 : (forref(indf+1,ig) - forref(indf,ig)))) &
925 8515584 : + o2cont
926 : ! ssa(lay,ngs21+ig) = tauray/taug(lay,ngs21+ig)
927 635904 : if (lay .eq. laysolfr) sfluxzen(ngs21+ig) = sfluxref(ig,js) &
928 55296 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
929 912384 : taur(lay,ngs21+ig) = tauray
930 : enddo
931 : enddo
932 :
933 : ! Upper atmosphere loop
934 566784 : do lay = laytrop+1, nlayers
935 552960 : o2cont = 4.35e-4_r8*colo2(lay)/(350.0_r8*2.0_r8)
936 552960 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(22) + 1
937 552960 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(22) + 1
938 552960 : tauray = colmol(lay) * rayl
939 :
940 1672704 : do ig = 1, ng22
941 1105920 : taug(lay,ngs21+ig) = colo2(lay) * o2adj * &
942 3317760 : (fac00(lay) * absb(ind0,ig) + &
943 2211840 : fac10(lay) * absb(ind0+1,ig) + &
944 2211840 : fac01(lay) * absb(ind1,ig) + &
945 2211840 : fac11(lay) * absb(ind1+1,ig)) + &
946 6635520 : o2cont
947 : ! ssa(lay,ngs21+ig) = tauray/taug(lay,ngs21+ig)
948 1658880 : taur(lay,ngs21+ig) = tauray
949 : enddo
950 : enddo
951 :
952 13824 : end subroutine taumol22
953 :
954 : !----------------------------------------------------------------------------
955 13824 : subroutine taumol23
956 : !----------------------------------------------------------------------------
957 : !
958 : ! band 23: 8050-12850 cm-1 (low - h2o; high - nothing)
959 : !
960 : !----------------------------------------------------------------------------
961 :
962 : ! ------- Modules -------
963 :
964 : use parrrsw, only : ng23, ngs22
965 : use rrsw_kg23, only : absa, forref, selfref, &
966 : sfluxref, rayl, layreffr, givfac
967 :
968 : ! ------- Declarations -------
969 :
970 : ! Local
971 :
972 : integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
973 : real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, &
974 : fac110, fac111, fs, speccomb, specmult, specparm, &
975 : tauray
976 :
977 : ! Compute the optical depth by interpolating in ln(pressure),
978 : ! temperature, and appropriate species. Below LAYTROP, the water
979 : ! vapor self-continuum is interpolated (in temperature) separately.
980 :
981 13824 : laysolfr = laytrop
982 :
983 : ! Lower atmosphere loop
984 317952 : do lay = 1, laytrop
985 304128 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
986 13824 : laysolfr = min(lay+1,laytrop)
987 304128 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(23) + 1
988 304128 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(23) + 1
989 304128 : inds = indself(lay)
990 304128 : indf = indfor(lay)
991 :
992 3359232 : do ig = 1, ng23
993 3041280 : tauray = colmol(lay) * rayl(ig)
994 3041280 : taug(lay,ngs22+ig) = colh2o(lay) * &
995 6082560 : (givfac * (fac00(lay) * absa(ind0,ig) + &
996 6082560 : fac10(lay) * absa(ind0+1,ig) + &
997 6082560 : fac01(lay) * absa(ind1,ig) + &
998 6082560 : fac11(lay) * absa(ind1+1,ig)) + &
999 6082560 : selffac(lay) * (selfref(inds,ig) + &
1000 3041280 : selffrac(lay) * &
1001 3041280 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
1002 6082560 : forfac(lay) * (forref(indf,ig) + &
1003 3041280 : forfrac(lay) * &
1004 27371520 : (forref(indf+1,ig) - forref(indf,ig))))
1005 : ! ssa(lay,ngs22+ig) = tauray/taug(lay,ngs22+ig)
1006 3041280 : if (lay .eq. laysolfr) sfluxzen(ngs22+ig) = sfluxref(ig)
1007 3345408 : taur(lay,ngs22+ig) = tauray
1008 : enddo
1009 : enddo
1010 :
1011 : ! Upper atmosphere loop
1012 566784 : do lay = laytrop+1, nlayers
1013 6096384 : do ig = 1, ng23
1014 : ! taug(lay,ngs22+ig) = colmol(lay) * rayl(ig)
1015 : ! ssa(lay,ngs22+ig) = 1.0_r8
1016 5529600 : taug(lay,ngs22+ig) = 0._r8
1017 6082560 : taur(lay,ngs22+ig) = colmol(lay) * rayl(ig)
1018 : enddo
1019 : enddo
1020 :
1021 13824 : end subroutine taumol23
1022 :
1023 : !----------------------------------------------------------------------------
1024 13824 : subroutine taumol24
1025 : !----------------------------------------------------------------------------
1026 : !
1027 : ! band 24: 12850-16000 cm-1 (low - h2o,o2; high - o2)
1028 : !
1029 : !----------------------------------------------------------------------------
1030 :
1031 : ! ------- Modules -------
1032 :
1033 : use parrrsw, only : ng24, ngs23
1034 : use rrsw_kg24, only : absa, absb, forref, selfref, &
1035 : sfluxref, abso3a, abso3b, rayla, raylb, &
1036 : layreffr, strrat
1037 :
1038 : ! ------- Declarations -------
1039 :
1040 : ! Local
1041 :
1042 : integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
1043 : real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, &
1044 : fac110, fac111, fs, speccomb, specmult, specparm, &
1045 : tauray
1046 :
1047 : ! Compute the optical depth by interpolating in ln(pressure),
1048 : ! temperature, and appropriate species. Below LAYTROP, the water
1049 : ! vapor self-continuum is interpolated (in temperature) separately.
1050 :
1051 13824 : laysolfr = laytrop
1052 :
1053 : ! Lower atmosphere loop
1054 317952 : do lay = 1, laytrop
1055 304128 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
1056 0 : laysolfr = min(lay+1,laytrop)
1057 304128 : speccomb = colh2o(lay) + strrat*colo2(lay)
1058 304128 : specparm = colh2o(lay)/speccomb
1059 304128 : if (specparm .ge. oneminus) specparm = oneminus
1060 304128 : specmult = 8._r8*(specparm)
1061 304128 : js = 1 + int(specmult)
1062 304128 : fs = mod(specmult, 1._r8 )
1063 304128 : fac000 = (1._r8 - fs) * fac00(lay)
1064 304128 : fac010 = (1._r8 - fs) * fac10(lay)
1065 304128 : fac100 = fs * fac00(lay)
1066 304128 : fac110 = fs * fac10(lay)
1067 304128 : fac001 = (1._r8 - fs) * fac01(lay)
1068 304128 : fac011 = (1._r8 - fs) * fac11(lay)
1069 304128 : fac101 = fs * fac01(lay)
1070 304128 : fac111 = fs * fac11(lay)
1071 304128 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(24) + js
1072 304128 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(24) + js
1073 304128 : inds = indself(lay)
1074 304128 : indf = indfor(lay)
1075 :
1076 2750976 : do ig = 1, ng24
1077 7299072 : tauray = colmol(lay) * (rayla(ig,js) + &
1078 7299072 : fs * (rayla(ig,js+1) - rayla(ig,js)))
1079 2433024 : taug(lay,ngs23+ig) = speccomb * &
1080 2433024 : (fac000 * absa(ind0,ig) + &
1081 2433024 : fac100 * absa(ind0+1,ig) + &
1082 2433024 : fac010 * absa(ind0+9,ig) + &
1083 2433024 : fac110 * absa(ind0+10,ig) + &
1084 2433024 : fac001 * absa(ind1,ig) + &
1085 2433024 : fac101 * absa(ind1+1,ig) + &
1086 2433024 : fac011 * absa(ind1+9,ig) + &
1087 2433024 : fac111 * absa(ind1+10,ig)) + &
1088 2433024 : colo3(lay) * abso3a(ig) + &
1089 2433024 : colh2o(lay) * &
1090 4866048 : (selffac(lay) * (selfref(inds,ig) + &
1091 2433024 : selffrac(lay) * &
1092 2433024 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
1093 4866048 : forfac(lay) * (forref(indf,ig) + &
1094 2433024 : forfrac(lay) * &
1095 31629312 : (forref(indf+1,ig) - forref(indf,ig))))
1096 : ! ssa(lay,ngs23+ig) = tauray/taug(lay,ngs23+ig)
1097 2433024 : if (lay .eq. laysolfr) sfluxzen(ngs23+ig) = sfluxref(ig,js) &
1098 110592 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
1099 2737152 : taur(lay,ngs23+ig) = tauray
1100 : enddo
1101 : enddo
1102 :
1103 : ! Upper atmosphere loop
1104 566784 : do lay = laytrop+1, nlayers
1105 552960 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(24) + 1
1106 552960 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(24) + 1
1107 :
1108 4990464 : do ig = 1, ng24
1109 4423680 : tauray = colmol(lay) * raylb(ig)
1110 4423680 : taug(lay,ngs23+ig) = colo2(lay) * &
1111 8847360 : (fac00(lay) * absb(ind0,ig) + &
1112 8847360 : fac10(lay) * absb(ind0+1,ig) + &
1113 8847360 : fac01(lay) * absb(ind1,ig) + &
1114 8847360 : fac11(lay) * absb(ind1+1,ig)) + &
1115 26542080 : colo3(lay) * abso3b(ig)
1116 : ! ssa(lay,ngs23+ig) = tauray/taug(lay,ngs23+ig)
1117 4976640 : taur(lay,ngs23+ig) = tauray
1118 : enddo
1119 : enddo
1120 :
1121 13824 : end subroutine taumol24
1122 :
1123 : !----------------------------------------------------------------------------
1124 13824 : subroutine taumol25
1125 : !----------------------------------------------------------------------------
1126 : !
1127 : ! band 25: 16000-22650 cm-1 (low - h2o; high - nothing)
1128 : !
1129 : !----------------------------------------------------------------------------
1130 :
1131 : ! ------- Modules -------
1132 :
1133 : use parrrsw, only : ng25, ngs24
1134 : use rrsw_kg25, only : absa, &
1135 : sfluxref, abso3a, abso3b, rayl, layreffr
1136 :
1137 : ! ------- Declarations -------
1138 :
1139 : ! Local
1140 :
1141 : integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
1142 : real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, &
1143 : fac110, fac111, fs, speccomb, specmult, specparm, &
1144 : tauray
1145 :
1146 : ! Compute the optical depth by interpolating in ln(pressure),
1147 : ! temperature, and appropriate species. Below LAYTROP, the water
1148 : ! vapor self-continuum is interpolated (in temperature) separately.
1149 :
1150 13824 : laysolfr = laytrop
1151 :
1152 : ! Lower atmosphere loop
1153 317952 : do lay = 1, laytrop
1154 304128 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
1155 11408 : laysolfr = min(lay+1,laytrop)
1156 304128 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(25) + 1
1157 304128 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(25) + 1
1158 :
1159 2142720 : do ig = 1, ng25
1160 1824768 : tauray = colmol(lay) * rayl(ig)
1161 1824768 : taug(lay,ngs24+ig) = colh2o(lay) * &
1162 3649536 : (fac00(lay) * absa(ind0,ig) + &
1163 3649536 : fac10(lay) * absa(ind0+1,ig) + &
1164 3649536 : fac01(lay) * absa(ind1,ig) + &
1165 3649536 : fac11(lay) * absa(ind1+1,ig)) + &
1166 10948608 : colo3(lay) * abso3a(ig)
1167 : ! ssa(lay,ngs24+ig) = tauray/taug(lay,ngs24+ig)
1168 1824768 : if (lay .eq. laysolfr) sfluxzen(ngs24+ig) = sfluxref(ig)
1169 2128896 : taur(lay,ngs24+ig) = tauray
1170 : enddo
1171 : enddo
1172 :
1173 : ! Upper atmosphere loop
1174 566784 : do lay = laytrop+1, nlayers
1175 3884544 : do ig = 1, ng25
1176 3317760 : tauray = colmol(lay) * rayl(ig)
1177 3317760 : taug(lay,ngs24+ig) = colo3(lay) * abso3b(ig)
1178 : ! ssa(lay,ngs24+ig) = tauray/taug(lay,ngs24+ig)
1179 3870720 : taur(lay,ngs24+ig) = tauray
1180 : enddo
1181 : enddo
1182 :
1183 13824 : end subroutine taumol25
1184 :
1185 : !----------------------------------------------------------------------------
1186 13824 : subroutine taumol26
1187 : !----------------------------------------------------------------------------
1188 : !
1189 : ! band 26: 22650-29000 cm-1 (low - nothing; high - nothing)
1190 : !
1191 : !----------------------------------------------------------------------------
1192 :
1193 : ! ------- Modules -------
1194 :
1195 : use parrrsw, only : ng26, ngs25
1196 : use rrsw_kg26, only : sfluxref, rayl
1197 :
1198 : ! ------- Declarations -------
1199 :
1200 : ! Local
1201 :
1202 : integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
1203 : real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, &
1204 : fac110, fac111, fs, speccomb, specmult, specparm, &
1205 : tauray
1206 :
1207 : ! Compute the optical depth by interpolating in ln(pressure),
1208 : ! temperature, and appropriate species. Below LAYTROP, the water
1209 : ! vapor self-continuum is interpolated (in temperature) separately.
1210 :
1211 13824 : laysolfr = laytrop
1212 :
1213 : ! Lower atmosphere loop
1214 317952 : do lay = 1, laytrop
1215 2142720 : do ig = 1, ng26
1216 : ! taug(lay,ngs25+ig) = colmol(lay) * rayl(ig)
1217 : ! ssa(lay,ngs25+ig) = 1.0_r8
1218 1824768 : if (lay .eq. laysolfr) sfluxzen(ngs25+ig) = sfluxref(ig)
1219 1824768 : taug(lay,ngs25+ig) = 0._r8
1220 2128896 : taur(lay,ngs25+ig) = colmol(lay) * rayl(ig)
1221 : enddo
1222 : enddo
1223 :
1224 : ! Upper atmosphere loop
1225 566784 : do lay = laytrop+1, nlayers
1226 3884544 : do ig = 1, ng26
1227 : ! taug(lay,ngs25+ig) = colmol(lay) * rayl(ig)
1228 : ! ssa(lay,ngs25+ig) = 1.0_r8
1229 3317760 : taug(lay,ngs25+ig) = 0._r8
1230 3870720 : taur(lay,ngs25+ig) = colmol(lay) * rayl(ig)
1231 : enddo
1232 : enddo
1233 :
1234 13824 : end subroutine taumol26
1235 :
1236 : !----------------------------------------------------------------------------
1237 13824 : subroutine taumol27
1238 : !----------------------------------------------------------------------------
1239 : !
1240 : ! band 27: 29000-38000 cm-1 (low - o3; high - o3)
1241 : !
1242 : !----------------------------------------------------------------------------
1243 :
1244 : ! ------- Modules -------
1245 :
1246 : use parrrsw, only : ng27, ngs26
1247 : use rrsw_kg27, only : absa, absb, &
1248 : sfluxref, rayl, layreffr, scalekur
1249 :
1250 : ! ------- Declarations -------
1251 :
1252 : ! Local
1253 :
1254 : integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
1255 : real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, &
1256 : fac110, fac111, fs, speccomb, specmult, specparm, &
1257 : tauray
1258 :
1259 : ! Compute the optical depth by interpolating in ln(pressure),
1260 : ! temperature, and appropriate species. Below LAYTROP, the water
1261 : ! vapor self-continuum is interpolated (in temperature) separately.
1262 :
1263 : ! Lower atmosphere loop
1264 317952 : do lay = 1, laytrop
1265 304128 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(27) + 1
1266 304128 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(27) + 1
1267 :
1268 2750976 : do ig = 1, ng27
1269 2433024 : tauray = colmol(lay) * rayl(ig)
1270 2433024 : taug(lay,ngs26+ig) = colo3(lay) * &
1271 4866048 : (fac00(lay) * absa(ind0,ig) + &
1272 4866048 : fac10(lay) * absa(ind0+1,ig) + &
1273 4866048 : fac01(lay) * absa(ind1,ig) + &
1274 12165120 : fac11(lay) * absa(ind1+1,ig))
1275 : ! ssa(lay,ngs26+ig) = tauray/taug(lay,ngs26+ig)
1276 2737152 : taur(lay,ngs26+ig) = tauray
1277 : enddo
1278 : enddo
1279 :
1280 13824 : laysolfr = nlayers
1281 :
1282 : ! Upper atmosphere loop
1283 566784 : do lay = laytrop+1, nlayers
1284 552960 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
1285 13824 : laysolfr = lay
1286 552960 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(27) + 1
1287 552960 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(27) + 1
1288 :
1289 4990464 : do ig = 1, ng27
1290 4423680 : tauray = colmol(lay) * rayl(ig)
1291 4423680 : taug(lay,ngs26+ig) = colo3(lay) * &
1292 8847360 : (fac00(lay) * absb(ind0,ig) + &
1293 8847360 : fac10(lay) * absb(ind0+1,ig) + &
1294 8847360 : fac01(lay) * absb(ind1,ig) + &
1295 22118400 : fac11(lay) * absb(ind1+1,ig))
1296 : ! ssa(lay,ngs26+ig) = tauray/taug(lay,ngs26+ig)
1297 4423680 : if (lay.eq.laysolfr) sfluxzen(ngs26+ig) = scalekur * sfluxref(ig)
1298 4976640 : taur(lay,ngs26+ig) = tauray
1299 : enddo
1300 : enddo
1301 :
1302 13824 : end subroutine taumol27
1303 :
1304 : !----------------------------------------------------------------------------
1305 13824 : subroutine taumol28
1306 : !----------------------------------------------------------------------------
1307 : !
1308 : ! band 28: 38000-50000 cm-1 (low - o3,o2; high - o3,o2)
1309 : !
1310 : !----------------------------------------------------------------------------
1311 :
1312 : ! ------- Modules -------
1313 :
1314 : use parrrsw, only : ng28, ngs27
1315 : use rrsw_kg28, only : absa, absb, &
1316 : sfluxref, rayl, layreffr, strrat
1317 :
1318 : ! ------- Declarations -------
1319 :
1320 : ! Local
1321 :
1322 : integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
1323 : real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, &
1324 : fac110, fac111, fs, speccomb, specmult, specparm, &
1325 : tauray
1326 :
1327 : ! Compute the optical depth by interpolating in ln(pressure),
1328 : ! temperature, and appropriate species. Below LAYTROP, the water
1329 : ! vapor self-continuum is interpolated (in temperature) separately.
1330 :
1331 : ! Lower atmosphere loop
1332 317952 : do lay = 1, laytrop
1333 304128 : speccomb = colo3(lay) + strrat*colo2(lay)
1334 304128 : specparm = colo3(lay)/speccomb
1335 304128 : if (specparm .ge. oneminus) specparm = oneminus
1336 304128 : specmult = 8._r8*(specparm)
1337 304128 : js = 1 + int(specmult)
1338 304128 : fs = mod(specmult, 1._r8 )
1339 304128 : fac000 = (1._r8 - fs) * fac00(lay)
1340 304128 : fac010 = (1._r8 - fs) * fac10(lay)
1341 304128 : fac100 = fs * fac00(lay)
1342 304128 : fac110 = fs * fac10(lay)
1343 304128 : fac001 = (1._r8 - fs) * fac01(lay)
1344 304128 : fac011 = (1._r8 - fs) * fac11(lay)
1345 304128 : fac101 = fs * fac01(lay)
1346 304128 : fac111 = fs * fac11(lay)
1347 304128 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(28) + js
1348 304128 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(28) + js
1349 304128 : tauray = colmol(lay) * rayl
1350 :
1351 2142720 : do ig = 1, ng28
1352 1824768 : taug(lay,ngs27+ig) = speccomb * &
1353 3649536 : (fac000 * absa(ind0,ig) + &
1354 1824768 : fac100 * absa(ind0+1,ig) + &
1355 1824768 : fac010 * absa(ind0+9,ig) + &
1356 1824768 : fac110 * absa(ind0+10,ig) + &
1357 1824768 : fac001 * absa(ind1,ig) + &
1358 1824768 : fac101 * absa(ind1+1,ig) + &
1359 1824768 : fac011 * absa(ind1+9,ig) + &
1360 18247680 : fac111 * absa(ind1+10,ig))
1361 : ! ssa(lay,ngs27+ig) = tauray/taug(lay,ngs27+ig)
1362 2128896 : taur(lay,ngs27+ig) = tauray
1363 : enddo
1364 : enddo
1365 :
1366 13824 : laysolfr = nlayers
1367 :
1368 : ! Upper atmosphere loop
1369 566784 : do lay = laytrop+1, nlayers
1370 552960 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
1371 13824 : laysolfr = lay
1372 552960 : speccomb = colo3(lay) + strrat*colo2(lay)
1373 552960 : specparm = colo3(lay)/speccomb
1374 552960 : if (specparm .ge. oneminus) specparm = oneminus
1375 552960 : specmult = 4._r8*(specparm)
1376 552960 : js = 1 + int(specmult)
1377 552960 : fs = mod(specmult, 1._r8 )
1378 552960 : fac000 = (1._r8 - fs) * fac00(lay)
1379 552960 : fac010 = (1._r8 - fs) * fac10(lay)
1380 552960 : fac100 = fs * fac00(lay)
1381 552960 : fac110 = fs * fac10(lay)
1382 552960 : fac001 = (1._r8 - fs) * fac01(lay)
1383 552960 : fac011 = (1._r8 - fs) * fac11(lay)
1384 552960 : fac101 = fs * fac01(lay)
1385 552960 : fac111 = fs * fac11(lay)
1386 552960 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(28) + js
1387 552960 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(28) + js
1388 552960 : tauray = colmol(lay) * rayl
1389 :
1390 3884544 : do ig = 1, ng28
1391 3317760 : taug(lay,ngs27+ig) = speccomb * &
1392 6635520 : (fac000 * absb(ind0,ig) + &
1393 3317760 : fac100 * absb(ind0+1,ig) + &
1394 3317760 : fac010 * absb(ind0+5,ig) + &
1395 3317760 : fac110 * absb(ind0+6,ig) + &
1396 3317760 : fac001 * absb(ind1,ig) + &
1397 3317760 : fac101 * absb(ind1+1,ig) + &
1398 3317760 : fac011 * absb(ind1+5,ig) + &
1399 33177600 : fac111 * absb(ind1+6,ig))
1400 : ! ssa(lay,ngs27+ig) = tauray/taug(lay,ngs27+ig)
1401 3400704 : if (lay .eq. laysolfr) sfluxzen(ngs27+ig) = sfluxref(ig,js) &
1402 165888 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
1403 3870720 : taur(lay,ngs27+ig) = tauray
1404 : enddo
1405 : enddo
1406 :
1407 13824 : end subroutine taumol28
1408 :
1409 : !----------------------------------------------------------------------------
1410 13824 : subroutine taumol29
1411 : !----------------------------------------------------------------------------
1412 : !
1413 : ! band 29: 820-2600 cm-1 (low - h2o; high - co2)
1414 : !
1415 : !----------------------------------------------------------------------------
1416 :
1417 : ! ------- Modules -------
1418 :
1419 : use parrrsw, only : ng29, ngs28
1420 : use rrsw_kg29, only : absa, absb, forref, selfref, &
1421 : sfluxref, absh2o, absco2, rayl, layreffr
1422 :
1423 : ! ------- Declarations -------
1424 :
1425 : ! Local
1426 :
1427 : integer :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
1428 : real(kind=r8) :: fac000, fac001, fac010, fac011, fac100, fac101, &
1429 : fac110, fac111, fs, speccomb, specmult, specparm, &
1430 : tauray
1431 :
1432 : ! Compute the optical depth by interpolating in ln(pressure),
1433 : ! temperature, and appropriate species. Below LAYTROP, the water
1434 : ! vapor self-continuum is interpolated (in temperature) separately.
1435 :
1436 : ! Lower atmosphere loop
1437 317952 : do lay = 1, laytrop
1438 304128 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(29) + 1
1439 304128 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(29) + 1
1440 304128 : inds = indself(lay)
1441 304128 : indf = indfor(lay)
1442 304128 : tauray = colmol(lay) * rayl
1443 :
1444 3967488 : do ig = 1, ng29
1445 3649536 : taug(lay,ngs28+ig) = colh2o(lay) * &
1446 10948608 : ((fac00(lay) * absa(ind0,ig) + &
1447 7299072 : fac10(lay) * absa(ind0+1,ig) + &
1448 7299072 : fac01(lay) * absa(ind1,ig) + &
1449 7299072 : fac11(lay) * absa(ind1+1,ig)) + &
1450 7299072 : selffac(lay) * (selfref(inds,ig) + &
1451 3649536 : selffrac(lay) * &
1452 3649536 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
1453 7299072 : forfac(lay) * (forref(indf,ig) + &
1454 3649536 : forfrac(lay) * &
1455 3649536 : (forref(indf+1,ig) - forref(indf,ig)))) &
1456 40144896 : + colco2(lay) * absco2(ig)
1457 : ! ssa(lay,ngs28+ig) = tauray/taug(lay,ngs28+ig)
1458 3953664 : taur(lay,ngs28+ig) = tauray
1459 : enddo
1460 : enddo
1461 :
1462 13824 : laysolfr = nlayers
1463 :
1464 : ! Upper atmosphere loop
1465 566784 : do lay = laytrop+1, nlayers
1466 552960 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
1467 13824 : laysolfr = lay
1468 552960 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(29) + 1
1469 552960 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(29) + 1
1470 552960 : tauray = colmol(lay) * rayl
1471 :
1472 7202304 : do ig = 1, ng29
1473 6635520 : taug(lay,ngs28+ig) = colco2(lay) * &
1474 19906560 : (fac00(lay) * absb(ind0,ig) + &
1475 13271040 : fac10(lay) * absb(ind0+1,ig) + &
1476 13271040 : fac01(lay) * absb(ind1,ig) + &
1477 13271040 : fac11(lay) * absb(ind1+1,ig)) &
1478 46448640 : + colh2o(lay) * absh2o(ig)
1479 : ! ssa(lay,ngs28+ig) = tauray/taug(lay,ngs28+ig)
1480 6635520 : if (lay .eq. laysolfr) sfluxzen(ngs28+ig) = sfluxref(ig)
1481 7188480 : taur(lay,ngs28+ig) = tauray
1482 : enddo
1483 : enddo
1484 :
1485 13824 : end subroutine taumol29
1486 :
1487 : end subroutine taumol_sw
1488 :
1489 : end module rrtmg_sw_taumol
1490 :
|
