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