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