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 243000 : subroutine taumol_sw(nlayers, &
31 729000 : colh2o, colco2, colch4, colo2, colo3, colmol, &
32 243000 : laytrop, jp, jt, jt1, &
33 243000 : fac00, fac01, fac10, fac11, &
34 486000 : selffac, selffrac, indself, forfac, forfrac, indfor, &
35 486000 : 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 243000 : call taumol16
221 243000 : call taumol17
222 243000 : call taumol18
223 243000 : call taumol19
224 243000 : call taumol20
225 243000 : call taumol21
226 243000 : call taumol22
227 243000 : call taumol23
228 243000 : call taumol24
229 243000 : call taumol25
230 243000 : call taumol26
231 243000 : call taumol27
232 243000 : call taumol28
233 243000 : call taumol29
234 :
235 : !-------------
236 : contains
237 : !-------------
238 :
239 : !----------------------------------------------------------------------------
240 243000 : 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 4606183 : do lay = 1, laytrop
268 4363183 : speccomb = colh2o(lay) + strrat1*colch4(lay)
269 4363183 : specparm = colh2o(lay)/speccomb
270 4363183 : if (specparm .ge. oneminus) specparm = oneminus
271 4363183 : specmult = 8._r8*(specparm)
272 4363183 : js = 1 + int(specmult)
273 4363183 : fs = mod(specmult, 1._r8 )
274 4363183 : fac000 = (1._r8 - fs) * fac00(lay)
275 4363183 : fac010 = (1._r8 - fs) * fac10(lay)
276 4363183 : fac100 = fs * fac00(lay)
277 4363183 : fac110 = fs * fac10(lay)
278 4363183 : fac001 = (1._r8 - fs) * fac01(lay)
279 4363183 : fac011 = (1._r8 - fs) * fac11(lay)
280 4363183 : fac101 = fs * fac01(lay)
281 4363183 : fac111 = fs * fac11(lay)
282 4363183 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(16) + js
283 4363183 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(16) + js
284 4363183 : inds = indself(lay)
285 4363183 : indf = indfor(lay)
286 4363183 : tauray = colmol(lay) * rayl
287 :
288 30785281 : do ig = 1, ng16
289 52358196 : taug(lay,ig) = speccomb * &
290 52358196 : (fac000 * absa(ind0 ,ig) + &
291 52358196 : fac100 * absa(ind0 +1,ig) + &
292 52358196 : fac010 * absa(ind0 +9,ig) + &
293 52358196 : fac110 * absa(ind0+10,ig) + &
294 52358196 : fac001 * absa(ind1 ,ig) + &
295 52358196 : fac101 * absa(ind1 +1,ig) + &
296 52358196 : fac011 * absa(ind1 +9,ig) + &
297 52358196 : fac111 * absa(ind1+10,ig)) + &
298 26179098 : colh2o(lay) * &
299 78537294 : (selffac(lay) * (selfref(inds,ig) + &
300 26179098 : selffrac(lay) * &
301 104716392 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
302 78537294 : forfac(lay) * (forref(indf,ig) + &
303 26179098 : forfrac(lay) * &
304 837731136 : (forref(indf+1,ig) - forref(indf,ig))))
305 : ! ssa(lay,ig) = tauray/taug(lay,ig)
306 30542281 : taur(lay,ig) = tauray
307 : enddo
308 : enddo
309 :
310 243000 : laysolfr = nlayers
311 :
312 : ! Upper atmosphere loop
313 2440817 : do lay = laytrop+1, nlayers
314 2197817 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
315 243000 : laysolfr = lay
316 2197817 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(16) + 1
317 2197817 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(16) + 1
318 2197817 : tauray = colmol(lay) * rayl
319 :
320 15627719 : do ig = 1, ng16
321 39560706 : taug(lay,ig) = colch4(lay) * &
322 39560706 : (fac00(lay) * absb(ind0 ,ig) + &
323 39560706 : fac10(lay) * absb(ind0+1,ig) + &
324 39560706 : fac01(lay) * absb(ind1 ,ig) + &
325 171429726 : fac11(lay) * absb(ind1+1,ig))
326 : ! ssa(lay,ig) = tauray/taug(lay,ig)
327 13186902 : if (lay .eq. laysolfr) sfluxzen(ig) = sfluxref(ig)
328 15384719 : taur(lay,ig) = tauray
329 : enddo
330 : enddo
331 :
332 243000 : end subroutine taumol16
333 :
334 : !----------------------------------------------------------------------------
335 243000 : 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 4606183 : do lay = 1, laytrop
363 4363183 : speccomb = colh2o(lay) + strrat*colco2(lay)
364 4363183 : specparm = colh2o(lay)/speccomb
365 4363183 : if (specparm .ge. oneminus) specparm = oneminus
366 4363183 : specmult = 8._r8*(specparm)
367 4363183 : js = 1 + int(specmult)
368 4363183 : fs = mod(specmult, 1._r8 )
369 4363183 : fac000 = (1._r8 - fs) * fac00(lay)
370 4363183 : fac010 = (1._r8 - fs) * fac10(lay)
371 4363183 : fac100 = fs * fac00(lay)
372 4363183 : fac110 = fs * fac10(lay)
373 4363183 : fac001 = (1._r8 - fs) * fac01(lay)
374 4363183 : fac011 = (1._r8 - fs) * fac11(lay)
375 4363183 : fac101 = fs * fac01(lay)
376 4363183 : fac111 = fs * fac11(lay)
377 4363183 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(17) + js
378 4363183 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(17) + js
379 4363183 : inds = indself(lay)
380 4363183 : indf = indfor(lay)
381 4363183 : tauray = colmol(lay) * rayl
382 :
383 56964379 : do ig = 1, ng17
384 104716392 : taug(lay,ngs16+ig) = speccomb * &
385 104716392 : (fac000 * absa(ind0,ig) + &
386 104716392 : fac100 * absa(ind0+1,ig) + &
387 104716392 : fac010 * absa(ind0+9,ig) + &
388 104716392 : fac110 * absa(ind0+10,ig) + &
389 104716392 : fac001 * absa(ind1,ig) + &
390 104716392 : fac101 * absa(ind1+1,ig) + &
391 104716392 : fac011 * absa(ind1+9,ig) + &
392 104716392 : fac111 * absa(ind1+10,ig)) + &
393 52358196 : colh2o(lay) * &
394 157074588 : (selffac(lay) * (selfref(inds,ig) + &
395 52358196 : selffrac(lay) * &
396 209432784 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
397 157074588 : forfac(lay) * (forref(indf,ig) + &
398 52358196 : forfrac(lay) * &
399 1675462272 : (forref(indf+1,ig) - forref(indf,ig))))
400 : ! ssa(lay,ngs16+ig) = tauray/taug(lay,ngs16+ig)
401 56721379 : taur(lay,ngs16+ig) = tauray
402 : enddo
403 : enddo
404 :
405 243000 : laysolfr = nlayers
406 :
407 : ! Upper atmosphere loop
408 2440817 : do lay = laytrop+1, nlayers
409 2197817 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
410 243000 : laysolfr = lay
411 2197817 : speccomb = colh2o(lay) + strrat*colco2(lay)
412 2197817 : specparm = colh2o(lay)/speccomb
413 2197817 : if (specparm .ge. oneminus) specparm = oneminus
414 2197817 : specmult = 4._r8*(specparm)
415 2197817 : js = 1 + int(specmult)
416 2197817 : fs = mod(specmult, 1._r8 )
417 2197817 : fac000 = (1._r8 - fs) * fac00(lay)
418 2197817 : fac010 = (1._r8 - fs) * fac10(lay)
419 2197817 : fac100 = fs * fac00(lay)
420 2197817 : fac110 = fs * fac10(lay)
421 2197817 : fac001 = (1._r8 - fs) * fac01(lay)
422 2197817 : fac011 = (1._r8 - fs) * fac11(lay)
423 2197817 : fac101 = fs * fac01(lay)
424 2197817 : fac111 = fs * fac11(lay)
425 2197817 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(17) + js
426 2197817 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(17) + js
427 2197817 : indf = indfor(lay)
428 2197817 : tauray = colmol(lay) * rayl
429 :
430 28814621 : do ig = 1, ng17
431 52747608 : taug(lay,ngs16+ig) = speccomb * &
432 52747608 : (fac000 * absb(ind0,ig) + &
433 52747608 : fac100 * absb(ind0+1,ig) + &
434 52747608 : fac010 * absb(ind0+5,ig) + &
435 52747608 : fac110 * absb(ind0+6,ig) + &
436 52747608 : fac001 * absb(ind1,ig) + &
437 52747608 : fac101 * absb(ind1+1,ig) + &
438 52747608 : fac011 * absb(ind1+5,ig) + &
439 52747608 : fac111 * absb(ind1+6,ig)) + &
440 26373804 : colh2o(lay) * &
441 79121412 : forfac(lay) * (forref(indf,ig) + &
442 26373804 : forfrac(lay) * &
443 632971296 : (forref(indf+1,ig) - forref(indf,ig)))
444 : ! ssa(lay,ngs16+ig) = tauray/taug(lay,ngs16+ig)
445 35121804 : if (lay .eq. laysolfr) sfluxzen(ngs16+ig) = sfluxref(ig,js) &
446 11664000 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
447 28571621 : taur(lay,ngs16+ig) = tauray
448 : enddo
449 : enddo
450 :
451 243000 : end subroutine taumol17
452 :
453 : !----------------------------------------------------------------------------
454 243000 : 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 243000 : laysolfr = laytrop
481 :
482 : ! Lower atmosphere loop
483 4606183 : do lay = 1, laytrop
484 4363183 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
485 243000 : laysolfr = min(lay+1,laytrop)
486 4363183 : speccomb = colh2o(lay) + strrat*colch4(lay)
487 4363183 : specparm = colh2o(lay)/speccomb
488 4363183 : if (specparm .ge. oneminus) specparm = oneminus
489 4363183 : specmult = 8._r8*(specparm)
490 4363183 : js = 1 + int(specmult)
491 4363183 : fs = mod(specmult, 1._r8 )
492 4363183 : fac000 = (1._r8 - fs) * fac00(lay)
493 4363183 : fac010 = (1._r8 - fs) * fac10(lay)
494 4363183 : fac100 = fs * fac00(lay)
495 4363183 : fac110 = fs * fac10(lay)
496 4363183 : fac001 = (1._r8 - fs) * fac01(lay)
497 4363183 : fac011 = (1._r8 - fs) * fac11(lay)
498 4363183 : fac101 = fs * fac01(lay)
499 4363183 : fac111 = fs * fac11(lay)
500 4363183 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(18) + js
501 4363183 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(18) + js
502 4363183 : inds = indself(lay)
503 4363183 : indf = indfor(lay)
504 4363183 : tauray = colmol(lay) * rayl
505 :
506 39511647 : do ig = 1, ng18
507 69810928 : taug(lay,ngs17+ig) = speccomb * &
508 69810928 : (fac000 * absa(ind0,ig) + &
509 69810928 : fac100 * absa(ind0+1,ig) + &
510 69810928 : fac010 * absa(ind0+9,ig) + &
511 69810928 : fac110 * absa(ind0+10,ig) + &
512 69810928 : fac001 * absa(ind1,ig) + &
513 69810928 : fac101 * absa(ind1+1,ig) + &
514 69810928 : fac011 * absa(ind1+9,ig) + &
515 69810928 : fac111 * absa(ind1+10,ig)) + &
516 34905464 : colh2o(lay) * &
517 104716392 : (selffac(lay) * (selfref(inds,ig) + &
518 34905464 : selffrac(lay) * &
519 139621856 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
520 104716392 : forfac(lay) * (forref(indf,ig) + &
521 34905464 : forfrac(lay) * &
522 1116974848 : (forref(indf+1,ig) - forref(indf,ig))))
523 : ! ssa(lay,ngs17+ig) = tauray/taug(lay,ngs17+ig)
524 40737464 : if (lay .eq. laysolfr) sfluxzen(ngs17+ig) = sfluxref(ig,js) &
525 7776000 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
526 39268647 : taur(lay,ngs17+ig) = tauray
527 : enddo
528 : enddo
529 :
530 : ! Upper atmosphere loop
531 2440817 : do lay = laytrop+1, nlayers
532 2197817 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(18) + 1
533 2197817 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(18) + 1
534 2197817 : tauray = colmol(lay) * rayl
535 :
536 20023353 : do ig = 1, ng18
537 52747608 : taug(lay,ngs17+ig) = colch4(lay) * &
538 52747608 : (fac00(lay) * absb(ind0,ig) + &
539 52747608 : fac10(lay) * absb(ind0+1,ig) + &
540 52747608 : fac01(lay) * absb(ind1,ig) + &
541 228572968 : fac11(lay) * absb(ind1+1,ig))
542 : ! ssa(lay,ngs17+ig) = tauray/taug(lay,ngs17+ig)
543 19780353 : taur(lay,ngs17+ig) = tauray
544 : enddo
545 : enddo
546 :
547 243000 : end subroutine taumol18
548 :
549 : !----------------------------------------------------------------------------
550 243000 : 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 243000 : laysolfr = laytrop
577 :
578 : ! Lower atmosphere loop
579 4606183 : do lay = 1, laytrop
580 4363183 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
581 235680 : laysolfr = min(lay+1,laytrop)
582 4363183 : speccomb = colh2o(lay) + strrat*colco2(lay)
583 4363183 : specparm = colh2o(lay)/speccomb
584 4363183 : if (specparm .ge. oneminus) specparm = oneminus
585 4363183 : specmult = 8._r8*(specparm)
586 4363183 : js = 1 + int(specmult)
587 4363183 : fs = mod(specmult, 1._r8 )
588 4363183 : fac000 = (1._r8 - fs) * fac00(lay)
589 4363183 : fac010 = (1._r8 - fs) * fac10(lay)
590 4363183 : fac100 = fs * fac00(lay)
591 4363183 : fac110 = fs * fac10(lay)
592 4363183 : fac001 = (1._r8 - fs) * fac01(lay)
593 4363183 : fac011 = (1._r8 - fs) * fac11(lay)
594 4363183 : fac101 = fs * fac01(lay)
595 4363183 : fac111 = fs * fac11(lay)
596 4363183 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(19) + js
597 4363183 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(19) + js
598 4363183 : inds = indself(lay)
599 4363183 : indf = indfor(lay)
600 4363183 : tauray = colmol(lay) * rayl
601 :
602 39511647 : do ig = 1 , ng19
603 69810928 : taug(lay,ngs18+ig) = speccomb * &
604 69810928 : (fac000 * absa(ind0,ig) + &
605 69810928 : fac100 * absa(ind0+1,ig) + &
606 69810928 : fac010 * absa(ind0+9,ig) + &
607 69810928 : fac110 * absa(ind0+10,ig) + &
608 69810928 : fac001 * absa(ind1,ig) + &
609 69810928 : fac101 * absa(ind1+1,ig) + &
610 69810928 : fac011 * absa(ind1+9,ig) + &
611 69810928 : fac111 * absa(ind1+10,ig)) + &
612 34905464 : colh2o(lay) * &
613 104716392 : (selffac(lay) * (selfref(inds,ig) + &
614 34905464 : selffrac(lay) * &
615 139621856 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
616 104716392 : forfac(lay) * (forref(indf,ig) + &
617 34905464 : forfrac(lay) * &
618 1116974848 : (forref(indf+1,ig) - forref(indf,ig))))
619 : ! ssa(lay,ngs18+ig) = tauray/taug(lay,ngs18+ig)
620 40737464 : if (lay .eq. laysolfr) sfluxzen(ngs18+ig) = sfluxref(ig,js) &
621 7776000 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
622 39268647 : taur(lay,ngs18+ig) = tauray
623 : enddo
624 : enddo
625 :
626 : ! Upper atmosphere loop
627 2440817 : do lay = laytrop+1, nlayers
628 2197817 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(19) + 1
629 2197817 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(19) + 1
630 2197817 : tauray = colmol(lay) * rayl
631 :
632 20023353 : do ig = 1 , ng19
633 52747608 : taug(lay,ngs18+ig) = colco2(lay) * &
634 52747608 : (fac00(lay) * absb(ind0,ig) + &
635 52747608 : fac10(lay) * absb(ind0+1,ig) + &
636 52747608 : fac01(lay) * absb(ind1,ig) + &
637 228572968 : fac11(lay) * absb(ind1+1,ig))
638 : ! ssa(lay,ngs18+ig) = tauray/taug(lay,ngs18+ig)
639 19780353 : taur(lay,ngs18+ig) = tauray
640 : enddo
641 : enddo
642 :
643 243000 : end subroutine taumol19
644 :
645 : !----------------------------------------------------------------------------
646 243000 : 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 243000 : laysolfr = laytrop
675 :
676 : ! Lower atmosphere loop
677 4606183 : do lay = 1, laytrop
678 4363183 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
679 235680 : laysolfr = min(lay+1,laytrop)
680 4363183 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(20) + 1
681 4363183 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(20) + 1
682 4363183 : inds = indself(lay)
683 4363183 : indf = indfor(lay)
684 4363183 : tauray = colmol(lay) * rayl
685 :
686 48238013 : do ig = 1, ng20
687 130895490 : taug(lay,ngs19+ig) = colh2o(lay) * &
688 130895490 : ((fac00(lay) * absa(ind0,ig) + &
689 130895490 : fac10(lay) * absa(ind0+1,ig) + &
690 130895490 : fac01(lay) * absa(ind1,ig) + &
691 130895490 : fac11(lay) * absa(ind1+1,ig)) + &
692 130895490 : selffac(lay) * (selfref(inds,ig) + &
693 43631830 : selffrac(lay) * &
694 174527320 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
695 130895490 : forfac(lay) * (forref(indf,ig) + &
696 43631830 : forfrac(lay) * &
697 174527320 : (forref(indf+1,ig) - forref(indf,ig)))) &
698 1396218560 : + colch4(lay) * absch4(ig)
699 : ! ssa(lay,ngs19+ig) = tauray/taug(lay,ngs19+ig)
700 43631830 : taur(lay,ngs19+ig) = tauray
701 47995013 : if (lay .eq. laysolfr) sfluxzen(ngs19+ig) = sfluxref(ig)
702 : enddo
703 : enddo
704 :
705 : ! Upper atmosphere loop
706 2440817 : do lay = laytrop+1, nlayers
707 2197817 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(20) + 1
708 2197817 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(20) + 1
709 2197817 : indf = indfor(lay)
710 2197817 : tauray = colmol(lay) * rayl
711 :
712 24418987 : do ig = 1, ng20
713 65934510 : taug(lay,ngs19+ig) = colh2o(lay) * &
714 65934510 : (fac00(lay) * absb(ind0,ig) + &
715 65934510 : fac10(lay) * absb(ind0+1,ig) + &
716 65934510 : fac01(lay) * absb(ind1,ig) + &
717 65934510 : fac11(lay) * absb(ind1+1,ig) + &
718 65934510 : forfac(lay) * (forref(indf,ig) + &
719 21978170 : forfrac(lay) * &
720 87912680 : (forref(indf+1,ig) - forref(indf,ig)))) + &
721 527476080 : colch4(lay) * absch4(ig)
722 : ! ssa(lay,ngs19+ig) = tauray/taug(lay,ngs19+ig)
723 24175987 : taur(lay,ngs19+ig) = tauray
724 : enddo
725 : enddo
726 :
727 243000 : end subroutine taumol20
728 :
729 : !----------------------------------------------------------------------------
730 243000 : 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 243000 : laysolfr = laytrop
757 :
758 : ! Lower atmosphere loop
759 4606183 : do lay = 1, laytrop
760 4363183 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
761 243000 : laysolfr = min(lay+1,laytrop)
762 4363183 : speccomb = colh2o(lay) + strrat*colco2(lay)
763 4363183 : specparm = colh2o(lay)/speccomb
764 4363183 : if (specparm .ge. oneminus) specparm = oneminus
765 4363183 : specmult = 8._r8*(specparm)
766 4363183 : js = 1 + int(specmult)
767 4363183 : fs = mod(specmult, 1._r8 )
768 4363183 : fac000 = (1._r8 - fs) * fac00(lay)
769 4363183 : fac010 = (1._r8 - fs) * fac10(lay)
770 4363183 : fac100 = fs * fac00(lay)
771 4363183 : fac110 = fs * fac10(lay)
772 4363183 : fac001 = (1._r8 - fs) * fac01(lay)
773 4363183 : fac011 = (1._r8 - fs) * fac11(lay)
774 4363183 : fac101 = fs * fac01(lay)
775 4363183 : fac111 = fs * fac11(lay)
776 4363183 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(21) + js
777 4363183 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(21) + js
778 4363183 : inds = indself(lay)
779 4363183 : indf = indfor(lay)
780 4363183 : tauray = colmol(lay) * rayl
781 :
782 48238013 : do ig = 1, ng21
783 87263660 : taug(lay,ngs20+ig) = speccomb * &
784 87263660 : (fac000 * absa(ind0,ig) + &
785 87263660 : fac100 * absa(ind0+1,ig) + &
786 87263660 : fac010 * absa(ind0+9,ig) + &
787 87263660 : fac110 * absa(ind0+10,ig) + &
788 87263660 : fac001 * absa(ind1,ig) + &
789 87263660 : fac101 * absa(ind1+1,ig) + &
790 87263660 : fac011 * absa(ind1+9,ig) + &
791 87263660 : fac111 * absa(ind1+10,ig)) + &
792 43631830 : colh2o(lay) * &
793 130895490 : (selffac(lay) * (selfref(inds,ig) + &
794 43631830 : selffrac(lay) * &
795 174527320 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
796 130895490 : forfac(lay) * (forref(indf,ig) + &
797 43631830 : forfrac(lay) * &
798 1396218560 : (forref(indf+1,ig) - forref(indf,ig))))
799 : ! ssa(lay,ngs20+ig) = tauray/taug(lay,ngs20+ig)
800 50921830 : if (lay .eq. laysolfr) sfluxzen(ngs20+ig) = sfluxref(ig,js) &
801 9720000 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
802 47995013 : taur(lay,ngs20+ig) = tauray
803 : enddo
804 : enddo
805 :
806 : ! Upper atmosphere loop
807 2440817 : do lay = laytrop+1, nlayers
808 2197817 : speccomb = colh2o(lay) + strrat*colco2(lay)
809 2197817 : specparm = colh2o(lay)/speccomb
810 2197817 : if (specparm .ge. oneminus) specparm = oneminus
811 2197817 : specmult = 4._r8*(specparm)
812 2197817 : js = 1 + int(specmult)
813 2197817 : fs = mod(specmult, 1._r8 )
814 2197817 : fac000 = (1._r8 - fs) * fac00(lay)
815 2197817 : fac010 = (1._r8 - fs) * fac10(lay)
816 2197817 : fac100 = fs * fac00(lay)
817 2197817 : fac110 = fs * fac10(lay)
818 2197817 : fac001 = (1._r8 - fs) * fac01(lay)
819 2197817 : fac011 = (1._r8 - fs) * fac11(lay)
820 2197817 : fac101 = fs * fac01(lay)
821 2197817 : fac111 = fs * fac11(lay)
822 2197817 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(21) + js
823 2197817 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(21) + js
824 2197817 : indf = indfor(lay)
825 2197817 : tauray = colmol(lay) * rayl
826 :
827 24418987 : do ig = 1, ng21
828 43956340 : taug(lay,ngs20+ig) = speccomb * &
829 43956340 : (fac000 * absb(ind0,ig) + &
830 43956340 : fac100 * absb(ind0+1,ig) + &
831 43956340 : fac010 * absb(ind0+5,ig) + &
832 43956340 : fac110 * absb(ind0+6,ig) + &
833 43956340 : fac001 * absb(ind1,ig) + &
834 43956340 : fac101 * absb(ind1+1,ig) + &
835 43956340 : fac011 * absb(ind1+5,ig) + &
836 43956340 : fac111 * absb(ind1+6,ig)) + &
837 21978170 : colh2o(lay) * &
838 65934510 : forfac(lay) * (forref(indf,ig) + &
839 21978170 : forfrac(lay) * &
840 527476080 : (forref(indf+1,ig) - forref(indf,ig)))
841 : ! ssa(lay,ngs20+ig) = tauray/taug(lay,ngs20+ig)
842 24175987 : taur(lay,ngs20+ig) = tauray
843 : enddo
844 : enddo
845 :
846 243000 : end subroutine taumol21
847 :
848 : !----------------------------------------------------------------------------
849 243000 : 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 243000 : 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 243000 : laysolfr = laytrop
881 :
882 : ! Lower atmosphere loop
883 4606183 : do lay = 1, laytrop
884 4363183 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
885 225544 : laysolfr = min(lay+1,laytrop)
886 4363183 : o2cont = 4.35e-4_r8*colo2(lay)/(350.0_r8*2.0_r8)
887 4363183 : speccomb = colh2o(lay) + o2adj*strrat*colo2(lay)
888 4363183 : specparm = colh2o(lay)/speccomb
889 4363183 : if (specparm .ge. oneminus) specparm = oneminus
890 4363183 : specmult = 8._r8*(specparm)
891 : ! odadj = specparm + o2adj * (1._r8 - specparm)
892 4363183 : js = 1 + int(specmult)
893 4363183 : fs = mod(specmult, 1._r8 )
894 4363183 : fac000 = (1._r8 - fs) * fac00(lay)
895 4363183 : fac010 = (1._r8 - fs) * fac10(lay)
896 4363183 : fac100 = fs * fac00(lay)
897 4363183 : fac110 = fs * fac10(lay)
898 4363183 : fac001 = (1._r8 - fs) * fac01(lay)
899 4363183 : fac011 = (1._r8 - fs) * fac11(lay)
900 4363183 : fac101 = fs * fac01(lay)
901 4363183 : fac111 = fs * fac11(lay)
902 4363183 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(22) + js
903 4363183 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(22) + js
904 4363183 : inds = indself(lay)
905 4363183 : indf = indfor(lay)
906 4363183 : tauray = colmol(lay) * rayl
907 :
908 13332549 : do ig = 1, ng22
909 17452732 : taug(lay,ngs21+ig) = speccomb * &
910 17452732 : (fac000 * absa(ind0,ig) + &
911 17452732 : fac100 * absa(ind0+1,ig) + &
912 17452732 : fac010 * absa(ind0+9,ig) + &
913 17452732 : fac110 * absa(ind0+10,ig) + &
914 17452732 : fac001 * absa(ind1,ig) + &
915 17452732 : fac101 * absa(ind1+1,ig) + &
916 17452732 : fac011 * absa(ind1+9,ig) + &
917 17452732 : fac111 * absa(ind1+10,ig)) + &
918 8726366 : colh2o(lay) * &
919 26179098 : (selffac(lay) * (selfref(inds,ig) + &
920 8726366 : selffrac(lay) * &
921 34905464 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
922 26179098 : forfac(lay) * (forref(indf,ig) + &
923 8726366 : forfrac(lay) * &
924 34905464 : (forref(indf+1,ig) - forref(indf,ig)))) &
925 305422810 : + o2cont
926 : ! ssa(lay,ngs21+ig) = tauray/taug(lay,ngs21+ig)
927 10184366 : if (lay .eq. laysolfr) sfluxzen(ngs21+ig) = sfluxref(ig,js) &
928 1944000 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
929 13089549 : taur(lay,ngs21+ig) = tauray
930 : enddo
931 : enddo
932 :
933 : ! Upper atmosphere loop
934 2440817 : do lay = laytrop+1, nlayers
935 2197817 : o2cont = 4.35e-4_r8*colo2(lay)/(350.0_r8*2.0_r8)
936 2197817 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(22) + 1
937 2197817 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(22) + 1
938 2197817 : tauray = colmol(lay) * rayl
939 :
940 6836451 : do ig = 1, ng22
941 13186902 : taug(lay,ngs21+ig) = colo2(lay) * o2adj * &
942 13186902 : (fac00(lay) * absb(ind0,ig) + &
943 13186902 : fac10(lay) * absb(ind0+1,ig) + &
944 13186902 : fac01(lay) * absb(ind1,ig) + &
945 13186902 : fac11(lay) * absb(ind1+1,ig)) + &
946 65934510 : o2cont
947 : ! ssa(lay,ngs21+ig) = tauray/taug(lay,ngs21+ig)
948 6593451 : taur(lay,ngs21+ig) = tauray
949 : enddo
950 : enddo
951 :
952 243000 : end subroutine taumol22
953 :
954 : !----------------------------------------------------------------------------
955 243000 : 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 243000 : laysolfr = laytrop
982 :
983 : ! Lower atmosphere loop
984 4606183 : do lay = 1, laytrop
985 4363183 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
986 243000 : laysolfr = min(lay+1,laytrop)
987 4363183 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(23) + 1
988 4363183 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(23) + 1
989 4363183 : inds = indself(lay)
990 4363183 : indf = indfor(lay)
991 :
992 48238013 : do ig = 1, ng23
993 43631830 : tauray = colmol(lay) * rayl(ig)
994 130895490 : taug(lay,ngs22+ig) = colh2o(lay) * &
995 130895490 : (givfac * (fac00(lay) * absa(ind0,ig) + &
996 130895490 : fac10(lay) * absa(ind0+1,ig) + &
997 130895490 : fac01(lay) * absa(ind1,ig) + &
998 130895490 : fac11(lay) * absa(ind1+1,ig)) + &
999 130895490 : selffac(lay) * (selfref(inds,ig) + &
1000 43631830 : selffrac(lay) * &
1001 174527320 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
1002 130895490 : forfac(lay) * (forref(indf,ig) + &
1003 43631830 : forfrac(lay) * &
1004 1221691240 : (forref(indf+1,ig) - forref(indf,ig))))
1005 : ! ssa(lay,ngs22+ig) = tauray/taug(lay,ngs22+ig)
1006 43631830 : if (lay .eq. laysolfr) sfluxzen(ngs22+ig) = sfluxref(ig)
1007 47995013 : taur(lay,ngs22+ig) = tauray
1008 : enddo
1009 : enddo
1010 :
1011 : ! Upper atmosphere loop
1012 2440817 : do lay = laytrop+1, nlayers
1013 24418987 : do ig = 1, ng23
1014 : ! taug(lay,ngs22+ig) = colmol(lay) * rayl(ig)
1015 : ! ssa(lay,ngs22+ig) = 1.0_r8
1016 21978170 : taug(lay,ngs22+ig) = 0._r8
1017 24175987 : taur(lay,ngs22+ig) = colmol(lay) * rayl(ig)
1018 : enddo
1019 : enddo
1020 :
1021 243000 : end subroutine taumol23
1022 :
1023 : !----------------------------------------------------------------------------
1024 243000 : 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 243000 : laysolfr = laytrop
1052 :
1053 : ! Lower atmosphere loop
1054 4606183 : do lay = 1, laytrop
1055 4363183 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
1056 0 : laysolfr = min(lay+1,laytrop)
1057 4363183 : speccomb = colh2o(lay) + strrat*colo2(lay)
1058 4363183 : specparm = colh2o(lay)/speccomb
1059 4363183 : if (specparm .ge. oneminus) specparm = oneminus
1060 4363183 : specmult = 8._r8*(specparm)
1061 4363183 : js = 1 + int(specmult)
1062 4363183 : fs = mod(specmult, 1._r8 )
1063 4363183 : fac000 = (1._r8 - fs) * fac00(lay)
1064 4363183 : fac010 = (1._r8 - fs) * fac10(lay)
1065 4363183 : fac100 = fs * fac00(lay)
1066 4363183 : fac110 = fs * fac10(lay)
1067 4363183 : fac001 = (1._r8 - fs) * fac01(lay)
1068 4363183 : fac011 = (1._r8 - fs) * fac11(lay)
1069 4363183 : fac101 = fs * fac01(lay)
1070 4363183 : fac111 = fs * fac11(lay)
1071 4363183 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(24) + js
1072 4363183 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(24) + js
1073 4363183 : inds = indself(lay)
1074 4363183 : indf = indfor(lay)
1075 :
1076 39511647 : do ig = 1, ng24
1077 104716392 : tauray = colmol(lay) * (rayla(ig,js) + &
1078 139621856 : fs * (rayla(ig,js+1) - rayla(ig,js)))
1079 69810928 : taug(lay,ngs23+ig) = speccomb * &
1080 69810928 : (fac000 * absa(ind0,ig) + &
1081 69810928 : fac100 * absa(ind0+1,ig) + &
1082 69810928 : fac010 * absa(ind0+9,ig) + &
1083 69810928 : fac110 * absa(ind0+10,ig) + &
1084 69810928 : fac001 * absa(ind1,ig) + &
1085 69810928 : fac101 * absa(ind1+1,ig) + &
1086 69810928 : fac011 * absa(ind1+9,ig) + &
1087 69810928 : fac111 * absa(ind1+10,ig)) + &
1088 69810928 : colo3(lay) * abso3a(ig) + &
1089 34905464 : colh2o(lay) * &
1090 104716392 : (selffac(lay) * (selfref(inds,ig) + &
1091 34905464 : selffrac(lay) * &
1092 139621856 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
1093 104716392 : forfac(lay) * (forref(indf,ig) + &
1094 34905464 : forfrac(lay) * &
1095 1186785776 : (forref(indf+1,ig) - forref(indf,ig))))
1096 : ! ssa(lay,ngs23+ig) = tauray/taug(lay,ngs23+ig)
1097 40737464 : if (lay .eq. laysolfr) sfluxzen(ngs23+ig) = sfluxref(ig,js) &
1098 7776000 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
1099 39268647 : taur(lay,ngs23+ig) = tauray
1100 : enddo
1101 : enddo
1102 :
1103 : ! Upper atmosphere loop
1104 2440817 : do lay = laytrop+1, nlayers
1105 2197817 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(24) + 1
1106 2197817 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(24) + 1
1107 :
1108 20023353 : do ig = 1, ng24
1109 17582536 : tauray = colmol(lay) * raylb(ig)
1110 52747608 : taug(lay,ngs23+ig) = colo2(lay) * &
1111 52747608 : (fac00(lay) * absb(ind0,ig) + &
1112 52747608 : fac10(lay) * absb(ind0+1,ig) + &
1113 52747608 : fac01(lay) * absb(ind1,ig) + &
1114 52747608 : fac11(lay) * absb(ind1+1,ig)) + &
1115 281320576 : colo3(lay) * abso3b(ig)
1116 : ! ssa(lay,ngs23+ig) = tauray/taug(lay,ngs23+ig)
1117 19780353 : taur(lay,ngs23+ig) = tauray
1118 : enddo
1119 : enddo
1120 :
1121 243000 : end subroutine taumol24
1122 :
1123 : !----------------------------------------------------------------------------
1124 243000 : 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 243000 : laysolfr = laytrop
1151 :
1152 : ! Lower atmosphere loop
1153 4606183 : do lay = 1, laytrop
1154 4363183 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
1155 225544 : laysolfr = min(lay+1,laytrop)
1156 4363183 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(25) + 1
1157 4363183 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(25) + 1
1158 :
1159 30785281 : do ig = 1, ng25
1160 26179098 : tauray = colmol(lay) * rayl(ig)
1161 78537294 : taug(lay,ngs24+ig) = colh2o(lay) * &
1162 78537294 : (fac00(lay) * absa(ind0,ig) + &
1163 78537294 : fac10(lay) * absa(ind0+1,ig) + &
1164 78537294 : fac01(lay) * absa(ind1,ig) + &
1165 78537294 : fac11(lay) * absa(ind1+1,ig)) + &
1166 418865568 : colo3(lay) * abso3a(ig)
1167 : ! ssa(lay,ngs24+ig) = tauray/taug(lay,ngs24+ig)
1168 26179098 : if (lay .eq. laysolfr) sfluxzen(ngs24+ig) = sfluxref(ig)
1169 30542281 : taur(lay,ngs24+ig) = tauray
1170 : enddo
1171 : enddo
1172 :
1173 : ! Upper atmosphere loop
1174 2440817 : do lay = laytrop+1, nlayers
1175 15627719 : do ig = 1, ng25
1176 13186902 : tauray = colmol(lay) * rayl(ig)
1177 13186902 : taug(lay,ngs24+ig) = colo3(lay) * abso3b(ig)
1178 : ! ssa(lay,ngs24+ig) = tauray/taug(lay,ngs24+ig)
1179 15384719 : taur(lay,ngs24+ig) = tauray
1180 : enddo
1181 : enddo
1182 :
1183 243000 : end subroutine taumol25
1184 :
1185 : !----------------------------------------------------------------------------
1186 243000 : 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 243000 : laysolfr = laytrop
1212 :
1213 : ! Lower atmosphere loop
1214 4606183 : do lay = 1, laytrop
1215 30785281 : do ig = 1, ng26
1216 : ! taug(lay,ngs25+ig) = colmol(lay) * rayl(ig)
1217 : ! ssa(lay,ngs25+ig) = 1.0_r8
1218 26179098 : if (lay .eq. laysolfr) sfluxzen(ngs25+ig) = sfluxref(ig)
1219 26179098 : taug(lay,ngs25+ig) = 0._r8
1220 30542281 : taur(lay,ngs25+ig) = colmol(lay) * rayl(ig)
1221 : enddo
1222 : enddo
1223 :
1224 : ! Upper atmosphere loop
1225 2440817 : do lay = laytrop+1, nlayers
1226 15627719 : do ig = 1, ng26
1227 : ! taug(lay,ngs25+ig) = colmol(lay) * rayl(ig)
1228 : ! ssa(lay,ngs25+ig) = 1.0_r8
1229 13186902 : taug(lay,ngs25+ig) = 0._r8
1230 15384719 : taur(lay,ngs25+ig) = colmol(lay) * rayl(ig)
1231 : enddo
1232 : enddo
1233 :
1234 243000 : end subroutine taumol26
1235 :
1236 : !----------------------------------------------------------------------------
1237 243000 : 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 4606183 : do lay = 1, laytrop
1265 4363183 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(27) + 1
1266 4363183 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(27) + 1
1267 :
1268 39511647 : do ig = 1, ng27
1269 34905464 : tauray = colmol(lay) * rayl(ig)
1270 104716392 : taug(lay,ngs26+ig) = colo3(lay) * &
1271 104716392 : (fac00(lay) * absa(ind0,ig) + &
1272 104716392 : fac10(lay) * absa(ind0+1,ig) + &
1273 104716392 : fac01(lay) * absa(ind1,ig) + &
1274 453771032 : fac11(lay) * absa(ind1+1,ig))
1275 : ! ssa(lay,ngs26+ig) = tauray/taug(lay,ngs26+ig)
1276 39268647 : taur(lay,ngs26+ig) = tauray
1277 : enddo
1278 : enddo
1279 :
1280 243000 : laysolfr = nlayers
1281 :
1282 : ! Upper atmosphere loop
1283 2440817 : do lay = laytrop+1, nlayers
1284 2197817 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
1285 243000 : laysolfr = lay
1286 2197817 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(27) + 1
1287 2197817 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(27) + 1
1288 :
1289 20023353 : do ig = 1, ng27
1290 17582536 : tauray = colmol(lay) * rayl(ig)
1291 52747608 : taug(lay,ngs26+ig) = colo3(lay) * &
1292 52747608 : (fac00(lay) * absb(ind0,ig) + &
1293 52747608 : fac10(lay) * absb(ind0+1,ig) + &
1294 52747608 : fac01(lay) * absb(ind1,ig) + &
1295 228572968 : fac11(lay) * absb(ind1+1,ig))
1296 : ! ssa(lay,ngs26+ig) = tauray/taug(lay,ngs26+ig)
1297 17582536 : if (lay.eq.laysolfr) sfluxzen(ngs26+ig) = scalekur * sfluxref(ig)
1298 19780353 : taur(lay,ngs26+ig) = tauray
1299 : enddo
1300 : enddo
1301 :
1302 243000 : end subroutine taumol27
1303 :
1304 : !----------------------------------------------------------------------------
1305 243000 : 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 4606183 : do lay = 1, laytrop
1333 4363183 : speccomb = colo3(lay) + strrat*colo2(lay)
1334 4363183 : specparm = colo3(lay)/speccomb
1335 4363183 : if (specparm .ge. oneminus) specparm = oneminus
1336 4363183 : specmult = 8._r8*(specparm)
1337 4363183 : js = 1 + int(specmult)
1338 4363183 : fs = mod(specmult, 1._r8 )
1339 4363183 : fac000 = (1._r8 - fs) * fac00(lay)
1340 4363183 : fac010 = (1._r8 - fs) * fac10(lay)
1341 4363183 : fac100 = fs * fac00(lay)
1342 4363183 : fac110 = fs * fac10(lay)
1343 4363183 : fac001 = (1._r8 - fs) * fac01(lay)
1344 4363183 : fac011 = (1._r8 - fs) * fac11(lay)
1345 4363183 : fac101 = fs * fac01(lay)
1346 4363183 : fac111 = fs * fac11(lay)
1347 4363183 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(28) + js
1348 4363183 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(28) + js
1349 4363183 : tauray = colmol(lay) * rayl
1350 :
1351 30785281 : do ig = 1, ng28
1352 52358196 : taug(lay,ngs27+ig) = speccomb * &
1353 52358196 : (fac000 * absa(ind0,ig) + &
1354 52358196 : fac100 * absa(ind0+1,ig) + &
1355 52358196 : fac010 * absa(ind0+9,ig) + &
1356 52358196 : fac110 * absa(ind0+10,ig) + &
1357 52358196 : fac001 * absa(ind1,ig) + &
1358 52358196 : fac101 * absa(ind1+1,ig) + &
1359 52358196 : fac011 * absa(ind1+9,ig) + &
1360 445044666 : fac111 * absa(ind1+10,ig))
1361 : ! ssa(lay,ngs27+ig) = tauray/taug(lay,ngs27+ig)
1362 30542281 : taur(lay,ngs27+ig) = tauray
1363 : enddo
1364 : enddo
1365 :
1366 243000 : laysolfr = nlayers
1367 :
1368 : ! Upper atmosphere loop
1369 2440817 : do lay = laytrop+1, nlayers
1370 2197817 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
1371 0 : laysolfr = lay
1372 2197817 : speccomb = colo3(lay) + strrat*colo2(lay)
1373 2197817 : specparm = colo3(lay)/speccomb
1374 2197817 : if (specparm .ge. oneminus) specparm = oneminus
1375 2197817 : specmult = 4._r8*(specparm)
1376 2197817 : js = 1 + int(specmult)
1377 2197817 : fs = mod(specmult, 1._r8 )
1378 2197817 : fac000 = (1._r8 - fs) * fac00(lay)
1379 2197817 : fac010 = (1._r8 - fs) * fac10(lay)
1380 2197817 : fac100 = fs * fac00(lay)
1381 2197817 : fac110 = fs * fac10(lay)
1382 2197817 : fac001 = (1._r8 - fs) * fac01(lay)
1383 2197817 : fac011 = (1._r8 - fs) * fac11(lay)
1384 2197817 : fac101 = fs * fac01(lay)
1385 2197817 : fac111 = fs * fac11(lay)
1386 2197817 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(28) + js
1387 2197817 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(28) + js
1388 2197817 : tauray = colmol(lay) * rayl
1389 :
1390 15627719 : do ig = 1, ng28
1391 26373804 : taug(lay,ngs27+ig) = speccomb * &
1392 26373804 : (fac000 * absb(ind0,ig) + &
1393 26373804 : fac100 * absb(ind0+1,ig) + &
1394 26373804 : fac010 * absb(ind0+5,ig) + &
1395 26373804 : fac110 * absb(ind0+6,ig) + &
1396 26373804 : fac001 * absb(ind1,ig) + &
1397 26373804 : fac101 * absb(ind1+1,ig) + &
1398 26373804 : fac011 * absb(ind1+5,ig) + &
1399 224177334 : fac111 * absb(ind1+6,ig))
1400 : ! ssa(lay,ngs27+ig) = tauray/taug(lay,ngs27+ig)
1401 17560902 : if (lay .eq. laysolfr) sfluxzen(ngs27+ig) = sfluxref(ig,js) &
1402 5832000 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
1403 15384719 : taur(lay,ngs27+ig) = tauray
1404 : enddo
1405 : enddo
1406 :
1407 243000 : end subroutine taumol28
1408 :
1409 : !----------------------------------------------------------------------------
1410 243000 : 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 4606183 : do lay = 1, laytrop
1438 4363183 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(29) + 1
1439 4363183 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(29) + 1
1440 4363183 : inds = indself(lay)
1441 4363183 : indf = indfor(lay)
1442 4363183 : tauray = colmol(lay) * rayl
1443 :
1444 56964379 : do ig = 1, ng29
1445 157074588 : taug(lay,ngs28+ig) = colh2o(lay) * &
1446 157074588 : ((fac00(lay) * absa(ind0,ig) + &
1447 157074588 : fac10(lay) * absa(ind0+1,ig) + &
1448 157074588 : fac01(lay) * absa(ind1,ig) + &
1449 157074588 : fac11(lay) * absa(ind1+1,ig)) + &
1450 157074588 : selffac(lay) * (selfref(inds,ig) + &
1451 52358196 : selffrac(lay) * &
1452 209432784 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
1453 157074588 : forfac(lay) * (forref(indf,ig) + &
1454 52358196 : forfrac(lay) * &
1455 209432784 : (forref(indf+1,ig) - forref(indf,ig)))) &
1456 1675462272 : + colco2(lay) * absco2(ig)
1457 : ! ssa(lay,ngs28+ig) = tauray/taug(lay,ngs28+ig)
1458 56721379 : taur(lay,ngs28+ig) = tauray
1459 : enddo
1460 : enddo
1461 :
1462 243000 : laysolfr = nlayers
1463 :
1464 : ! Upper atmosphere loop
1465 2440817 : do lay = laytrop+1, nlayers
1466 2197817 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
1467 0 : laysolfr = lay
1468 2197817 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(29) + 1
1469 2197817 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(29) + 1
1470 2197817 : tauray = colmol(lay) * rayl
1471 :
1472 28814621 : do ig = 1, ng29
1473 79121412 : taug(lay,ngs28+ig) = colco2(lay) * &
1474 79121412 : (fac00(lay) * absb(ind0,ig) + &
1475 79121412 : fac10(lay) * absb(ind0+1,ig) + &
1476 79121412 : fac01(lay) * absb(ind1,ig) + &
1477 79121412 : fac11(lay) * absb(ind1+1,ig)) &
1478 421980864 : + colh2o(lay) * absh2o(ig)
1479 : ! ssa(lay,ngs28+ig) = tauray/taug(lay,ngs28+ig)
1480 26373804 : if (lay .eq. laysolfr) sfluxzen(ngs28+ig) = sfluxref(ig)
1481 28571621 : taur(lay,ngs28+ig) = tauray
1482 : enddo
1483 : enddo
1484 :
1485 243000 : end subroutine taumol29
1486 :
1487 : end subroutine taumol_sw
1488 :
1489 : end module rrtmg_sw_taumol
1490 :
|
