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 486000 : 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 11878265 : do lay = 1, laytrop
268 11635265 : speccomb = colh2o(lay) + strrat1*colch4(lay)
269 11635265 : specparm = colh2o(lay)/speccomb
270 11635265 : if (specparm .ge. oneminus) specparm = oneminus
271 11635265 : specmult = 8._r8*(specparm)
272 11635265 : js = 1 + int(specmult)
273 11635265 : fs = mod(specmult, 1._r8 )
274 11635265 : fac000 = (1._r8 - fs) * fac00(lay)
275 11635265 : fac010 = (1._r8 - fs) * fac10(lay)
276 11635265 : fac100 = fs * fac00(lay)
277 11635265 : fac110 = fs * fac10(lay)
278 11635265 : fac001 = (1._r8 - fs) * fac01(lay)
279 11635265 : fac011 = (1._r8 - fs) * fac11(lay)
280 11635265 : fac101 = fs * fac01(lay)
281 11635265 : fac111 = fs * fac11(lay)
282 11635265 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(16) + js
283 11635265 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(16) + js
284 11635265 : inds = indself(lay)
285 11635265 : indf = indfor(lay)
286 11635265 : tauray = colmol(lay) * rayl
287 :
288 81689855 : do ig = 1, ng16
289 69811590 : taug(lay,ig) = speccomb * &
290 139623180 : (fac000 * absa(ind0 ,ig) + &
291 69811590 : fac100 * absa(ind0 +1,ig) + &
292 69811590 : fac010 * absa(ind0 +9,ig) + &
293 69811590 : fac110 * absa(ind0+10,ig) + &
294 69811590 : fac001 * absa(ind1 ,ig) + &
295 69811590 : fac101 * absa(ind1 +1,ig) + &
296 69811590 : fac011 * absa(ind1 +9,ig) + &
297 69811590 : fac111 * absa(ind1+10,ig)) + &
298 69811590 : colh2o(lay) * &
299 139623180 : (selffac(lay) * (selfref(inds,ig) + &
300 69811590 : selffrac(lay) * &
301 69811590 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
302 139623180 : forfac(lay) * (forref(indf,ig) + &
303 69811590 : forfrac(lay) * &
304 907550670 : (forref(indf+1,ig) - forref(indf,ig))))
305 : ! ssa(lay,ig) = tauray/taug(lay,ig)
306 81446855 : taur(lay,ig) = tauray
307 : enddo
308 : enddo
309 :
310 243000 : laysolfr = nlayers
311 :
312 : ! Upper atmosphere loop
313 11206735 : do lay = laytrop+1, nlayers
314 10963735 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
315 243000 : laysolfr = lay
316 10963735 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(16) + 1
317 10963735 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(16) + 1
318 10963735 : tauray = colmol(lay) * rayl
319 :
320 76989145 : do ig = 1, ng16
321 65782410 : taug(lay,ig) = colch4(lay) * &
322 131564820 : (fac00(lay) * absb(ind0 ,ig) + &
323 131564820 : fac10(lay) * absb(ind0+1,ig) + &
324 131564820 : fac01(lay) * absb(ind1 ,ig) + &
325 328912050 : fac11(lay) * absb(ind1+1,ig))
326 : ! ssa(lay,ig) = tauray/taug(lay,ig)
327 65782410 : if (lay .eq. laysolfr) sfluxzen(ig) = sfluxref(ig)
328 76746145 : 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 11878265 : do lay = 1, laytrop
363 11635265 : speccomb = colh2o(lay) + strrat*colco2(lay)
364 11635265 : specparm = colh2o(lay)/speccomb
365 11635265 : if (specparm .ge. oneminus) specparm = oneminus
366 11635265 : specmult = 8._r8*(specparm)
367 11635265 : js = 1 + int(specmult)
368 11635265 : fs = mod(specmult, 1._r8 )
369 11635265 : fac000 = (1._r8 - fs) * fac00(lay)
370 11635265 : fac010 = (1._r8 - fs) * fac10(lay)
371 11635265 : fac100 = fs * fac00(lay)
372 11635265 : fac110 = fs * fac10(lay)
373 11635265 : fac001 = (1._r8 - fs) * fac01(lay)
374 11635265 : fac011 = (1._r8 - fs) * fac11(lay)
375 11635265 : fac101 = fs * fac01(lay)
376 11635265 : fac111 = fs * fac11(lay)
377 11635265 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(17) + js
378 11635265 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(17) + js
379 11635265 : inds = indself(lay)
380 11635265 : indf = indfor(lay)
381 11635265 : tauray = colmol(lay) * rayl
382 :
383 151501445 : do ig = 1, ng17
384 139623180 : taug(lay,ngs16+ig) = speccomb * &
385 279246360 : (fac000 * absa(ind0,ig) + &
386 139623180 : fac100 * absa(ind0+1,ig) + &
387 139623180 : fac010 * absa(ind0+9,ig) + &
388 139623180 : fac110 * absa(ind0+10,ig) + &
389 139623180 : fac001 * absa(ind1,ig) + &
390 139623180 : fac101 * absa(ind1+1,ig) + &
391 139623180 : fac011 * absa(ind1+9,ig) + &
392 139623180 : fac111 * absa(ind1+10,ig)) + &
393 139623180 : colh2o(lay) * &
394 279246360 : (selffac(lay) * (selfref(inds,ig) + &
395 139623180 : selffrac(lay) * &
396 139623180 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
397 279246360 : forfac(lay) * (forref(indf,ig) + &
398 139623180 : forfrac(lay) * &
399 1954724520 : (forref(indf+1,ig) - forref(indf,ig))))
400 : ! ssa(lay,ngs16+ig) = tauray/taug(lay,ngs16+ig)
401 151258445 : taur(lay,ngs16+ig) = tauray
402 : enddo
403 : enddo
404 :
405 243000 : laysolfr = nlayers
406 :
407 : ! Upper atmosphere loop
408 11206735 : do lay = laytrop+1, nlayers
409 10963735 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
410 243000 : laysolfr = lay
411 10963735 : speccomb = colh2o(lay) + strrat*colco2(lay)
412 10963735 : specparm = colh2o(lay)/speccomb
413 10963735 : if (specparm .ge. oneminus) specparm = oneminus
414 10963735 : specmult = 4._r8*(specparm)
415 10963735 : js = 1 + int(specmult)
416 10963735 : fs = mod(specmult, 1._r8 )
417 10963735 : fac000 = (1._r8 - fs) * fac00(lay)
418 10963735 : fac010 = (1._r8 - fs) * fac10(lay)
419 10963735 : fac100 = fs * fac00(lay)
420 10963735 : fac110 = fs * fac10(lay)
421 10963735 : fac001 = (1._r8 - fs) * fac01(lay)
422 10963735 : fac011 = (1._r8 - fs) * fac11(lay)
423 10963735 : fac101 = fs * fac01(lay)
424 10963735 : fac111 = fs * fac11(lay)
425 10963735 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(17) + js
426 10963735 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(17) + js
427 10963735 : indf = indfor(lay)
428 10963735 : tauray = colmol(lay) * rayl
429 :
430 142771555 : do ig = 1, ng17
431 131564820 : taug(lay,ngs16+ig) = speccomb * &
432 263129640 : (fac000 * absb(ind0,ig) + &
433 131564820 : fac100 * absb(ind0+1,ig) + &
434 131564820 : fac010 * absb(ind0+5,ig) + &
435 131564820 : fac110 * absb(ind0+6,ig) + &
436 131564820 : fac001 * absb(ind1,ig) + &
437 131564820 : fac101 * absb(ind1+1,ig) + &
438 131564820 : fac011 * absb(ind1+5,ig) + &
439 131564820 : fac111 * absb(ind1+6,ig)) + &
440 131564820 : colh2o(lay) * &
441 263129640 : forfac(lay) * (forref(indf,ig) + &
442 131564820 : forfrac(lay) * &
443 1578777840 : (forref(indf+1,ig) - forref(indf,ig)))
444 : ! ssa(lay,ngs16+ig) = tauray/taug(lay,ngs16+ig)
445 134480820 : if (lay .eq. laysolfr) sfluxzen(ngs16+ig) = sfluxref(ig,js) &
446 5832000 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
447 142528555 : 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 11878265 : do lay = 1, laytrop
484 11635265 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
485 243000 : laysolfr = min(lay+1,laytrop)
486 11635265 : speccomb = colh2o(lay) + strrat*colch4(lay)
487 11635265 : specparm = colh2o(lay)/speccomb
488 11635265 : if (specparm .ge. oneminus) specparm = oneminus
489 11635265 : specmult = 8._r8*(specparm)
490 11635265 : js = 1 + int(specmult)
491 11635265 : fs = mod(specmult, 1._r8 )
492 11635265 : fac000 = (1._r8 - fs) * fac00(lay)
493 11635265 : fac010 = (1._r8 - fs) * fac10(lay)
494 11635265 : fac100 = fs * fac00(lay)
495 11635265 : fac110 = fs * fac10(lay)
496 11635265 : fac001 = (1._r8 - fs) * fac01(lay)
497 11635265 : fac011 = (1._r8 - fs) * fac11(lay)
498 11635265 : fac101 = fs * fac01(lay)
499 11635265 : fac111 = fs * fac11(lay)
500 11635265 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(18) + js
501 11635265 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(18) + js
502 11635265 : inds = indself(lay)
503 11635265 : indf = indfor(lay)
504 11635265 : tauray = colmol(lay) * rayl
505 :
506 104960385 : do ig = 1, ng18
507 93082120 : taug(lay,ngs17+ig) = speccomb * &
508 186164240 : (fac000 * absa(ind0,ig) + &
509 93082120 : fac100 * absa(ind0+1,ig) + &
510 93082120 : fac010 * absa(ind0+9,ig) + &
511 93082120 : fac110 * absa(ind0+10,ig) + &
512 93082120 : fac001 * absa(ind1,ig) + &
513 93082120 : fac101 * absa(ind1+1,ig) + &
514 93082120 : fac011 * absa(ind1+9,ig) + &
515 93082120 : fac111 * absa(ind1+10,ig)) + &
516 93082120 : colh2o(lay) * &
517 186164240 : (selffac(lay) * (selfref(inds,ig) + &
518 93082120 : selffrac(lay) * &
519 93082120 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
520 186164240 : forfac(lay) * (forref(indf,ig) + &
521 93082120 : forfrac(lay) * &
522 1303149680 : (forref(indf+1,ig) - forref(indf,ig))))
523 : ! ssa(lay,ngs17+ig) = tauray/taug(lay,ngs17+ig)
524 95026120 : if (lay .eq. laysolfr) sfluxzen(ngs17+ig) = sfluxref(ig,js) &
525 3888000 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
526 104717385 : taur(lay,ngs17+ig) = tauray
527 : enddo
528 : enddo
529 :
530 : ! Upper atmosphere loop
531 11206735 : do lay = laytrop+1, nlayers
532 10963735 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(18) + 1
533 10963735 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(18) + 1
534 10963735 : tauray = colmol(lay) * rayl
535 :
536 98916615 : do ig = 1, ng18
537 87709880 : taug(lay,ngs17+ig) = colch4(lay) * &
538 263129640 : (fac00(lay) * absb(ind0,ig) + &
539 175419760 : fac10(lay) * absb(ind0+1,ig) + &
540 175419760 : fac01(lay) * absb(ind1,ig) + &
541 526259280 : fac11(lay) * absb(ind1+1,ig))
542 : ! ssa(lay,ngs17+ig) = tauray/taug(lay,ngs17+ig)
543 98673615 : 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 11878265 : do lay = 1, laytrop
580 11635265 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
581 236185 : laysolfr = min(lay+1,laytrop)
582 11635265 : speccomb = colh2o(lay) + strrat*colco2(lay)
583 11635265 : specparm = colh2o(lay)/speccomb
584 11635265 : if (specparm .ge. oneminus) specparm = oneminus
585 11635265 : specmult = 8._r8*(specparm)
586 11635265 : js = 1 + int(specmult)
587 11635265 : fs = mod(specmult, 1._r8 )
588 11635265 : fac000 = (1._r8 - fs) * fac00(lay)
589 11635265 : fac010 = (1._r8 - fs) * fac10(lay)
590 11635265 : fac100 = fs * fac00(lay)
591 11635265 : fac110 = fs * fac10(lay)
592 11635265 : fac001 = (1._r8 - fs) * fac01(lay)
593 11635265 : fac011 = (1._r8 - fs) * fac11(lay)
594 11635265 : fac101 = fs * fac01(lay)
595 11635265 : fac111 = fs * fac11(lay)
596 11635265 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(19) + js
597 11635265 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(19) + js
598 11635265 : inds = indself(lay)
599 11635265 : indf = indfor(lay)
600 11635265 : tauray = colmol(lay) * rayl
601 :
602 104960385 : do ig = 1 , ng19
603 93082120 : taug(lay,ngs18+ig) = speccomb * &
604 186164240 : (fac000 * absa(ind0,ig) + &
605 93082120 : fac100 * absa(ind0+1,ig) + &
606 93082120 : fac010 * absa(ind0+9,ig) + &
607 93082120 : fac110 * absa(ind0+10,ig) + &
608 93082120 : fac001 * absa(ind1,ig) + &
609 93082120 : fac101 * absa(ind1+1,ig) + &
610 93082120 : fac011 * absa(ind1+9,ig) + &
611 93082120 : fac111 * absa(ind1+10,ig)) + &
612 93082120 : colh2o(lay) * &
613 186164240 : (selffac(lay) * (selfref(inds,ig) + &
614 93082120 : selffrac(lay) * &
615 93082120 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
616 186164240 : forfac(lay) * (forref(indf,ig) + &
617 93082120 : forfrac(lay) * &
618 1303149680 : (forref(indf+1,ig) - forref(indf,ig))))
619 : ! ssa(lay,ngs18+ig) = tauray/taug(lay,ngs18+ig)
620 95026120 : if (lay .eq. laysolfr) sfluxzen(ngs18+ig) = sfluxref(ig,js) &
621 3888000 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
622 104717385 : taur(lay,ngs18+ig) = tauray
623 : enddo
624 : enddo
625 :
626 : ! Upper atmosphere loop
627 11206735 : do lay = laytrop+1, nlayers
628 10963735 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(19) + 1
629 10963735 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(19) + 1
630 10963735 : tauray = colmol(lay) * rayl
631 :
632 98916615 : do ig = 1 , ng19
633 87709880 : taug(lay,ngs18+ig) = colco2(lay) * &
634 263129640 : (fac00(lay) * absb(ind0,ig) + &
635 175419760 : fac10(lay) * absb(ind0+1,ig) + &
636 175419760 : fac01(lay) * absb(ind1,ig) + &
637 526259280 : fac11(lay) * absb(ind1+1,ig))
638 : ! ssa(lay,ngs18+ig) = tauray/taug(lay,ngs18+ig)
639 98673615 : 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 11878265 : do lay = 1, laytrop
678 11635265 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
679 236185 : laysolfr = min(lay+1,laytrop)
680 11635265 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(20) + 1
681 11635265 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(20) + 1
682 11635265 : inds = indself(lay)
683 11635265 : indf = indfor(lay)
684 11635265 : tauray = colmol(lay) * rayl
685 :
686 128230915 : do ig = 1, ng20
687 116352650 : taug(lay,ngs19+ig) = colh2o(lay) * &
688 349057950 : ((fac00(lay) * absa(ind0,ig) + &
689 232705300 : fac10(lay) * absa(ind0+1,ig) + &
690 232705300 : fac01(lay) * absa(ind1,ig) + &
691 232705300 : fac11(lay) * absa(ind1+1,ig)) + &
692 232705300 : selffac(lay) * (selfref(inds,ig) + &
693 116352650 : selffrac(lay) * &
694 116352650 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
695 232705300 : forfac(lay) * (forref(indf,ig) + &
696 116352650 : forfrac(lay) * &
697 116352650 : (forref(indf+1,ig) - forref(indf,ig)))) &
698 1279879150 : + colch4(lay) * absch4(ig)
699 : ! ssa(lay,ngs19+ig) = tauray/taug(lay,ngs19+ig)
700 116352650 : taur(lay,ngs19+ig) = tauray
701 127987915 : if (lay .eq. laysolfr) sfluxzen(ngs19+ig) = sfluxref(ig)
702 : enddo
703 : enddo
704 :
705 : ! Upper atmosphere loop
706 11206735 : do lay = laytrop+1, nlayers
707 10963735 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(20) + 1
708 10963735 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(20) + 1
709 10963735 : indf = indfor(lay)
710 10963735 : tauray = colmol(lay) * rayl
711 :
712 120844085 : do ig = 1, ng20
713 109637350 : taug(lay,ngs19+ig) = colh2o(lay) * &
714 328912050 : (fac00(lay) * absb(ind0,ig) + &
715 219274700 : fac10(lay) * absb(ind0+1,ig) + &
716 219274700 : fac01(lay) * absb(ind1,ig) + &
717 219274700 : fac11(lay) * absb(ind1+1,ig) + &
718 219274700 : forfac(lay) * (forref(indf,ig) + &
719 109637350 : forfrac(lay) * &
720 109637350 : (forref(indf+1,ig) - forref(indf,ig)))) + &
721 986736150 : colch4(lay) * absch4(ig)
722 : ! ssa(lay,ngs19+ig) = tauray/taug(lay,ngs19+ig)
723 120601085 : 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 11878265 : do lay = 1, laytrop
760 11635265 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
761 243000 : laysolfr = min(lay+1,laytrop)
762 11635265 : speccomb = colh2o(lay) + strrat*colco2(lay)
763 11635265 : specparm = colh2o(lay)/speccomb
764 11635265 : if (specparm .ge. oneminus) specparm = oneminus
765 11635265 : specmult = 8._r8*(specparm)
766 11635265 : js = 1 + int(specmult)
767 11635265 : fs = mod(specmult, 1._r8 )
768 11635265 : fac000 = (1._r8 - fs) * fac00(lay)
769 11635265 : fac010 = (1._r8 - fs) * fac10(lay)
770 11635265 : fac100 = fs * fac00(lay)
771 11635265 : fac110 = fs * fac10(lay)
772 11635265 : fac001 = (1._r8 - fs) * fac01(lay)
773 11635265 : fac011 = (1._r8 - fs) * fac11(lay)
774 11635265 : fac101 = fs * fac01(lay)
775 11635265 : fac111 = fs * fac11(lay)
776 11635265 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(21) + js
777 11635265 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(21) + js
778 11635265 : inds = indself(lay)
779 11635265 : indf = indfor(lay)
780 11635265 : tauray = colmol(lay) * rayl
781 :
782 128230915 : do ig = 1, ng21
783 116352650 : taug(lay,ngs20+ig) = speccomb * &
784 232705300 : (fac000 * absa(ind0,ig) + &
785 116352650 : fac100 * absa(ind0+1,ig) + &
786 116352650 : fac010 * absa(ind0+9,ig) + &
787 116352650 : fac110 * absa(ind0+10,ig) + &
788 116352650 : fac001 * absa(ind1,ig) + &
789 116352650 : fac101 * absa(ind1+1,ig) + &
790 116352650 : fac011 * absa(ind1+9,ig) + &
791 116352650 : fac111 * absa(ind1+10,ig)) + &
792 116352650 : colh2o(lay) * &
793 232705300 : (selffac(lay) * (selfref(inds,ig) + &
794 116352650 : selffrac(lay) * &
795 116352650 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
796 232705300 : forfac(lay) * (forref(indf,ig) + &
797 116352650 : forfrac(lay) * &
798 1628937100 : (forref(indf+1,ig) - forref(indf,ig))))
799 : ! ssa(lay,ngs20+ig) = tauray/taug(lay,ngs20+ig)
800 118782650 : if (lay .eq. laysolfr) sfluxzen(ngs20+ig) = sfluxref(ig,js) &
801 4860000 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
802 127987915 : taur(lay,ngs20+ig) = tauray
803 : enddo
804 : enddo
805 :
806 : ! Upper atmosphere loop
807 11206735 : do lay = laytrop+1, nlayers
808 10963735 : speccomb = colh2o(lay) + strrat*colco2(lay)
809 10963735 : specparm = colh2o(lay)/speccomb
810 10963735 : if (specparm .ge. oneminus) specparm = oneminus
811 10963735 : specmult = 4._r8*(specparm)
812 10963735 : js = 1 + int(specmult)
813 10963735 : fs = mod(specmult, 1._r8 )
814 10963735 : fac000 = (1._r8 - fs) * fac00(lay)
815 10963735 : fac010 = (1._r8 - fs) * fac10(lay)
816 10963735 : fac100 = fs * fac00(lay)
817 10963735 : fac110 = fs * fac10(lay)
818 10963735 : fac001 = (1._r8 - fs) * fac01(lay)
819 10963735 : fac011 = (1._r8 - fs) * fac11(lay)
820 10963735 : fac101 = fs * fac01(lay)
821 10963735 : fac111 = fs * fac11(lay)
822 10963735 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(21) + js
823 10963735 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(21) + js
824 10963735 : indf = indfor(lay)
825 10963735 : tauray = colmol(lay) * rayl
826 :
827 120844085 : do ig = 1, ng21
828 109637350 : taug(lay,ngs20+ig) = speccomb * &
829 219274700 : (fac000 * absb(ind0,ig) + &
830 109637350 : fac100 * absb(ind0+1,ig) + &
831 109637350 : fac010 * absb(ind0+5,ig) + &
832 109637350 : fac110 * absb(ind0+6,ig) + &
833 109637350 : fac001 * absb(ind1,ig) + &
834 109637350 : fac101 * absb(ind1+1,ig) + &
835 109637350 : fac011 * absb(ind1+5,ig) + &
836 109637350 : fac111 * absb(ind1+6,ig)) + &
837 109637350 : colh2o(lay) * &
838 219274700 : forfac(lay) * (forref(indf,ig) + &
839 109637350 : forfrac(lay) * &
840 1315648200 : (forref(indf+1,ig) - forref(indf,ig)))
841 : ! ssa(lay,ngs20+ig) = tauray/taug(lay,ngs20+ig)
842 120601085 : 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 11878265 : do lay = 1, laytrop
884 11635265 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
885 227258 : laysolfr = min(lay+1,laytrop)
886 11635265 : o2cont = 4.35e-4_r8*colo2(lay)/(350.0_r8*2.0_r8)
887 11635265 : speccomb = colh2o(lay) + o2adj*strrat*colo2(lay)
888 11635265 : specparm = colh2o(lay)/speccomb
889 11635265 : if (specparm .ge. oneminus) specparm = oneminus
890 11635265 : specmult = 8._r8*(specparm)
891 : ! odadj = specparm + o2adj * (1._r8 - specparm)
892 11635265 : js = 1 + int(specmult)
893 11635265 : fs = mod(specmult, 1._r8 )
894 11635265 : fac000 = (1._r8 - fs) * fac00(lay)
895 11635265 : fac010 = (1._r8 - fs) * fac10(lay)
896 11635265 : fac100 = fs * fac00(lay)
897 11635265 : fac110 = fs * fac10(lay)
898 11635265 : fac001 = (1._r8 - fs) * fac01(lay)
899 11635265 : fac011 = (1._r8 - fs) * fac11(lay)
900 11635265 : fac101 = fs * fac01(lay)
901 11635265 : fac111 = fs * fac11(lay)
902 11635265 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(22) + js
903 11635265 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(22) + js
904 11635265 : inds = indself(lay)
905 11635265 : indf = indfor(lay)
906 11635265 : tauray = colmol(lay) * rayl
907 :
908 35148795 : do ig = 1, ng22
909 23270530 : taug(lay,ngs21+ig) = speccomb * &
910 46541060 : (fac000 * absa(ind0,ig) + &
911 23270530 : fac100 * absa(ind0+1,ig) + &
912 23270530 : fac010 * absa(ind0+9,ig) + &
913 23270530 : fac110 * absa(ind0+10,ig) + &
914 23270530 : fac001 * absa(ind1,ig) + &
915 23270530 : fac101 * absa(ind1+1,ig) + &
916 23270530 : fac011 * absa(ind1+9,ig) + &
917 23270530 : fac111 * absa(ind1+10,ig)) + &
918 23270530 : colh2o(lay) * &
919 46541060 : (selffac(lay) * (selfref(inds,ig) + &
920 23270530 : selffrac(lay) * &
921 23270530 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
922 46541060 : forfac(lay) * (forref(indf,ig) + &
923 23270530 : forfrac(lay) * &
924 23270530 : (forref(indf+1,ig) - forref(indf,ig)))) &
925 325787420 : + o2cont
926 : ! ssa(lay,ngs21+ig) = tauray/taug(lay,ngs21+ig)
927 23756530 : if (lay .eq. laysolfr) sfluxzen(ngs21+ig) = sfluxref(ig,js) &
928 972000 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
929 34905795 : taur(lay,ngs21+ig) = tauray
930 : enddo
931 : enddo
932 :
933 : ! Upper atmosphere loop
934 11206735 : do lay = laytrop+1, nlayers
935 10963735 : o2cont = 4.35e-4_r8*colo2(lay)/(350.0_r8*2.0_r8)
936 10963735 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(22) + 1
937 10963735 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(22) + 1
938 10963735 : tauray = colmol(lay) * rayl
939 :
940 33134205 : do ig = 1, ng22
941 21927470 : taug(lay,ngs21+ig) = colo2(lay) * o2adj * &
942 65782410 : (fac00(lay) * absb(ind0,ig) + &
943 43854940 : fac10(lay) * absb(ind0+1,ig) + &
944 43854940 : fac01(lay) * absb(ind1,ig) + &
945 43854940 : fac11(lay) * absb(ind1+1,ig)) + &
946 131564820 : o2cont
947 : ! ssa(lay,ngs21+ig) = tauray/taug(lay,ngs21+ig)
948 32891205 : 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 11878265 : do lay = 1, laytrop
985 11635265 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
986 243000 : laysolfr = min(lay+1,laytrop)
987 11635265 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(23) + 1
988 11635265 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(23) + 1
989 11635265 : inds = indself(lay)
990 11635265 : indf = indfor(lay)
991 :
992 128230915 : do ig = 1, ng23
993 116352650 : tauray = colmol(lay) * rayl(ig)
994 116352650 : taug(lay,ngs22+ig) = colh2o(lay) * &
995 232705300 : (givfac * (fac00(lay) * absa(ind0,ig) + &
996 232705300 : fac10(lay) * absa(ind0+1,ig) + &
997 232705300 : fac01(lay) * absa(ind1,ig) + &
998 232705300 : fac11(lay) * absa(ind1+1,ig)) + &
999 232705300 : selffac(lay) * (selfref(inds,ig) + &
1000 116352650 : selffrac(lay) * &
1001 116352650 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
1002 232705300 : forfac(lay) * (forref(indf,ig) + &
1003 116352650 : forfrac(lay) * &
1004 1047173850 : (forref(indf+1,ig) - forref(indf,ig))))
1005 : ! ssa(lay,ngs22+ig) = tauray/taug(lay,ngs22+ig)
1006 116352650 : if (lay .eq. laysolfr) sfluxzen(ngs22+ig) = sfluxref(ig)
1007 127987915 : taur(lay,ngs22+ig) = tauray
1008 : enddo
1009 : enddo
1010 :
1011 : ! Upper atmosphere loop
1012 11206735 : do lay = laytrop+1, nlayers
1013 120844085 : do ig = 1, ng23
1014 : ! taug(lay,ngs22+ig) = colmol(lay) * rayl(ig)
1015 : ! ssa(lay,ngs22+ig) = 1.0_r8
1016 109637350 : taug(lay,ngs22+ig) = 0._r8
1017 120601085 : 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 11878265 : do lay = 1, laytrop
1055 11635265 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
1056 0 : laysolfr = min(lay+1,laytrop)
1057 11635265 : speccomb = colh2o(lay) + strrat*colo2(lay)
1058 11635265 : specparm = colh2o(lay)/speccomb
1059 11635265 : if (specparm .ge. oneminus) specparm = oneminus
1060 11635265 : specmult = 8._r8*(specparm)
1061 11635265 : js = 1 + int(specmult)
1062 11635265 : fs = mod(specmult, 1._r8 )
1063 11635265 : fac000 = (1._r8 - fs) * fac00(lay)
1064 11635265 : fac010 = (1._r8 - fs) * fac10(lay)
1065 11635265 : fac100 = fs * fac00(lay)
1066 11635265 : fac110 = fs * fac10(lay)
1067 11635265 : fac001 = (1._r8 - fs) * fac01(lay)
1068 11635265 : fac011 = (1._r8 - fs) * fac11(lay)
1069 11635265 : fac101 = fs * fac01(lay)
1070 11635265 : fac111 = fs * fac11(lay)
1071 11635265 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(24) + js
1072 11635265 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(24) + js
1073 11635265 : inds = indself(lay)
1074 11635265 : indf = indfor(lay)
1075 :
1076 104960385 : do ig = 1, ng24
1077 279246360 : tauray = colmol(lay) * (rayla(ig,js) + &
1078 279246360 : fs * (rayla(ig,js+1) - rayla(ig,js)))
1079 93082120 : taug(lay,ngs23+ig) = speccomb * &
1080 93082120 : (fac000 * absa(ind0,ig) + &
1081 93082120 : fac100 * absa(ind0+1,ig) + &
1082 93082120 : fac010 * absa(ind0+9,ig) + &
1083 93082120 : fac110 * absa(ind0+10,ig) + &
1084 93082120 : fac001 * absa(ind1,ig) + &
1085 93082120 : fac101 * absa(ind1+1,ig) + &
1086 93082120 : fac011 * absa(ind1+9,ig) + &
1087 93082120 : fac111 * absa(ind1+10,ig)) + &
1088 93082120 : colo3(lay) * abso3a(ig) + &
1089 93082120 : colh2o(lay) * &
1090 186164240 : (selffac(lay) * (selfref(inds,ig) + &
1091 93082120 : selffrac(lay) * &
1092 93082120 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
1093 186164240 : forfac(lay) * (forref(indf,ig) + &
1094 93082120 : forfrac(lay) * &
1095 1210067560 : (forref(indf+1,ig) - forref(indf,ig))))
1096 : ! ssa(lay,ngs23+ig) = tauray/taug(lay,ngs23+ig)
1097 93082120 : if (lay .eq. laysolfr) sfluxzen(ngs23+ig) = sfluxref(ig,js) &
1098 1944000 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
1099 104717385 : taur(lay,ngs23+ig) = tauray
1100 : enddo
1101 : enddo
1102 :
1103 : ! Upper atmosphere loop
1104 11206735 : do lay = laytrop+1, nlayers
1105 10963735 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(24) + 1
1106 10963735 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(24) + 1
1107 :
1108 98916615 : do ig = 1, ng24
1109 87709880 : tauray = colmol(lay) * raylb(ig)
1110 87709880 : taug(lay,ngs23+ig) = colo2(lay) * &
1111 175419760 : (fac00(lay) * absb(ind0,ig) + &
1112 175419760 : fac10(lay) * absb(ind0+1,ig) + &
1113 175419760 : fac01(lay) * absb(ind1,ig) + &
1114 175419760 : fac11(lay) * absb(ind1+1,ig)) + &
1115 526259280 : colo3(lay) * abso3b(ig)
1116 : ! ssa(lay,ngs23+ig) = tauray/taug(lay,ngs23+ig)
1117 98673615 : 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 11878265 : do lay = 1, laytrop
1154 11635265 : if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
1155 227258 : laysolfr = min(lay+1,laytrop)
1156 11635265 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(25) + 1
1157 11635265 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(25) + 1
1158 :
1159 81689855 : do ig = 1, ng25
1160 69811590 : tauray = colmol(lay) * rayl(ig)
1161 69811590 : taug(lay,ngs24+ig) = colh2o(lay) * &
1162 139623180 : (fac00(lay) * absa(ind0,ig) + &
1163 139623180 : fac10(lay) * absa(ind0+1,ig) + &
1164 139623180 : fac01(lay) * absa(ind1,ig) + &
1165 139623180 : fac11(lay) * absa(ind1+1,ig)) + &
1166 418869540 : colo3(lay) * abso3a(ig)
1167 : ! ssa(lay,ngs24+ig) = tauray/taug(lay,ngs24+ig)
1168 69811590 : if (lay .eq. laysolfr) sfluxzen(ngs24+ig) = sfluxref(ig)
1169 81446855 : taur(lay,ngs24+ig) = tauray
1170 : enddo
1171 : enddo
1172 :
1173 : ! Upper atmosphere loop
1174 11206735 : do lay = laytrop+1, nlayers
1175 76989145 : do ig = 1, ng25
1176 65782410 : tauray = colmol(lay) * rayl(ig)
1177 65782410 : taug(lay,ngs24+ig) = colo3(lay) * abso3b(ig)
1178 : ! ssa(lay,ngs24+ig) = tauray/taug(lay,ngs24+ig)
1179 76746145 : 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 11878265 : do lay = 1, laytrop
1215 81689855 : do ig = 1, ng26
1216 : ! taug(lay,ngs25+ig) = colmol(lay) * rayl(ig)
1217 : ! ssa(lay,ngs25+ig) = 1.0_r8
1218 69811590 : if (lay .eq. laysolfr) sfluxzen(ngs25+ig) = sfluxref(ig)
1219 69811590 : taug(lay,ngs25+ig) = 0._r8
1220 81446855 : taur(lay,ngs25+ig) = colmol(lay) * rayl(ig)
1221 : enddo
1222 : enddo
1223 :
1224 : ! Upper atmosphere loop
1225 11206735 : do lay = laytrop+1, nlayers
1226 76989145 : do ig = 1, ng26
1227 : ! taug(lay,ngs25+ig) = colmol(lay) * rayl(ig)
1228 : ! ssa(lay,ngs25+ig) = 1.0_r8
1229 65782410 : taug(lay,ngs25+ig) = 0._r8
1230 76746145 : 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 11878265 : do lay = 1, laytrop
1265 11635265 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(27) + 1
1266 11635265 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(27) + 1
1267 :
1268 104960385 : do ig = 1, ng27
1269 93082120 : tauray = colmol(lay) * rayl(ig)
1270 93082120 : taug(lay,ngs26+ig) = colo3(lay) * &
1271 186164240 : (fac00(lay) * absa(ind0,ig) + &
1272 186164240 : fac10(lay) * absa(ind0+1,ig) + &
1273 186164240 : fac01(lay) * absa(ind1,ig) + &
1274 465410600 : fac11(lay) * absa(ind1+1,ig))
1275 : ! ssa(lay,ngs26+ig) = tauray/taug(lay,ngs26+ig)
1276 104717385 : taur(lay,ngs26+ig) = tauray
1277 : enddo
1278 : enddo
1279 :
1280 243000 : laysolfr = nlayers
1281 :
1282 : ! Upper atmosphere loop
1283 11206735 : do lay = laytrop+1, nlayers
1284 10963735 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
1285 243000 : laysolfr = lay
1286 10963735 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(27) + 1
1287 10963735 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(27) + 1
1288 :
1289 98916615 : do ig = 1, ng27
1290 87709880 : tauray = colmol(lay) * rayl(ig)
1291 87709880 : taug(lay,ngs26+ig) = colo3(lay) * &
1292 175419760 : (fac00(lay) * absb(ind0,ig) + &
1293 175419760 : fac10(lay) * absb(ind0+1,ig) + &
1294 175419760 : fac01(lay) * absb(ind1,ig) + &
1295 438549400 : fac11(lay) * absb(ind1+1,ig))
1296 : ! ssa(lay,ngs26+ig) = tauray/taug(lay,ngs26+ig)
1297 87709880 : if (lay.eq.laysolfr) sfluxzen(ngs26+ig) = scalekur * sfluxref(ig)
1298 98673615 : 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 11878265 : do lay = 1, laytrop
1333 11635265 : speccomb = colo3(lay) + strrat*colo2(lay)
1334 11635265 : specparm = colo3(lay)/speccomb
1335 11635265 : if (specparm .ge. oneminus) specparm = oneminus
1336 11635265 : specmult = 8._r8*(specparm)
1337 11635265 : js = 1 + int(specmult)
1338 11635265 : fs = mod(specmult, 1._r8 )
1339 11635265 : fac000 = (1._r8 - fs) * fac00(lay)
1340 11635265 : fac010 = (1._r8 - fs) * fac10(lay)
1341 11635265 : fac100 = fs * fac00(lay)
1342 11635265 : fac110 = fs * fac10(lay)
1343 11635265 : fac001 = (1._r8 - fs) * fac01(lay)
1344 11635265 : fac011 = (1._r8 - fs) * fac11(lay)
1345 11635265 : fac101 = fs * fac01(lay)
1346 11635265 : fac111 = fs * fac11(lay)
1347 11635265 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(28) + js
1348 11635265 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(28) + js
1349 11635265 : tauray = colmol(lay) * rayl
1350 :
1351 81689855 : do ig = 1, ng28
1352 69811590 : taug(lay,ngs27+ig) = speccomb * &
1353 139623180 : (fac000 * absa(ind0,ig) + &
1354 69811590 : fac100 * absa(ind0+1,ig) + &
1355 69811590 : fac010 * absa(ind0+9,ig) + &
1356 69811590 : fac110 * absa(ind0+10,ig) + &
1357 69811590 : fac001 * absa(ind1,ig) + &
1358 69811590 : fac101 * absa(ind1+1,ig) + &
1359 69811590 : fac011 * absa(ind1+9,ig) + &
1360 698115900 : fac111 * absa(ind1+10,ig))
1361 : ! ssa(lay,ngs27+ig) = tauray/taug(lay,ngs27+ig)
1362 81446855 : taur(lay,ngs27+ig) = tauray
1363 : enddo
1364 : enddo
1365 :
1366 243000 : laysolfr = nlayers
1367 :
1368 : ! Upper atmosphere loop
1369 11206735 : do lay = laytrop+1, nlayers
1370 10963735 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
1371 243000 : laysolfr = lay
1372 10963735 : speccomb = colo3(lay) + strrat*colo2(lay)
1373 10963735 : specparm = colo3(lay)/speccomb
1374 10963735 : if (specparm .ge. oneminus) specparm = oneminus
1375 10963735 : specmult = 4._r8*(specparm)
1376 10963735 : js = 1 + int(specmult)
1377 10963735 : fs = mod(specmult, 1._r8 )
1378 10963735 : fac000 = (1._r8 - fs) * fac00(lay)
1379 10963735 : fac010 = (1._r8 - fs) * fac10(lay)
1380 10963735 : fac100 = fs * fac00(lay)
1381 10963735 : fac110 = fs * fac10(lay)
1382 10963735 : fac001 = (1._r8 - fs) * fac01(lay)
1383 10963735 : fac011 = (1._r8 - fs) * fac11(lay)
1384 10963735 : fac101 = fs * fac01(lay)
1385 10963735 : fac111 = fs * fac11(lay)
1386 10963735 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(28) + js
1387 10963735 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(28) + js
1388 10963735 : tauray = colmol(lay) * rayl
1389 :
1390 76989145 : do ig = 1, ng28
1391 65782410 : taug(lay,ngs27+ig) = speccomb * &
1392 131564820 : (fac000 * absb(ind0,ig) + &
1393 65782410 : fac100 * absb(ind0+1,ig) + &
1394 65782410 : fac010 * absb(ind0+5,ig) + &
1395 65782410 : fac110 * absb(ind0+6,ig) + &
1396 65782410 : fac001 * absb(ind1,ig) + &
1397 65782410 : fac101 * absb(ind1+1,ig) + &
1398 65782410 : fac011 * absb(ind1+5,ig) + &
1399 657824100 : fac111 * absb(ind1+6,ig))
1400 : ! ssa(lay,ngs27+ig) = tauray/taug(lay,ngs27+ig)
1401 67240410 : if (lay .eq. laysolfr) sfluxzen(ngs27+ig) = sfluxref(ig,js) &
1402 2916000 : + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
1403 76746145 : 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 11878265 : do lay = 1, laytrop
1438 11635265 : ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(29) + 1
1439 11635265 : ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(29) + 1
1440 11635265 : inds = indself(lay)
1441 11635265 : indf = indfor(lay)
1442 11635265 : tauray = colmol(lay) * rayl
1443 :
1444 151501445 : do ig = 1, ng29
1445 139623180 : taug(lay,ngs28+ig) = colh2o(lay) * &
1446 418869540 : ((fac00(lay) * absa(ind0,ig) + &
1447 279246360 : fac10(lay) * absa(ind0+1,ig) + &
1448 279246360 : fac01(lay) * absa(ind1,ig) + &
1449 279246360 : fac11(lay) * absa(ind1+1,ig)) + &
1450 279246360 : selffac(lay) * (selfref(inds,ig) + &
1451 139623180 : selffrac(lay) * &
1452 139623180 : (selfref(inds+1,ig) - selfref(inds,ig))) + &
1453 279246360 : forfac(lay) * (forref(indf,ig) + &
1454 139623180 : forfrac(lay) * &
1455 139623180 : (forref(indf+1,ig) - forref(indf,ig)))) &
1456 1535854980 : + colco2(lay) * absco2(ig)
1457 : ! ssa(lay,ngs28+ig) = tauray/taug(lay,ngs28+ig)
1458 151258445 : taur(lay,ngs28+ig) = tauray
1459 : enddo
1460 : enddo
1461 :
1462 243000 : laysolfr = nlayers
1463 :
1464 : ! Upper atmosphere loop
1465 11206735 : do lay = laytrop+1, nlayers
1466 10963735 : if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
1467 243000 : laysolfr = lay
1468 10963735 : ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(29) + 1
1469 10963735 : ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(29) + 1
1470 10963735 : tauray = colmol(lay) * rayl
1471 :
1472 142771555 : do ig = 1, ng29
1473 131564820 : taug(lay,ngs28+ig) = colco2(lay) * &
1474 394694460 : (fac00(lay) * absb(ind0,ig) + &
1475 263129640 : fac10(lay) * absb(ind0+1,ig) + &
1476 263129640 : fac01(lay) * absb(ind1,ig) + &
1477 263129640 : fac11(lay) * absb(ind1+1,ig)) &
1478 920953740 : + colh2o(lay) * absh2o(ig)
1479 : ! ssa(lay,ngs28+ig) = tauray/taug(lay,ngs28+ig)
1480 131564820 : if (lay .eq. laysolfr) sfluxzen(ngs28+ig) = sfluxref(ig)
1481 142528555 : 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 :
|
