Radiation Scheme in CCPP
Modules | Functions/Subroutines | Variables
radlw_main.f File Reference

Go to the source code of this file.

Modules

module  module_radlw_main
 This module includes ncep's modifications of the rrtm-lw radiation ! code from aer inc.
 

Functions/Subroutines

subroutine, public module_radlw_main::rlwinit
 This subroutine performs calculations necessary for the initialization of the longwave model. lookup tables are computed for use in the lw radiative transfer, and input absorption coefficient data for each spectral band are reduced from 256 g-point intervals to 140. More...
 
subroutine module_radlw_main::cldprop
 This subroutine computes the cloud optical depth(s) for each cloudy layer and g-point interval. More...
 
subroutine module_radlw_main::mcica_subcol
 This suroutine computes sub-colum cloud profile flag array. More...
 
subroutine module_radlw_main::setcoef
 This subroutine computes various coefficients needed in radiative transfer calculations. More...
 
subroutine module_radlw_main::rtrn
 This subroutine computes the upward/downward radiative fluxes, and heating rates for both clear or cloudy atmosphere. Clouds assumed as randomly overlaping in a vertical column. More...
 
subroutine module_radlw_main::rtrnmr
 
subroutine module_radlw_main::rtrnmc
 
subroutine module_radlw_main::taumol
 
subroutine taugb01
 
subroutine taugb02
 
subroutine taugb03
 
subroutine taugb04
 
subroutine taugb05
 
subroutine taugb06
 
subroutine taugb07
 
subroutine taugb08
 
subroutine taugb09
 
subroutine taugb10
 
subroutine taugb11
 
subroutine taugb12
 
subroutine taugb13
 
subroutine taugb14
 
subroutine taugb15
 
subroutine taugb16
 
subroutine, public module_radlw_main::lwrad
 This subroutine is the main lw radiation routine. More...
 

Variables

character(40), parameter module_radlw_main::vtaglw ='NCEP LW v5.1 Nov 2012 -RRTMG-LW v4.82 '
 
real(kind=kind_phys), parameter module_radlw_main::eps = 1.0e-6
 
real(kind=kind_phys), parameter module_radlw_main::oneminus = 1.0-eps
 
real(kind=kind_phys), parameter module_radlw_main::cldmin = 1.0e-80
 
real(kind=kind_phys), parameter module_radlw_main::bpade = 1.0/0.278
 
real(kind=kind_phys), parameter module_radlw_main::stpfac = 296.0/1013.0
 
real(kind=kind_phys), parameter module_radlw_main::wtdiff = 0.5
 
real(kind=kind_phys), parameter module_radlw_main::tblint = ntbl
 
real(kind=kind_phys), parameter module_radlw_main::f_zero = 0.0
 
real(kind=kind_phys), parameter module_radlw_main::f_one = 1.0
 
real(kind=kind_phys), parameter module_radlw_main::amdw = con_amd/con_amw
 
real(kind=kind_phys), parameter module_radlw_main::amdo3 = con_amd/con_amo3
 
integer, dimension(nbands) module_radlw_main::nspa
 
integer, dimension(nbands) module_radlw_main::nspb
 
real(kind=kind_phys), dimension(nbands) module_radlw_main::a0
 
real(kind=kind_phys), dimension(nbands) module_radlw_main::a1
 
real(kind=kind_phys), dimension(nbands) module_radlw_main::a2
 
logical module_radlw_main::lhlwb = .false.
 
logical module_radlw_main::lhlw0 = .false.
 
logical module_radlw_main::lflxprf = .false.
 
real(kind=kind_phys) module_radlw_main::fluxfac
 
real(kind=kind_phys) module_radlw_main::heatfac
 
real(kind=kind_phys), dimension(nbands) module_radlw_main::semiss0
 
real(kind=kind_phys), dimension(0:ntbl) module_radlw_main::tau_tbl
 
real(kind=kind_phys), dimension(0:ntbl) module_radlw_main::exp_tbl
 
real(kind=kind_phys), dimension(0:ntbl) module_radlw_main::tfn_tbl
 
integer, parameter module_radlw_main::ipsdlw0 = ngptlw
 

Function/Subroutine Documentation

subroutine taumol::taugb01 ( )
private

Definition at line 3688 of file radlw_main.f.

References module_radlw_kgb01::absa, module_radlw_kgb01::absb, module_radlw_main::f_one, module_radlw_kgb01::forref, module_radlw_kgb01::fracrefa, module_radlw_kgb01::fracrefb, module_radlw_kgb01::ka_mn2, module_radlw_kgb01::kb_mn2, module_radlw_parameters::ng01, module_radlw_main::nspa, module_radlw_main::nspb, and module_radlw_kgb01::selfref.

Referenced by module_radlw_main::taumol().

3688 ! ..................................
3689 
3690 ! ------------------------------------------------------------------ !
3691 ! written by eli j. mlawer, atmospheric & environmental research. !
3692 ! revised by michael j. iacono, atmospheric & environmental research. !
3693 ! !
3694 ! band 1: 10-350 cm-1 (low key - h2o; low minor - n2) !
3695 ! (high key - h2o; high minor - n2) !
3696 ! !
3697 ! compute the optical depth by interpolating in ln(pressure) and !
3698 ! temperature. below laytrop, the water vapor self-continuum and !
3699 ! foreign continuum is interpolated (in temperature) separately. !
3700 ! ------------------------------------------------------------------ !
3701 
3702  use module_radlw_kgb01
3703 
3704 ! --- locals:
3705  integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, &
3706  & indm, indmp, ig
3707 
3708  real (kind=kind_phys) :: pp, corradj, scalen2, tauself, taufor, &
3709  & taun2
3710 !
3711 !===> ... begin here
3712 !
3713 ! --- minor gas mapping levels:
3714 ! lower - n2, p = 142.5490 mbar, t = 215.70 k
3715 ! upper - n2, p = 142.5490 mbar, t = 215.70 k
3716 
3717 ! --- ... lower atmosphere loop
3718 
3719  do k = 1, laytrop
3720  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(1) + 1
3721  ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(1) + 1
3722  inds = indself(k)
3723  indf = indfor(k)
3724  indm = indminor(k)
3725 
3726  ind0p = ind0 + 1
3727  ind1p = ind1 + 1
3728  indsp = inds + 1
3729  indfp = indf + 1
3730  indmp = indm + 1
3731 
3732  pp = pavel(k)
3733  scalen2 = colbrd(k) * scaleminorn2(k)
3734  if (pp < 250.0) then
3735  corradj = f_one - 0.15 * (250.0-pp) / 154.4
3736  else
3737  corradj = f_one
3738  endif
3739 
3740  do ig = 1, ng01
3741  tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) &
3742  & * (selfref(ig,indsp) - selfref(ig,inds)))
3743  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
3744  & * (forref(ig,indfp) - forref(ig,indf)))
3745  taun2 = scalen2 * (ka_mn2(ig,indm) + minorfrac(k) &
3746  & * (ka_mn2(ig,indmp) - ka_mn2(ig,indm)))
3747 
3748  taug(ig,k) = corradj * (colamt(k,1) &
3749  & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) &
3750  & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) &
3751  & + tauself + taufor + taun2)
3752 
3753  fracs(ig,k) = fracrefa(ig)
3754  enddo
3755  enddo
3756 
3757 ! --- ... upper atmosphere loop
3758 
3759  do k = laytrop+1, nlay
3760  ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(1) + 1
3761  ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(1) + 1
3762  indf = indfor(k)
3763  indm = indminor(k)
3764 
3765  ind0p = ind0 + 1
3766  ind1p = ind1 + 1
3767  indfp = indf + 1
3768  indmp = indm + 1
3769 
3770  scalen2 = colbrd(k) * scaleminorn2(k)
3771  corradj = f_one - 0.15 * (pavel(k) / 95.6)
3772 
3773  do ig = 1, ng01
3774  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
3775  & * (forref(ig,indfp) - forref(ig,indf)))
3776  taun2 = scalen2 * (kb_mn2(ig,indm) + minorfrac(k) &
3777  & * (kb_mn2(ig,indmp) - kb_mn2(ig,indm)))
3778 
3779  taug(ig,k) = corradj * (colamt(k,1) &
3780  & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) &
3781  & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) &
3782  & + taufor + taun2)
3783 
3784  fracs(ig,k) = fracrefb(ig)
3785  enddo
3786  enddo
3787 
3788 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::ka_mn2
real(kind=kind_phys), dimension(ng01, mmn01), public ka_mn2
Definition: radlw_datatb.f:1620
module_radlw_kgb01::absb
real(kind=kind_phys), dimension(ng01, msb01), public absb
Definition: radlw_datatb.f:1620
module_radlw_kgb01
This module sets up absorption coefficients for band 01: 10-250 cm-1 (low - h2o; high - h2o) ...
Definition: radlw_datatb.f:1607
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::fracrefb
real(kind=kind_phys), dimension(ng01), public fracrefb
Definition: radlw_datatb.f:1620
module_radlw_kgb01::kb_mn2
real(kind=kind_phys), dimension(ng01, mmn01), public kb_mn2
Definition: radlw_datatb.f:1620
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function:

subroutine taumol::taugb02 ( )

Definition at line 3794 of file radlw_main.f.

References module_radlw_kgb02::absa, module_radlw_kgb02::absb, module_radlw_main::f_one, module_radlw_kgb02::forref, module_radlw_kgb02::fracrefa, module_radlw_kgb02::fracrefb, module_radlw_parameters::ng02, module_radlw_parameters::ns02, module_radlw_main::nspa, module_radlw_main::nspb, and module_radlw_kgb02::selfref.

Referenced by module_radlw_main::taumol().

3794 ! ..................................
3795 
3796 ! ------------------------------------------------------------------ !
3797 ! band 2: 350-500 cm-1 (low key - h2o; high key - h2o) !
3798 ! ------------------------------------------------------------------ !
3799 
3800  use module_radlw_kgb02
3801 
3802 ! --- locals:
3803  integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, &
3804  & ig
3805 
3806  real (kind=kind_phys) :: corradj, tauself, taufor
3807 !
3808 !===> ... begin here
3809 !
3810 ! --- ... lower atmosphere loop
3811 
3812  do k = 1, laytrop
3813  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(2) + 1
3814  ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(2) + 1
3815  inds = indself(k)
3816  indf = indfor(k)
3817 
3818  ind0p = ind0 + 1
3819  ind1p = ind1 + 1
3820  indsp = inds + 1
3821  indfp = indf + 1
3822 
3823  corradj = f_one - 0.05 * (pavel(k) - 100.0) / 900.0
3824 
3825  do ig = 1, ng02
3826  tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) &
3827  & * (selfref(ig,indsp) - selfref(ig,inds)))
3828  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
3829  & * (forref(ig,indfp) - forref(ig,indf)))
3830 
3831  taug(ns02+ig,k) = corradj * (colamt(k,1) &
3832  & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) &
3833  & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) &
3834  & + tauself + taufor)
3835 
3836  fracs(ns02+ig,k) = fracrefa(ig)
3837  enddo
3838  enddo
3839 
3840 ! --- ... upper atmosphere loop
3841 
3842  do k = laytrop+1, nlay
3843  ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(2) + 1
3844  ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(2) + 1
3845  indf = indfor(k)
3846 
3847  ind0p = ind0 + 1
3848  ind1p = ind1 + 1
3849  indfp = indf + 1
3850 
3851  do ig = 1, ng02
3852  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
3853  & * (forref(ig,indfp) - forref(ig,indf)))
3854 
3855  taug(ns02+ig,k) = colamt(k,1) &
3856  & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) &
3857  & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) &
3858  & + taufor
3859 
3860  fracs(ns02+ig,k) = fracrefb(ig)
3861  enddo
3862  enddo
3863 
3864 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb02
This module sets up absorption coefficients for band 02: 250-500 cm-1 (low - h2o; high - h2o) ...
Definition: radlw_datatb.f:2403
module_radlw_kgb01::absb
real(kind=kind_phys), dimension(ng01, msb01), public absb
Definition: radlw_datatb.f:1620
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::fracrefb
real(kind=kind_phys), dimension(ng01), public fracrefb
Definition: radlw_datatb.f:1620
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function:

subroutine taumol::taugb03 ( )

Definition at line 3870 of file radlw_main.f.

References module_radlw_kgb03::absa, module_radlw_kgb03::absb, module_radlw_ref::chi_mls, module_radlw_main::f_one, module_radlw_main::f_zero, module_radlw_kgb03::forref, module_radlw_kgb03::fracrefa, module_radlw_kgb03::fracrefb, module_radlw_kgb03::ka_mn2o, module_radlw_kgb03::kb_mn2o, module_radlw_parameters::ng03, module_radlw_parameters::ns03, module_radlw_main::nspa, module_radlw_main::nspb, module_radlw_main::oneminus, and module_radlw_kgb03::selfref.

Referenced by module_radlw_main::taumol().

3870 ! ..................................
3871 
3872 ! ------------------------------------------------------------------ !
3873 ! band 3: 500-630 cm-1 (low key - h2o,co2; low minor - n2o) !
3874 ! (high key - h2o,co2; high minor - n2o) !
3875 ! ------------------------------------------------------------------ !
3876 
3877  use module_radlw_kgb03
3878 
3879 ! --- locals:
3880  integer :: k, ind0, ind1, inds, indsp, indf, indfp, indm, indmp, &
3881  & id000, id010, id100, id110, id200, id210, jmn2o, jmn2op, &
3882  & id001, id011, id101, id111, id201, id211, jpl, jplp, &
3883  & ig, js, js1
3884 
3885  real (kind=kind_phys) :: absn2o, ratn2o, adjfac, adjcoln2o, &
3886  & speccomb, specparm, specmult, fs, &
3887  & speccomb1, specparm1, specmult1, fs1, &
3888  & speccomb_mn2o, specparm_mn2o, specmult_mn2o, fmn2o, &
3889  & speccomb_planck,specparm_planck,specmult_planck,fpl, &
3890  & refrat_planck_a, refrat_planck_b, refrat_m_a, refrat_m_b, &
3891  & fac000, fac100, fac200, fac010, fac110, fac210, &
3892  & fac001, fac101, fac201, fac011, fac111, fac211, &
3893  & tau_major, tau_major1, tauself, taufor, n2om1, n2om2, &
3894  & p, p4, fk0, fk1, fk2
3895 !
3896 !===> ... begin here
3897 !
3898 ! --- ... minor gas mapping levels:
3899 ! lower - n2o, p = 706.272 mbar, t = 278.94 k
3900 ! upper - n2o, p = 95.58 mbar, t = 215.7 k
3901 
3902  refrat_planck_a = chi_mls(1,9)/chi_mls(2,9) ! P = 212.725 mb
3903  refrat_planck_b = chi_mls(1,13)/chi_mls(2,13) ! P = 95.58 mb
3904  refrat_m_a = chi_mls(1,3)/chi_mls(2,3) ! P = 706.270 mb
3905  refrat_m_b = chi_mls(1,13)/chi_mls(2,13) ! P = 95.58 mb
3906 
3907 ! --- ... lower atmosphere loop
3908 
3909  do k = 1, laytrop
3910  speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2)
3911  specparm = colamt(k,1) / speccomb
3912  specmult = 8.0 * min(specparm, oneminus)
3913  js = 1 + int(specmult)
3914  fs = mod(specmult, f_one)
3915  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(3) + js
3916 
3917  speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2)
3918  specparm1 = colamt(k,1) / speccomb1
3919  specmult1 = 8.0 * min(specparm1, oneminus)
3920  js1 = 1 + int(specmult1)
3921  fs1 = mod(specmult1, f_one)
3922  ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(3) + js1
3923 
3924  speccomb_mn2o = colamt(k,1) + refrat_m_a*colamt(k,2)
3925  specparm_mn2o = colamt(k,1) / speccomb_mn2o
3926  specmult_mn2o = 8.0 * min(specparm_mn2o, oneminus)
3927  jmn2o = 1 + int(specmult_mn2o)
3928  fmn2o = mod(specmult_mn2o, f_one)
3929 
3930  speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,2)
3931  specparm_planck = colamt(k,1) / speccomb_planck
3932  specmult_planck = 8.0 * min(specparm_planck, oneminus)
3933  jpl = 1 + int(specmult_planck)
3934  fpl = mod(specmult_planck, f_one)
3935 
3936  inds = indself(k)
3937  indf = indfor(k)
3938  indm = indminor(k)
3939  indsp = inds + 1
3940  indfp = indf + 1
3941  indmp = indm + 1
3942  jmn2op= jmn2o+ 1
3943  jplp = jpl + 1
3944 
3945 ! --- ... in atmospheres where the amount of n2O is too great to be considered
3946 ! a minor species, adjust the column amount of n2O by an empirical factor
3947 ! to obtain the proper contribution.
3948 
3949  p = coldry(k) * chi_mls(4,jp(k)+1)
3950  ratn2o = colamt(k,4) / p
3951  if (ratn2o > 1.5) then
3952  adjfac = 0.5 + (ratn2o - 0.5)**0.65
3953  adjcoln2o = adjfac * p
3954  else
3955  adjcoln2o = colamt(k,4)
3956  endif
3957 
3958  if (specparm < 0.125) then
3959  p = fs - f_one
3960  p4 = p**4
3961  fk0 = p4
3962  fk1 = f_one - p - 2.0*p4
3963  fk2 = p + p4
3964  id000 = ind0
3965  id010 = ind0 + 9
3966  id100 = ind0 + 1
3967  id110 = ind0 +10
3968  id200 = ind0 + 2
3969  id210 = ind0 +11
3970  else if (specparm > 0.875) then
3971  p = -fs
3972  p4 = p**4
3973  fk0 = p4
3974  fk1 = f_one - p - 2.0*p4
3975  fk2 = p + p4
3976  id000 = ind0 + 1
3977  id010 = ind0 +10
3978  id100 = ind0
3979  id110 = ind0 + 9
3980  id200 = ind0 - 1
3981  id210 = ind0 + 8
3982  else
3983  fk0 = f_one - fs
3984  fk1 = fs
3985  fk2 = f_zero
3986  id000 = ind0
3987  id010 = ind0 + 9
3988  id100 = ind0 + 1
3989  id110 = ind0 +10
3990  id200 = ind0
3991  id210 = ind0
3992  endif
3993 
3994  fac000 = fk0*fac00(k)
3995  fac100 = fk1*fac00(k)
3996  fac200 = fk2*fac00(k)
3997  fac010 = fk0*fac10(k)
3998  fac110 = fk1*fac10(k)
3999  fac210 = fk2*fac10(k)
4000 
4001  if (specparm1 < 0.125) then
4002  p = fs1 - f_one
4003  p4 = p**4
4004  fk0 = p4
4005  fk1 = f_one - p - 2.0*p4
4006  fk2 = p + p4
4007  id001 = ind1
4008  id011 = ind1 + 9
4009  id101 = ind1 + 1
4010  id111 = ind1 +10
4011  id201 = ind1 + 2
4012  id211 = ind1 +11
4013  elseif (specparm1 > 0.875) then
4014  p = -fs1
4015  p4 = p**4
4016  fk0 = p4
4017  fk1 = f_one - p - 2.0*p4
4018  fk2 = p + p4
4019  id001 = ind1 + 1
4020  id011 = ind1 +10
4021  id101 = ind1
4022  id111 = ind1 + 9
4023  id201 = ind1 - 1
4024  id211 = ind1 + 8
4025  else
4026  fk0 = f_one - fs1
4027  fk1 = fs1
4028  fk2 = f_zero
4029  id001 = ind1
4030  id011 = ind1 + 9
4031  id101 = ind1 + 1
4032  id111 = ind1 +10
4033  id201 = ind1
4034  id211 = ind1
4035  endif
4036 
4037  fac001 = fk0*fac01(k)
4038  fac101 = fk1*fac01(k)
4039  fac201 = fk2*fac01(k)
4040  fac011 = fk0*fac11(k)
4041  fac111 = fk1*fac11(k)
4042  fac211 = fk2*fac11(k)
4043 
4044  do ig = 1, ng03
4045  tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) &
4046  & * (selfref(ig,indsp) - selfref(ig,inds)))
4047  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
4048  & * (forref(ig,indfp) - forref(ig,indf)))
4049  n2om1 = ka_mn2o(ig,jmn2o,indm) + fmn2o &
4050  & * (ka_mn2o(ig,jmn2op,indm) - ka_mn2o(ig,jmn2o,indm))
4051  n2om2 = ka_mn2o(ig,jmn2o,indmp) + fmn2o &
4052  & * (ka_mn2o(ig,jmn2op,indmp) - ka_mn2o(ig,jmn2o,indmp))
4053  absn2o = n2om1 + minorfrac(k) * (n2om2 - n2om1)
4054 
4055  tau_major = speccomb &
4056  & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) &
4057  & + fac100*absa(ig,id100) + fac110*absa(ig,id110) &
4058  & + fac200*absa(ig,id200) + fac210*absa(ig,id210))
4059 
4060  tau_major1 = speccomb1 &
4061  & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) &
4062  & + fac101*absa(ig,id101) + fac111*absa(ig,id111) &
4063  & + fac201*absa(ig,id201) + fac211*absa(ig,id211))
4064 
4065  taug(ns03+ig,k) = tau_major + tau_major1 &
4066  & + tauself + taufor + adjcoln2o*absn2o
4067 
4068  fracs(ns03+ig,k) = fracrefa(ig,jpl) + fpl &
4069  & * (fracrefa(ig,jplp) - fracrefa(ig,jpl))
4070  enddo ! end do_k_loop
4071  enddo ! end do_ig_loop
4072 
4073 ! --- ... upper atmosphere loop
4074 
4075  do k = laytrop+1, nlay
4076  speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2)
4077  specparm = colamt(k,1) / speccomb
4078  specmult = 4.0 * min(specparm, oneminus)
4079  js = 1 + int(specmult)
4080  fs = mod(specmult, f_one)
4081  ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(3) + js
4082 
4083  speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2)
4084  specparm1 = colamt(k,1) / speccomb1
4085  specmult1 = 4.0 * min(specparm1, oneminus)
4086  js1 = 1 + int(specmult1)
4087  fs1 = mod(specmult1, f_one)
4088  ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(3) + js1
4089 
4090  speccomb_mn2o = colamt(k,1) + refrat_m_b*colamt(k,2)
4091  specparm_mn2o = colamt(k,1) / speccomb_mn2o
4092  specmult_mn2o = 4.0 * min(specparm_mn2o, oneminus)
4093  jmn2o = 1 + int(specmult_mn2o)
4094  fmn2o = mod(specmult_mn2o, f_one)
4095 
4096  speccomb_planck = colamt(k,1) + refrat_planck_b*colamt(k,2)
4097  specparm_planck = colamt(k,1) / speccomb_planck
4098  specmult_planck = 4.0 * min(specparm_planck, oneminus)
4099  jpl = 1 + int(specmult_planck)
4100  fpl = mod(specmult_planck, f_one)
4101 
4102  indf = indfor(k)
4103  indm = indminor(k)
4104  indfp = indf + 1
4105  indmp = indm + 1
4106  jmn2op= jmn2o+ 1
4107  jplp = jpl + 1
4108 
4109  id000 = ind0
4110  id010 = ind0 + 5
4111  id100 = ind0 + 1
4112  id110 = ind0 + 6
4113  id001 = ind1
4114  id011 = ind1 + 5
4115  id101 = ind1 + 1
4116  id111 = ind1 + 6
4117 
4118 ! --- ... in atmospheres where the amount of n2o is too great to be considered
4119 ! a minor species, adjust the column amount of N2O by an empirical factor
4120 ! to obtain the proper contribution.
4121 
4122  p = coldry(k) * chi_mls(4,jp(k)+1)
4123  ratn2o = colamt(k,4) / p
4124  if (ratn2o > 1.5) then
4125  adjfac = 0.5 + (ratn2o - 0.5)**0.65
4126  adjcoln2o = adjfac * p
4127  else
4128  adjcoln2o = colamt(k,4)
4129  endif
4130 
4131  fk0 = f_one - fs
4132  fk1 = fs
4133  fac000 = fk0*fac00(k)
4134  fac010 = fk0*fac10(k)
4135  fac100 = fk1*fac00(k)
4136  fac110 = fk1*fac10(k)
4137 
4138  fk0 = f_one - fs1
4139  fk1 = fs1
4140  fac001 = fk0*fac01(k)
4141  fac011 = fk0*fac11(k)
4142  fac101 = fk1*fac01(k)
4143  fac111 = fk1*fac11(k)
4144 
4145  do ig = 1, ng03
4146  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
4147  & * (forref(ig,indfp) - forref(ig,indf)))
4148  n2om1 = kb_mn2o(ig,jmn2o,indm) + fmn2o &
4149  & * (kb_mn2o(ig,jmn2op,indm) - kb_mn2o(ig,jmn2o,indm))
4150  n2om2 = kb_mn2o(ig,jmn2o,indmp) + fmn2o &
4151  & * (kb_mn2o(ig,jmn2op,indmp) - kb_mn2o(ig,jmn2o,indmp))
4152  absn2o = n2om1 + minorfrac(k) * (n2om2 - n2om1)
4153 
4154  tau_major = speccomb &
4155  & * (fac000*absb(ig,id000) + fac010*absb(ig,id010) &
4156  & + fac100*absb(ig,id100) + fac110*absb(ig,id110))
4157 
4158  tau_major1 = speccomb1 &
4159  & * (fac001*absb(ig,id001) + fac011*absb(ig,id011) &
4160  & + fac101*absb(ig,id101) + fac111*absb(ig,id111))
4161 
4162  taug(ns03+ig,k) = tau_major + tau_major1 &
4163  & + taufor + adjcoln2o*absn2o
4164 
4165  fracs(ns03+ig,k) = fracrefb(ig,jpl) + fpl &
4166  & * (fracrefb(ig,jplp) - fracrefb(ig,jpl))
4167  enddo
4168  enddo
4169 
4170 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb03::ka_mn2o
real(kind=kind_phys), dimension(ng03, maf03, mmn03), public ka_mn2o
Definition: radlw_datatb.f:3260
module_radlw_kgb01::absb
real(kind=kind_phys), dimension(ng01, msb01), public absb
Definition: radlw_datatb.f:1620
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::fracrefb
real(kind=kind_phys), dimension(ng01), public fracrefb
Definition: radlw_datatb.f:1620
module_radlw_kgb03::kb_mn2o
real(kind=kind_phys), dimension(ng03, mbf03, mmn03), public kb_mn2o
Definition: radlw_datatb.f:3260
module_radlw_kgb03
This module sets up absorption coefficients for band 03: 500-630 cm-1 (low - h2o, co2; high - h2o...
Definition: radlw_datatb.f:3246
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function:

subroutine taumol::taugb04 ( )

Definition at line 4176 of file radlw_main.f.

References module_radlw_kgb04::absa, module_radlw_kgb04::absb, module_radlw_ref::chi_mls, module_radlw_main::f_one, module_radlw_main::f_zero, module_radlw_kgb04::forref, module_radlw_kgb04::fracrefa, module_radlw_kgb04::fracrefb, module_radlw_parameters::ng04, module_radlw_parameters::ns04, module_radlw_main::nspa, module_radlw_main::nspb, module_radlw_main::oneminus, and module_radlw_kgb04::selfref.

Referenced by module_radlw_main::taumol().

4176 ! ..................................
4177 
4178 ! ------------------------------------------------------------------ !
4179 ! band 4: 630-700 cm-1 (low key - h2o,co2; high key - o3,co2) !
4180 ! ------------------------------------------------------------------ !
4181 
4182  use module_radlw_kgb04
4183 
4184 ! --- locals:
4185  integer :: k, ind0, ind1, inds, indsp, indf, indfp, jpl, jplp, &
4186  & id000, id010, id100, id110, id200, id210, ig, js, js1, &
4187  & id001, id011, id101, id111, id201, id211
4188 
4189  real (kind=kind_phys) :: tauself, taufor, p, p4, fk0, fk1, fk2, &
4190  & speccomb, specparm, specmult, fs, &
4191  & speccomb1, specparm1, specmult1, fs1, &
4192  & speccomb_planck,specparm_planck,specmult_planck,fpl, &
4193  & fac000, fac100, fac200, fac010, fac110, fac210, &
4194  & fac001, fac101, fac201, fac011, fac111, fac211, &
4195  & refrat_planck_a, refrat_planck_b, tau_major, tau_major1
4196 !
4197 !===> ... begin here
4198 !
4199  refrat_planck_a = chi_mls(1,11)/chi_mls(2,11) ! P = 142.5940 mb
4200  refrat_planck_b = chi_mls(3,13)/chi_mls(2,13) ! P = 95.58350 mb
4201 
4202 ! --- ... lower atmosphere loop
4203 
4204  do k = 1, laytrop
4205  speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2)
4206  specparm = colamt(k,1) / speccomb
4207  specmult = 8.0 * min(specparm, oneminus)
4208  js = 1 + int(specmult)
4209  fs = mod(specmult, f_one)
4210  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(4) + js
4211 
4212  speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2)
4213  specparm1 = colamt(k,1) / speccomb1
4214  specmult1 = 8.0 * min(specparm1, oneminus)
4215  js1 = 1 + int(specmult1)
4216  fs1 = mod(specmult1, f_one)
4217  ind1 = ( jp(k)*5 + (jt1(k)-1)) * nspa(4) + js1
4218 
4219  speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,2)
4220  specparm_planck = colamt(k,1) / speccomb_planck
4221  specmult_planck = 8.0 * min(specparm_planck, oneminus)
4222  jpl = 1 + int(specmult_planck)
4223  fpl = mod(specmult_planck, 1.0)
4224 
4225  inds = indself(k)
4226  indf = indfor(k)
4227  indsp = inds + 1
4228  indfp = indf + 1
4229  jplp = jpl + 1
4230 
4231  if (specparm < 0.125) then
4232  p = fs - f_one
4233  p4 = p**4
4234  fk0 = p4
4235  fk1 = f_one - p - 2.0*p4
4236  fk2 = p + p4
4237  id000 = ind0
4238  id010 = ind0 + 9
4239  id100 = ind0 + 1
4240  id110 = ind0 +10
4241  id200 = ind0 + 2
4242  id210 = ind0 +11
4243  elseif (specparm > 0.875) then
4244  p = -fs
4245  p4 = p**4
4246  fk0 = p4
4247  fk1 = f_one - p - 2.0*p4
4248  fk2 = p + p4
4249  id000 = ind0 + 1
4250  id010 = ind0 +10
4251  id100 = ind0
4252  id110 = ind0 + 9
4253  id200 = ind0 - 1
4254  id210 = ind0 + 8
4255  else
4256  fk0 = f_one - fs
4257  fk1 = fs
4258  fk2 = f_zero
4259  id000 = ind0
4260  id010 = ind0 + 9
4261  id100 = ind0 + 1
4262  id110 = ind0 +10
4263  id200 = ind0
4264  id210 = ind0
4265  endif
4266 
4267  fac000 = fk0*fac00(k)
4268  fac100 = fk1*fac00(k)
4269  fac200 = fk2*fac00(k)
4270  fac010 = fk0*fac10(k)
4271  fac110 = fk1*fac10(k)
4272  fac210 = fk2*fac10(k)
4273 
4274  if (specparm1 < 0.125) then
4275  p = fs1 - f_one
4276  p4 = p**4
4277  fk0 = p4
4278  fk1 = f_one - p - 2.0*p4
4279  fk2 = p + p4
4280  id001 = ind1
4281  id011 = ind1 + 9
4282  id101 = ind1 + 1
4283  id111 = ind1 +10
4284  id201 = ind1 + 2
4285  id211 = ind1 +11
4286  elseif (specparm1 > 0.875) then
4287  p = -fs1
4288  p4 = p**4
4289  fk0 = p4
4290  fk1 = f_one - p - 2.0*p4
4291  fk2 = p + p4
4292  id001 = ind1 + 1
4293  id011 = ind1 +10
4294  id101 = ind1
4295  id111 = ind1 + 9
4296  id201 = ind1 - 1
4297  id211 = ind1 + 8
4298  else
4299  fk0 = f_one - fs1
4300  fk1 = fs1
4301  fk2 = f_zero
4302  id001 = ind1
4303  id011 = ind1 + 9
4304  id101 = ind1 + 1
4305  id111 = ind1 +10
4306  id201 = ind1
4307  id211 = ind1
4308  endif
4309 
4310  fac001 = fk0*fac01(k)
4311  fac101 = fk1*fac01(k)
4312  fac201 = fk2*fac01(k)
4313  fac011 = fk0*fac11(k)
4314  fac111 = fk1*fac11(k)
4315  fac211 = fk2*fac11(k)
4316 
4317  do ig = 1, ng04
4318  tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) &
4319  & * (selfref(ig,indsp) - selfref(ig,inds)))
4320  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
4321  & * (forref(ig,indfp) - forref(ig,indf)))
4322 
4323  tau_major = speccomb &
4324  & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) &
4325  & + fac100*absa(ig,id100) + fac110*absa(ig,id110) &
4326  & + fac200*absa(ig,id200) + fac210*absa(ig,id210))
4327 
4328  tau_major1 = speccomb1 &
4329  & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) &
4330  & + fac101*absa(ig,id101) + fac111*absa(ig,id111) &
4331  & + fac201*absa(ig,id201) + fac211*absa(ig,id211))
4332 
4333  taug(ns04+ig,k) = tau_major + tau_major1 + tauself + taufor
4334 
4335  fracs(ns04+ig,k) = fracrefa(ig,jpl) + fpl &
4336  & * (fracrefa(ig,jplp) - fracrefa(ig,jpl))
4337  enddo ! end do_k_loop
4338  enddo ! end do_ig_loop
4339 
4340 ! --- ... upper atmosphere loop
4341 
4342  do k = laytrop+1, nlay
4343  speccomb = colamt(k,3) + rfrate(k,6,1)*colamt(k,2)
4344  specparm = colamt(k,3) / speccomb
4345  specmult = 4.0 * min(specparm, oneminus)
4346  js = 1 + int(specmult)
4347  fs = mod(specmult, f_one)
4348  ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(4) + js
4349 
4350  speccomb1 = colamt(k,3) + rfrate(k,6,2)*colamt(k,2)
4351  specparm1 = colamt(k,3) / speccomb1
4352  specmult1 = 4.0 * min(specparm1, oneminus)
4353  js1 = 1 + int(specmult1)
4354  fs1 = mod(specmult1, f_one)
4355  ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(4) + js1
4356 
4357  speccomb_planck = colamt(k,3) + refrat_planck_b*colamt(k,2)
4358  specparm_planck = colamt(k,3) / speccomb_planck
4359  specmult_planck = 4.0 * min(specparm_planck, oneminus)
4360  jpl = 1 + int(specmult_planck)
4361  fpl = mod(specmult_planck, f_one)
4362  jplp = jpl + 1
4363 
4364  id000 = ind0
4365  id010 = ind0 + 5
4366  id100 = ind0 + 1
4367  id110 = ind0 + 6
4368  id001 = ind1
4369  id011 = ind1 + 5
4370  id101 = ind1 + 1
4371  id111 = ind1 + 6
4372 
4373  fk0 = f_one - fs
4374  fk1 = fs
4375  fac000 = fk0*fac00(k)
4376  fac010 = fk0*fac10(k)
4377  fac100 = fk1*fac00(k)
4378  fac110 = fk1*fac10(k)
4379 
4380  fk0 = f_one - fs1
4381  fk1 = fs1
4382  fac001 = fk0*fac01(k)
4383  fac011 = fk0*fac11(k)
4384  fac101 = fk1*fac01(k)
4385  fac111 = fk1*fac11(k)
4386 
4387  do ig = 1, ng04
4388  tau_major = speccomb &
4389  & * (fac000*absb(ig,id000) + fac010*absb(ig,id010) &
4390  & + fac100*absb(ig,id100) + fac110*absb(ig,id110))
4391  tau_major1 = speccomb1 &
4392  & * (fac001*absb(ig,id001) + fac011*absb(ig,id011) &
4393  & + fac101*absb(ig,id101) + fac111*absb(ig,id111))
4394 
4395  taug(ns04+ig,k) = tau_major + tau_major1
4396 
4397  fracs(ns04+ig,k) = fracrefb(ig,jpl) + fpl &
4398  & * (fracrefb(ig,jplp) - fracrefb(ig,jpl))
4399  enddo
4400 
4401 ! --- ... empirical modification to code to improve stratospheric cooling rates
4402 ! for co2. revised to apply weighting for g-point reduction in this band.
4403 
4404  taug(ns04+ 8,k) = taug(ns04+ 8,k) * 0.92
4405  taug(ns04+ 9,k) = taug(ns04+ 9,k) * 0.88
4406  taug(ns04+10,k) = taug(ns04+10,k) * 1.07
4407  taug(ns04+11,k) = taug(ns04+11,k) * 1.1
4408  taug(ns04+12,k) = taug(ns04+12,k) * 0.99
4409  taug(ns04+13,k) = taug(ns04+13,k) * 0.88
4410  taug(ns04+14,k) = taug(ns04+14,k) * 0.943
4411  enddo
4412 
4413 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::absb
real(kind=kind_phys), dimension(ng01, msb01), public absb
Definition: radlw_datatb.f:1620
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::fracrefb
real(kind=kind_phys), dimension(ng01), public fracrefb
Definition: radlw_datatb.f:1620
module_radlw_kgb04
This module sets up absorption coefficients for band 04: 630-700 cm-1 (low - h2o, co2; high - co2...
Definition: radlw_datatb.f:10048
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function:

subroutine taumol::taugb05 ( )

Definition at line 4419 of file radlw_main.f.

References module_radlw_kgb05::absa, module_radlw_kgb05::absb, module_radlw_kgb05::ccl4, module_radlw_ref::chi_mls, module_radlw_main::f_one, module_radlw_main::f_zero, module_radlw_kgb05::forref, module_radlw_kgb05::fracrefa, module_radlw_kgb05::fracrefb, module_radlw_kgb05::ka_mo3, module_radlw_parameters::ng05, module_radlw_parameters::ns05, module_radlw_main::nspa, module_radlw_main::nspb, module_radlw_main::oneminus, and module_radlw_kgb05::selfref.

Referenced by module_radlw_main::taumol().

4419 ! ..................................
4420 
4421 ! ------------------------------------------------------------------ !
4422 ! band 5: 700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4) !
4423 ! (high key - o3,co2) !
4424 ! ------------------------------------------------------------------ !
4425 
4426  use module_radlw_kgb05
4427 
4428 ! --- locals:
4429  integer :: k, ind0, ind1, inds, indsp, indf, indfp, indm, indmp, &
4430  & id000, id010, id100, id110, id200, id210, jmo3, jmo3p, &
4431  & id001, id011, id101, id111, id201, id211, jpl, jplp, &
4432  & ig, js, js1
4433 
4434  real (kind=kind_phys) :: tauself, taufor, o3m1, o3m2, abso3, &
4435  & speccomb, specparm, specmult, fs, &
4436  & speccomb1, specparm1, specmult1, fs1, &
4437  & speccomb_mo3, specparm_mo3, specmult_mo3, fmo3, &
4438  & speccomb_planck,specparm_planck,specmult_planck,fpl, &
4439  & refrat_planck_a, refrat_planck_b, refrat_m_a, &
4440  & fac000, fac100, fac200, fac010, fac110, fac210, &
4441  & fac001, fac101, fac201, fac011, fac111, fac211, &
4442  & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21
4443 !
4444 !===> ... begin here
4445 !
4446 ! --- ... minor gas mapping level :
4447 ! lower - o3, p = 317.34 mbar, t = 240.77 k
4448 ! lower - ccl4
4449 
4450 ! --- ... calculate reference ratio to be used in calculation of Planck
4451 ! fraction in lower/upper atmosphere.
4452 
4453  refrat_planck_a = chi_mls(1,5)/chi_mls(2,5) ! P = 473.420 mb
4454  refrat_planck_b = chi_mls(3,43)/chi_mls(2,43) ! P = 0.2369 mb
4455  refrat_m_a = chi_mls(1,7)/chi_mls(2,7) ! P = 317.348 mb
4456 
4457 ! --- ... lower atmosphere loop
4458 
4459  do k = 1, laytrop
4460  speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2)
4461  specparm = colamt(k,1) / speccomb
4462  specmult = 8.0 * min(specparm, oneminus)
4463  js = 1 + int(specmult)
4464  fs = mod(specmult, f_one)
4465  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(5) + js
4466 
4467  speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2)
4468  specparm1 = colamt(k,1) / speccomb1
4469  specmult1 = 8.0 * min(specparm1, oneminus)
4470  js1 = 1 + int(specmult1)
4471  fs1 = mod(specmult1, f_one)
4472  ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(5) + js1
4473 
4474  speccomb_mo3 = colamt(k,1) + refrat_m_a*colamt(k,2)
4475  specparm_mo3 = colamt(k,1) / speccomb_mo3
4476  specmult_mo3 = 8.0 * min(specparm_mo3, oneminus)
4477  jmo3 = 1 + int(specmult_mo3)
4478  fmo3 = mod(specmult_mo3, f_one)
4479 
4480  speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,2)
4481  specparm_planck = colamt(k,1) / speccomb_planck
4482  specmult_planck = 8.0 * min(specparm_planck, oneminus)
4483  jpl = 1 + int(specmult_planck)
4484  fpl = mod(specmult_planck, f_one)
4485 
4486  inds = indself(k)
4487  indf = indfor(k)
4488  indm = indminor(k)
4489  indsp = inds + 1
4490  indfp = indf + 1
4491  indmp = indm + 1
4492  jplp = jpl + 1
4493  jmo3p = jmo3 + 1
4494 
4495  if (specparm < 0.125 .and. specparm1 < 0.125) then
4496  p0 = fs - f_one
4497  p40 = p0**4
4498  fk00 = p40
4499  fk10 = f_one - p0 - 2.0*p40
4500  fk20 = p0 + p40
4501 
4502  p1 = fs1 - f_one
4503  p41 = p1**4
4504  fk01 = p41
4505  fk11 = f_one - p1 - 2.0*p41
4506  fk21 = p1 + p41
4507 
4508  id000 = ind0
4509  id010 = ind0 + 9
4510  id100 = ind0 + 1
4511  id110 = ind0 +10
4512  id200 = ind0 + 2
4513  id210 = ind0 +11
4514 
4515  id001 = ind1
4516  id011 = ind1 + 9
4517  id101 = ind1 + 1
4518  id111 = ind1 +10
4519  id201 = ind1 + 2
4520  id211 = ind1 +11
4521  elseif (specparm > 0.875 .and. specparm1 > 0.875) then
4522  p0 = -fs
4523  p40 = p0**4
4524  fk00 = p40
4525  fk10 = f_one - p0 - 2.0*p40
4526  fk20 = p0 + p40
4527 
4528  p1 = -fs1
4529  p41 = p1**4
4530  fk01 = p41
4531  fk11 = f_one - p1 - 2.0*p41
4532  fk21 = p1 + p41
4533 
4534  id000 = ind0 + 1
4535  id010 = ind0 +10
4536  id100 = ind0
4537  id110 = ind0 + 9
4538  id200 = ind0 - 1
4539  id210 = ind0 + 8
4540 
4541  id001 = ind1 + 1
4542  id011 = ind1 +10
4543  id101 = ind1
4544  id111 = ind1 + 9
4545  id201 = ind1 - 1
4546  id211 = ind1 + 8
4547  else
4548  fk00 = f_one - fs
4549  fk10 = fs
4550  fk20 = f_zero
4551 
4552  fk01 = f_one - fs1
4553  fk11 = fs1
4554  fk21 = f_zero
4555 
4556  id000 = ind0
4557  id010 = ind0 + 9
4558  id100 = ind0 + 1
4559  id110 = ind0 +10
4560  id200 = ind0
4561  id210 = ind0
4562 
4563  id001 = ind1
4564  id011 = ind1 + 9
4565  id101 = ind1 + 1
4566  id111 = ind1 +10
4567  id201 = ind1
4568  id211 = ind1
4569  endif
4570 
4571  fac000 = fk00 * fac00(k)
4572  fac100 = fk10 * fac00(k)
4573  fac200 = fk20 * fac00(k)
4574  fac010 = fk00 * fac10(k)
4575  fac110 = fk10 * fac10(k)
4576  fac210 = fk20 * fac10(k)
4577 
4578  fac001 = fk01 * fac01(k)
4579  fac101 = fk11 * fac01(k)
4580  fac201 = fk21 * fac01(k)
4581  fac011 = fk01 * fac11(k)
4582  fac111 = fk11 * fac11(k)
4583  fac211 = fk21 * fac11(k)
4584 
4585  do ig = 1, ng05
4586  tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) &
4587  & * (selfref(ig,indsp) - selfref(ig,inds)))
4588  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
4589  & * (forref(ig,indfp) - forref(ig,indf)))
4590  o3m1 = ka_mo3(ig,jmo3,indm) + fmo3 &
4591  & * (ka_mo3(ig,jmo3p,indm) - ka_mo3(ig,jmo3,indm))
4592  o3m2 = ka_mo3(ig,jmo3,indmp) + fmo3 &
4593  & * (ka_mo3(ig,jmo3p,indmp) - ka_mo3(ig,jmo3,indmp))
4594  abso3 = o3m1 + minorfrac(k)*(o3m2 - o3m1)
4595 
4596  taug(ns05+ig,k) = speccomb &
4597  & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) &
4598  & + fac100*absa(ig,id100) + fac110*absa(ig,id110) &
4599  & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) &
4600  & + speccomb1 &
4601  & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) &
4602  & + fac101*absa(ig,id101) + fac111*absa(ig,id111) &
4603  & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) &
4604  & + tauself + taufor+abso3*colamt(k,3)+wx(k,1)*ccl4(ig)
4605 
4606  fracs(ns05+ig,k) = fracrefa(ig,jpl) + fpl &
4607  & * (fracrefa(ig,jplp) - fracrefa(ig,jpl))
4608  enddo
4609  enddo
4610 
4611 ! --- ... upper atmosphere loop
4612 
4613  do k = laytrop+1, nlay
4614  speccomb = colamt(k,3) + rfrate(k,6,1)*colamt(k,2)
4615  specparm = colamt(k,3) / speccomb
4616  specmult = 4.0 * min(specparm, oneminus)
4617  js = 1 + int(specmult)
4618  fs = mod(specmult, f_one)
4619  ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(5) + js
4620 
4621  speccomb1 = colamt(k,3) + rfrate(k,6,2)*colamt(k,2)
4622  specparm1 = colamt(k,3) / speccomb1
4623  specmult1 = 4.0 * min(specparm1, oneminus)
4624  js1 = 1 + int(specmult1)
4625  fs1 = mod(specmult1, f_one)
4626  ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(5) + js1
4627 
4628  speccomb_planck = colamt(k,3) + refrat_planck_b*colamt(k,2)
4629  specparm_planck = colamt(k,3) / speccomb_planck
4630  specmult_planck = 4.0 * min(specparm_planck, oneminus)
4631  jpl = 1 + int(specmult_planck)
4632  fpl = mod(specmult_planck, f_one)
4633  jplp= jpl + 1
4634 
4635  id000 = ind0
4636  id010 = ind0 + 5
4637  id100 = ind0 + 1
4638  id110 = ind0 + 6
4639  id001 = ind1
4640  id011 = ind1 + 5
4641  id101 = ind1 + 1
4642  id111 = ind1 + 6
4643 
4644  fk00 = f_one - fs
4645  fk10 = fs
4646 
4647  fk01 = f_one - fs1
4648  fk11 = fs1
4649 
4650  fac000 = fk00 * fac00(k)
4651  fac010 = fk00 * fac10(k)
4652  fac100 = fk10 * fac00(k)
4653  fac110 = fk10 * fac10(k)
4654 
4655  fac001 = fk01 * fac01(k)
4656  fac011 = fk01 * fac11(k)
4657  fac101 = fk11 * fac01(k)
4658  fac111 = fk11 * fac11(k)
4659 
4660  do ig = 1, ng05
4661  taug(ns05+ig,k) = speccomb &
4662  & * (fac000*absb(ig,id000) + fac010*absb(ig,id010) &
4663  & + fac100*absb(ig,id100) + fac110*absb(ig,id110)) &
4664  & + speccomb1 &
4665  & * (fac001*absb(ig,id001) + fac011*absb(ig,id011) &
4666  & + fac101*absb(ig,id101) + fac111*absb(ig,id111)) &
4667  & + wx(k,1) * ccl4(ig)
4668 
4669  fracs(ns05+ig,k) = fracrefb(ig,jpl) + fpl &
4670  & * (fracrefb(ig,jplp) - fracrefb(ig,jpl))
4671  enddo
4672  enddo
4673 
4674 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb05
This module sets up absorption coefficients for band 05: 700-820 cm-1 (low - h2o, co2; high - co2...
Definition: radlw_datatb.f:15227
module_radlw_kgb01::absb
real(kind=kind_phys), dimension(ng01, msb01), public absb
Definition: radlw_datatb.f:1620
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb05::ka_mo3
real(kind=kind_phys), dimension(ng05, maf05, mmo05), public ka_mo3
Definition: radlw_datatb.f:15241
module_radlw_kgb01::fracrefb
real(kind=kind_phys), dimension(ng01), public fracrefb
Definition: radlw_datatb.f:1620
module_radlw_kgb05::ccl4
real(kind=kind_phys), dimension(ng05), public ccl4
Definition: radlw_datatb.f:15241
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function:

subroutine taumol::taugb06 ( )

Definition at line 4680 of file radlw_main.f.

References module_radlw_kgb06::absa, module_radlw_kgb06::cfc11adj, module_radlw_kgb06::cfc12, module_radlw_ref::chi_mls, module_radlw_kgb06::forref, module_radlw_kgb06::fracrefa, module_radlw_kgb06::ka_mco2, module_radlw_parameters::ng06, module_radlw_parameters::ns06, module_radlw_main::nspa, and module_radlw_kgb06::selfref.

Referenced by module_radlw_main::taumol().

4680 ! ..................................
4681 
4682 ! ------------------------------------------------------------------ !
4683 ! band 6: 820-980 cm-1 (low key - h2o; low minor - co2) !
4684 ! (high key - none; high minor - cfc11, cfc12)
4685 ! ------------------------------------------------------------------ !
4686 
4687  use module_radlw_kgb06
4688 
4689 ! --- locals:
4690  integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, &
4691  & indm, indmp, ig
4692 
4693  real (kind=kind_phys) :: ratco2, adjfac, adjcolco2, tauself, &
4694  & taufor, absco2, temp
4695 !
4696 !===> ... begin here
4697 !
4698 ! --- ... minor gas mapping level:
4699 ! lower - co2, p = 706.2720 mb, t = 294.2 k
4700 ! upper - cfc11, cfc12
4701 
4702 ! --- ... lower atmosphere loop
4703 
4704  do k = 1, laytrop
4705  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(6) + 1
4706  ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(6) + 1
4707 
4708  inds = indself(k)
4709  indf = indfor(k)
4710  indm = indminor(k)
4711  indsp = inds + 1
4712  indfp = indf + 1
4713  indmp = indm + 1
4714  ind0p = ind0 + 1
4715  ind1p = ind1 + 1
4716 
4717 ! --- ... in atmospheres where the amount of co2 is too great to be considered
4718 ! a minor species, adjust the column amount of co2 by an empirical factor
4719 ! to obtain the proper contribution.
4720 
4721  temp = coldry(k) * chi_mls(2,jp(k)+1)
4722  ratco2 = colamt(k,2) / temp
4723  if (ratco2 > 3.0) then
4724  adjfac = 2.0 + (ratco2-2.0)**0.77
4725  adjcolco2 = adjfac * temp
4726  else
4727  adjcolco2 = colamt(k,2)
4728  endif
4729 
4730  do ig = 1, ng06
4731  tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) &
4732  & * (selfref(ig,indsp) - selfref(ig,inds)))
4733  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
4734  & * (forref(ig,indfp) - forref(ig,indf)))
4735  absco2 = ka_mco2(ig,indm) + minorfrac(k) &
4736  & * (ka_mco2(ig,indmp) - ka_mco2(ig,indm))
4737 
4738  taug(ns06+ig,k) = colamt(k,1) &
4739  & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) &
4740  & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) &
4741  & + tauself + taufor + adjcolco2*absco2 &
4742  & + wx(k,2)*cfc11adj(ig) + wx(k,3)*cfc12(ig)
4743 
4744  fracs(ns06+ig,k) = fracrefa(ig)
4745  enddo
4746  enddo
4747 
4748 ! --- ... upper atmosphere loop
4749 ! nothing important goes on above laytrop in this band.
4750 
4751  do k = laytrop+1, nlay
4752  do ig = 1, ng06
4753  taug(ns06+ig,k) = wx(k,2)*cfc11adj(ig) + wx(k,3)*cfc12(ig)
4754 
4755  fracs(ns06+ig,k) = fracrefa(ig)
4756  enddo
4757  enddo
4758 
4759 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb06
This module sets up absorption coefficients for band 06: 820-980 cm-1 (low - h2o; high - /) ...
Definition: radlw_datatb.f:21699
module_radlw_kgb06::cfc11adj
real(kind=kind_phys), dimension(ng06), public cfc11adj
Definition: radlw_datatb.f:21712
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb06::cfc12
real(kind=kind_phys), dimension(ng06), public cfc12
Definition: radlw_datatb.f:21712
module_radlw_kgb06::ka_mco2
real(kind=kind_phys), dimension(ng06, mmc06), public ka_mco2
Definition: radlw_datatb.f:21712
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function:

subroutine taumol::taugb07 ( )

Definition at line 4765 of file radlw_main.f.

References module_radlw_kgb07::absa, module_radlw_kgb07::absb, module_radlw_ref::chi_mls, module_radlw_main::f_one, module_radlw_main::f_zero, module_radlw_kgb07::forref, module_radlw_kgb07::fracrefa, module_radlw_kgb07::fracrefb, module_radlw_kgb07::ka_mco2, module_radlw_kgb07::kb_mco2, module_radlw_parameters::ng07, module_radlw_parameters::ns07, module_radlw_main::nspa, module_radlw_main::nspb, module_radlw_main::oneminus, and module_radlw_kgb07::selfref.

Referenced by module_radlw_main::taumol().

4765 ! ..................................
4766 
4767 ! ------------------------------------------------------------------ !
4768 ! band 7: 980-1080 cm-1 (low key - h2o,o3; low minor - co2) !
4769 ! (high key - o3; high minor - co2) !
4770 ! ------------------------------------------------------------------ !
4771 
4772  use module_radlw_kgb07
4773 
4774 ! --- locals:
4775  integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, &
4776  & id000, id010, id100, id110, id200, id210, indm, indmp, &
4777  & id001, id011, id101, id111, id201, id211, jmco2, jmco2p, &
4778  & jpl, jplp, ig, js, js1
4779 
4780  real (kind=kind_phys) :: tauself, taufor, co2m1, co2m2, absco2, &
4781  & speccomb, specparm, specmult, fs, &
4782  & speccomb1, specparm1, specmult1, fs1, &
4783  & speccomb_mco2, specparm_mco2, specmult_mco2, fmco2, &
4784  & speccomb_planck,specparm_planck,specmult_planck,fpl, &
4785  & refrat_planck_a, refrat_m_a, ratco2, adjfac, adjcolco2, &
4786  & fac000, fac100, fac200, fac010, fac110, fac210, &
4787  & fac001, fac101, fac201, fac011, fac111, fac211, &
4788  & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21, temp
4789 !
4790 !===> ... begin here
4791 !
4792 ! --- ... minor gas mapping level :
4793 ! lower - co2, p = 706.2620 mbar, t= 278.94 k
4794 ! upper - co2, p = 12.9350 mbar, t = 234.01 k
4795 
4796 ! --- ... calculate reference ratio to be used in calculation of Planck
4797 ! fraction in lower atmosphere.
4798 
4799  refrat_planck_a = chi_mls(1,3)/chi_mls(3,3) ! P = 706.2620 mb
4800  refrat_m_a = chi_mls(1,3)/chi_mls(3,3) ! P = 706.2720 mb
4801 
4802 ! --- ... lower atmosphere loop
4803 
4804  do k = 1, laytrop
4805  speccomb = colamt(k,1) + rfrate(k,2,1)*colamt(k,3)
4806  specparm = colamt(k,1) / speccomb
4807  specmult = 8.0 * min(specparm, oneminus)
4808  js = 1 + int(specmult)
4809  fs = mod(specmult, f_one)
4810  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(7) + js
4811 
4812  speccomb1 = colamt(k,1) + rfrate(k,2,2)*colamt(k,3)
4813  specparm1 = colamt(k,1) / speccomb1
4814  specmult1 = 8.0 * min(specparm1, oneminus)
4815  js1 = 1 + int(specmult1)
4816  fs1 = mod(specmult1, f_one)
4817  ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(7) + js1
4818 
4819  speccomb_mco2 = colamt(k,1) + refrat_m_a*colamt(k,3)
4820  specparm_mco2 = colamt(k,1) / speccomb_mco2
4821  specmult_mco2 = 8.0 * min(specparm_mco2, oneminus)
4822  jmco2 = 1 + int(specmult_mco2)
4823  fmco2 = mod(specmult_mco2, f_one)
4824 
4825  speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,3)
4826  specparm_planck = colamt(k,1) / speccomb_planck
4827  specmult_planck = 8.0 * min(specparm_planck, oneminus)
4828  jpl = 1 + int(specmult_planck)
4829  fpl = mod(specmult_planck, f_one)
4830 
4831  inds = indself(k)
4832  indf = indfor(k)
4833  indm = indminor(k)
4834  indsp = inds + 1
4835  indfp = indf + 1
4836  indmp = indm + 1
4837  jplp = jpl + 1
4838  jmco2p= jmco2+ 1
4839  ind0p = ind0 + 1
4840  ind1p = ind1 + 1
4841 
4842 ! --- ... in atmospheres where the amount of CO2 is too great to be considered
4843 ! a minor species, adjust the column amount of CO2 by an empirical factor
4844 ! to obtain the proper contribution.
4845 
4846  temp = coldry(k) * chi_mls(2,jp(k)+1)
4847  ratco2 = colamt(k,2) / temp
4848  if (ratco2 > 3.0) then
4849  adjfac = 3.0 + (ratco2-3.0)**0.79
4850  adjcolco2 = adjfac * temp
4851  else
4852  adjcolco2 = colamt(k,2)
4853  endif
4854 
4855  if (specparm < 0.125 .and. specparm1 < 0.125) then
4856  p0 = fs - f_one
4857  p40 = p0**4
4858  fk00 = p40
4859  fk10 = f_one - p0 - 2.0*p40
4860  fk20 = p0 + p40
4861 
4862  p1 = fs1 - f_one
4863  p41 = p1**4
4864  fk01 = p41
4865  fk11 = f_one - p1 - 2.0*p41
4866  fk21 = p1 + p41
4867 
4868  id000 = ind0
4869  id010 = ind0 + 9
4870  id100 = ind0 + 1
4871  id110 = ind0 +10
4872  id200 = ind0 + 2
4873  id210 = ind0 +11
4874 
4875  id001 = ind1
4876  id011 = ind1 + 9
4877  id101 = ind1 + 1
4878  id111 = ind1 +10
4879  id201 = ind1 + 2
4880  id211 = ind1 +11
4881  elseif (specparm > 0.875 .and. specparm1 > 0.875) then
4882  p0 = -fs
4883  p40 = p0**4
4884  fk00 = p40
4885  fk10 = f_one - p0 - 2.0*p40
4886  fk20 = p0 + p40
4887 
4888  p1 = -fs1
4889  p41 = p1**4
4890  fk01 = p41
4891  fk11 = f_one - p1 - 2.0*p41
4892  fk21 = p1 + p41
4893 
4894  id000 = ind0 + 1
4895  id010 = ind0 +10
4896  id100 = ind0
4897  id110 = ind0 + 9
4898  id200 = ind0 - 1
4899  id210 = ind0 + 8
4900 
4901  id001 = ind1 + 1
4902  id011 = ind1 +10
4903  id101 = ind1
4904  id111 = ind1 + 9
4905  id201 = ind1 - 1
4906  id211 = ind1 + 8
4907  else
4908  fk00 = f_one - fs
4909  fk10 = fs
4910  fk20 = f_zero
4911 
4912  fk01 = f_one - fs1
4913  fk11 = fs1
4914  fk21 = f_zero
4915 
4916  id000 = ind0
4917  id010 = ind0 + 9
4918  id100 = ind0 + 1
4919  id110 = ind0 +10
4920  id200 = ind0
4921  id210 = ind0
4922 
4923  id001 = ind1
4924  id011 = ind1 + 9
4925  id101 = ind1 + 1
4926  id111 = ind1 +10
4927  id201 = ind1
4928  id211 = ind1
4929  endif
4930 
4931  fac000 = fk00 * fac00(k)
4932  fac100 = fk10 * fac00(k)
4933  fac200 = fk20 * fac00(k)
4934  fac010 = fk00 * fac10(k)
4935  fac110 = fk10 * fac10(k)
4936  fac210 = fk20 * fac10(k)
4937 
4938  fac001 = fk01 * fac01(k)
4939  fac101 = fk11 * fac01(k)
4940  fac201 = fk21 * fac01(k)
4941  fac011 = fk01 * fac11(k)
4942  fac111 = fk11 * fac11(k)
4943  fac211 = fk21 * fac11(k)
4944 
4945  do ig = 1, ng07
4946  tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) &
4947  & * (selfref(ig,indsp) - selfref(ig,inds)))
4948  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
4949  & * (forref(ig,indfp) - forref(ig,indf)))
4950  co2m1 = ka_mco2(ig,jmco2,indm) + fmco2 &
4951  & * (ka_mco2(ig,jmco2p,indm) - ka_mco2(ig,jmco2,indm))
4952  co2m2 = ka_mco2(ig,jmco2,indmp) + fmco2 &
4953  & * (ka_mco2(ig,jmco2p,indmp) - ka_mco2(ig,jmco2,indmp))
4954  absco2 = co2m1 + minorfrac(k) * (co2m2 - co2m1)
4955 
4956  taug(ns07+ig,k) = speccomb &
4957  & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) &
4958  & + fac100*absa(ig,id100) + fac110*absa(ig,id110) &
4959  & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) &
4960  & + speccomb1 &
4961  & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) &
4962  & + fac101*absa(ig,id101) + fac111*absa(ig,id111) &
4963  & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) &
4964  & + tauself + taufor + adjcolco2*absco2
4965 
4966  fracs(ns07+ig,k) = fracrefa(ig,jpl) + fpl &
4967  & * (fracrefa(ig,jplp) - fracrefa(ig,jpl))
4968  enddo
4969  enddo
4970 
4971 ! --- ... upper atmosphere loop
4972 
4973 ! --- ... in atmospheres where the amount of co2 is too great to be considered
4974 ! a minor species, adjust the column amount of co2 by an empirical factor
4975 ! to obtain the proper contribution.
4976 
4977  do k = laytrop+1, nlay
4978  temp = coldry(k) * chi_mls(2,jp(k)+1)
4979  ratco2 = colamt(k,2) / temp
4980  if (ratco2 > 3.0) then
4981  adjfac = 2.0 + (ratco2-2.0)**0.79
4982  adjcolco2 = adjfac * temp
4983  else
4984  adjcolco2 = colamt(k,2)
4985  endif
4986 
4987  ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(7) + 1
4988  ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(7) + 1
4989 
4990  indm = indminor(k)
4991  indmp = indm + 1
4992  ind0p = ind0 + 1
4993  ind1p = ind1 + 1
4994 
4995  do ig = 1, ng07
4996  absco2 = kb_mco2(ig,indm) + minorfrac(k) &
4997  & * (kb_mco2(ig,indmp) - kb_mco2(ig,indm))
4998 
4999  taug(ns07+ig,k) = colamt(k,3) &
5000  & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) &
5001  & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) &
5002  & + adjcolco2 * absco2
5003 
5004  fracs(ns07+ig,k) = fracrefb(ig)
5005  enddo
5006 
5007 ! --- ... empirical modification to code to improve stratospheric cooling rates
5008 ! for o3. revised to apply weighting for g-point reduction in this band.
5009 
5010  taug(ns07+ 6,k) = taug(ns07+ 6,k) * 0.92
5011  taug(ns07+ 7,k) = taug(ns07+ 7,k) * 0.88
5012  taug(ns07+ 8,k) = taug(ns07+ 8,k) * 1.07
5013  taug(ns07+ 9,k) = taug(ns07+ 9,k) * 1.1
5014  taug(ns07+10,k) = taug(ns07+10,k) * 0.99
5015  taug(ns07+11,k) = taug(ns07+11,k) * 0.855
5016  enddo
5017 
5018 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::absb
real(kind=kind_phys), dimension(ng01, msb01), public absb
Definition: radlw_datatb.f:1620
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::fracrefb
real(kind=kind_phys), dimension(ng01), public fracrefb
Definition: radlw_datatb.f:1620
module_radlw_kgb07
This module sets up absorption coefficients for band 07: 980-1080 cm-1 (low - h2o, o3; high - o3)
Definition: radlw_datatb.f:21937
module_radlw_kgb07::kb_mco2
real(kind=kind_phys), dimension(ng07, mmc07), public kb_mco2
Definition: radlw_datatb.f:21951
module_radlw_kgb06::ka_mco2
real(kind=kind_phys), dimension(ng06, mmc06), public ka_mco2
Definition: radlw_datatb.f:21712
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function:

subroutine taumol::taugb08 ( )

Definition at line 5024 of file radlw_main.f.

References module_radlw_kgb08::absa, module_radlw_kgb08::absb, module_radlw_kgb08::cfc12, module_radlw_kgb08::cfc22adj, module_radlw_ref::chi_mls, module_radlw_kgb08::forref, module_radlw_kgb08::fracrefa, module_radlw_kgb08::fracrefb, module_radlw_kgb08::ka_mco2, module_radlw_kgb08::ka_mn2o, module_radlw_kgb08::ka_mo3, module_radlw_kgb08::kb_mco2, module_radlw_kgb08::kb_mn2o, module_radlw_parameters::ng08, module_radlw_parameters::ns08, module_radlw_main::nspa, module_radlw_main::nspb, and module_radlw_kgb08::selfref.

Referenced by module_radlw_main::taumol().

5024 ! ..................................
5025 
5026 ! ------------------------------------------------------------------ !
5027 ! band 8: 1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o) !
5028 ! (high key - o3; high minor - co2, n2o) !
5029 ! ------------------------------------------------------------------ !
5030 
5031  use module_radlw_kgb08
5032 
5033 ! --- locals:
5034  integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, &
5035  & indm, indmp, ig
5036 
5037  real (kind=kind_phys) :: tauself, taufor, absco2, abso3, absn2o, &
5038  & ratco2, adjfac, adjcolco2, temp
5039 !
5040 !===> ... begin here
5041 !
5042 ! --- ... minor gas mapping level:
5043 ! lower - co2, p = 1053.63 mb, t = 294.2 k
5044 ! lower - o3, p = 317.348 mb, t = 240.77 k
5045 ! lower - n2o, p = 706.2720 mb, t= 278.94 k
5046 ! lower - cfc12,cfc11
5047 ! upper - co2, p = 35.1632 mb, t = 223.28 k
5048 ! upper - n2o, p = 8.716e-2 mb, t = 226.03 k
5049 
5050 ! --- ... lower atmosphere loop
5051 
5052  do k = 1, laytrop
5053  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(8) + 1
5054  ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(8) + 1
5055 
5056  inds = indself(k)
5057  indf = indfor(k)
5058  indm = indminor(k)
5059  ind0p = ind0 + 1
5060  ind1p = ind1 + 1
5061  indsp = inds + 1
5062  indfp = indf + 1
5063  indmp = indm + 1
5064 
5065 ! --- ... in atmospheres where the amount of co2 is too great to be considered
5066 ! a minor species, adjust the column amount of co2 by an empirical factor
5067 ! to obtain the proper contribution.
5068 
5069  temp = coldry(k) * chi_mls(2,jp(k)+1)
5070  ratco2 = colamt(k,2) / temp
5071  if (ratco2 > 3.0) then
5072  adjfac = 2.0 + (ratco2-2.0)**0.65
5073  adjcolco2 = adjfac * temp
5074  else
5075  adjcolco2 = colamt(k,2)
5076  endif
5077 
5078  do ig = 1, ng08
5079  tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) &
5080  & * (selfref(ig,indsp) - selfref(ig,inds)))
5081  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
5082  & * (forref(ig,indfp) - forref(ig,indf)))
5083  absco2 = (ka_mco2(ig,indm) + minorfrac(k) &
5084  & * (ka_mco2(ig,indmp) - ka_mco2(ig,indm)))
5085  abso3 = (ka_mo3(ig,indm) + minorfrac(k) &
5086  & * (ka_mo3(ig,indmp) - ka_mo3(ig,indm)))
5087  absn2o = (ka_mn2o(ig,indm) + minorfrac(k) &
5088  & * (ka_mn2o(ig,indmp) - ka_mn2o(ig,indm)))
5089 
5090  taug(ns08+ig,k) = colamt(k,1) &
5091  & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) &
5092  & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) &
5093  & + tauself+taufor + adjcolco2*absco2 &
5094  & + colamt(k,3)*abso3 + colamt(k,4)*absn2o &
5095  & + wx(k,3)*cfc12(ig) + wx(k,4)*cfc22adj(ig)
5096 
5097  fracs(ns08+ig,k) = fracrefa(ig)
5098  enddo
5099  enddo
5100 
5101 ! --- ... upper atmosphere loop
5102 
5103  do k = laytrop+1, nlay
5104  ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(8) + 1
5105  ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(8) + 1
5106 
5107  indm = indminor(k)
5108  ind0p = ind0 + 1
5109  ind1p = ind1 + 1
5110  indmp = indm + 1
5111 
5112 ! --- ... in atmospheres where the amount of co2 is too great to be considered
5113 ! a minor species, adjust the column amount of co2 by an empirical factor
5114 ! to obtain the proper contribution.
5115 
5116  temp = coldry(k) * chi_mls(2,jp(k)+1)
5117  ratco2 = colamt(k,2) / temp
5118  if (ratco2 > 3.0) then
5119  adjfac = 2.0 + (ratco2-2.0)**0.65
5120  adjcolco2 = adjfac * temp
5121  else
5122  adjcolco2 = colamt(k,2)
5123  endif
5124 
5125  do ig = 1, ng08
5126  absco2 = (kb_mco2(ig,indm) + minorfrac(k) &
5127  & * (kb_mco2(ig,indmp) - kb_mco2(ig,indm)))
5128  absn2o = (kb_mn2o(ig,indm) + minorfrac(k) &
5129  & * (kb_mn2o(ig,indmp) - kb_mn2o(ig,indm)))
5130 
5131  taug(ns08+ig,k) = colamt(k,3) &
5132  & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) &
5133  & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) &
5134  & + adjcolco2*absco2 + colamt(k,4)*absn2o &
5135  & + wx(k,3)*cfc12(ig) + wx(k,4)*cfc22adj(ig)
5136 
5137  fracs(ns08+ig,k) = fracrefb(ig)
5138  enddo
5139  enddo
5140 
5141 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb03::ka_mn2o
real(kind=kind_phys), dimension(ng03, maf03, mmn03), public ka_mn2o
Definition: radlw_datatb.f:3260
module_radlw_kgb01::absb
real(kind=kind_phys), dimension(ng01, msb01), public absb
Definition: radlw_datatb.f:1620
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb08
This module sets up absorption coefficients for band 08: 1080-1180 cm-1 (low - h2o; high - o3) ...
Definition: radlw_datatb.f:24563
module_radlw_kgb05::ka_mo3
real(kind=kind_phys), dimension(ng05, maf05, mmo05), public ka_mo3
Definition: radlw_datatb.f:15241
module_radlw_kgb01::fracrefb
real(kind=kind_phys), dimension(ng01), public fracrefb
Definition: radlw_datatb.f:1620
module_radlw_kgb03::kb_mn2o
real(kind=kind_phys), dimension(ng03, mbf03, mmn03), public kb_mn2o
Definition: radlw_datatb.f:3260
module_radlw_kgb07::kb_mco2
real(kind=kind_phys), dimension(ng07, mmc07), public kb_mco2
Definition: radlw_datatb.f:21951
module_radlw_kgb06::cfc12
real(kind=kind_phys), dimension(ng06), public cfc12
Definition: radlw_datatb.f:21712
module_radlw_kgb06::ka_mco2
real(kind=kind_phys), dimension(ng06, mmc06), public ka_mco2
Definition: radlw_datatb.f:21712
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620
module_radlw_kgb08::cfc22adj
real(kind=kind_phys), dimension(ng08), public cfc22adj
Definition: radlw_datatb.f:24576

Here is the caller graph for this function:

subroutine taumol::taugb09 ( )

Definition at line 5147 of file radlw_main.f.

References module_radlw_kgb09::absa, module_radlw_kgb09::absb, module_radlw_ref::chi_mls, module_radlw_main::f_one, module_radlw_main::f_zero, module_radlw_kgb09::forref, module_radlw_kgb09::fracrefa, module_radlw_kgb09::fracrefb, module_radlw_kgb09::ka_mn2o, module_radlw_kgb09::kb_mn2o, module_radlw_parameters::ng09, module_radlw_parameters::ns09, module_radlw_main::nspa, module_radlw_main::nspb, module_radlw_main::oneminus, and module_radlw_kgb09::selfref.

Referenced by module_radlw_main::taumol().

5147 ! ..................................
5148 
5149 ! ------------------------------------------------------------------ !
5150 ! band 9: 1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o) !
5151 ! (high key - ch4; high minor - n2o) !
5152 ! ------------------------------------------------------------------ !
5153 
5154  use module_radlw_kgb09
5155 
5156 ! --- locals:
5157  integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, &
5158  & id000, id010, id100, id110, id200, id210, indm, indmp, &
5159  & id001, id011, id101, id111, id201, id211, jmn2o, jmn2op, &
5160  & jpl, jplp, ig, js, js1
5161 
5162  real (kind=kind_phys) :: tauself, taufor, n2om1, n2om2, absn2o, &
5163  & speccomb, specparm, specmult, fs, &
5164  & speccomb1, specparm1, specmult1, fs1, &
5165  & speccomb_mn2o, specparm_mn2o, specmult_mn2o, fmn2o, &
5166  & speccomb_planck,specparm_planck,specmult_planck,fpl, &
5167  & refrat_planck_a, refrat_m_a, ratn2o, adjfac, adjcoln2o, &
5168  & fac000, fac100, fac200, fac010, fac110, fac210, &
5169  & fac001, fac101, fac201, fac011, fac111, fac211, &
5170  & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21, temp
5171 !
5172 !===> ... begin here
5173 !
5174 ! --- ... minor gas mapping level :
5175 ! lower - n2o, p = 706.272 mbar, t = 278.94 k
5176 ! upper - n2o, p = 95.58 mbar, t = 215.7 k
5177 
5178 ! --- ... calculate reference ratio to be used in calculation of Planck
5179 ! fraction in lower/upper atmosphere.
5180 
5181  refrat_planck_a = chi_mls(1,9)/chi_mls(6,9) ! P = 212 mb
5182  refrat_m_a = chi_mls(1,3)/chi_mls(6,3) ! P = 706.272 mb
5183 
5184 ! --- ... lower atmosphere loop
5185 
5186  do k = 1, laytrop
5187  speccomb = colamt(k,1) + rfrate(k,4,1)*colamt(k,5)
5188  specparm = colamt(k,1) / speccomb
5189  specmult = 8.0 * min(specparm, oneminus)
5190  js = 1 + int(specmult)
5191  fs = mod(specmult, f_one)
5192  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(9) + js
5193 
5194  speccomb1 = colamt(k,1) + rfrate(k,4,2)*colamt(k,5)
5195  specparm1 = colamt(k,1) / speccomb1
5196  specmult1 = 8.0 * min(specparm1, oneminus)
5197  js1 = 1 + int(specmult1)
5198  fs1 = mod(specmult1, f_one)
5199  ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(9) + js1
5200 
5201  speccomb_mn2o = colamt(k,1) + refrat_m_a*colamt(k,5)
5202  specparm_mn2o = colamt(k,1) / speccomb_mn2o
5203  specmult_mn2o = 8.0 * min(specparm_mn2o, oneminus)
5204  jmn2o = 1 + int(specmult_mn2o)
5205  fmn2o = mod(specmult_mn2o, f_one)
5206 
5207  speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,5)
5208  specparm_planck = colamt(k,1) / speccomb_planck
5209  specmult_planck = 8.0 * min(specparm_planck, oneminus)
5210  jpl = 1 + int(specmult_planck)
5211  fpl = mod(specmult_planck, f_one)
5212 
5213  inds = indself(k)
5214  indf = indfor(k)
5215  indm = indminor(k)
5216  indsp = inds + 1
5217  indfp = indf + 1
5218  indmp = indm + 1
5219  jplp = jpl + 1
5220  jmn2op= jmn2o+ 1
5221 
5222 ! --- ... in atmospheres where the amount of n2o is too great to be considered
5223 ! a minor species, adjust the column amount of n2o by an empirical factor
5224 ! to obtain the proper contribution.
5225 
5226  temp = coldry(k) * chi_mls(4,jp(k)+1)
5227  ratn2o = colamt(k,4) / temp
5228  if (ratn2o > 1.5) then
5229  adjfac = 0.5 + (ratn2o-0.5)**0.65
5230  adjcoln2o = adjfac * temp
5231  else
5232  adjcoln2o = colamt(k,4)
5233  endif
5234 
5235  if (specparm < 0.125 .and. specparm1 < 0.125) then
5236  p0 = fs - f_one
5237  p40 = p0**4
5238  fk00 = p40
5239  fk10 = f_one - p0 - 2.0*p40
5240  fk20 = p0 + p40
5241 
5242  p1 = fs1 - f_one
5243  p41 = p1**4
5244  fk01 = p41
5245  fk11 = f_one - p1 - 2.0*p41
5246  fk21 = p1 + p41
5247 
5248  id000 = ind0
5249  id010 = ind0 + 9
5250  id100 = ind0 + 1
5251  id110 = ind0 +10
5252  id200 = ind0 + 2
5253  id210 = ind0 +11
5254 
5255  id001 = ind1
5256  id011 = ind1 + 9
5257  id101 = ind1 + 1
5258  id111 = ind1 +10
5259  id201 = ind1 + 2
5260  id211 = ind1 +11
5261 
5262  elseif (specparm > 0.875 .and. specparm1 > 0.875) then
5263  p0 = -fs
5264  p40 = p0**4
5265  fk00 = p40
5266  fk10 = f_one - p0 - 2.0*p40
5267  fk20 = p0 + p40
5268 
5269  p1 = -fs1
5270  p41 = p1**4
5271  fk01 = p41
5272  fk11 = f_one - p1 - 2.0*p41
5273  fk21 = p1 + p41
5274 
5275  id000 = ind0 + 1
5276  id010 = ind0 +10
5277  id100 = ind0
5278  id110 = ind0 + 9
5279  id200 = ind0 - 1
5280  id210 = ind0 + 8
5281 
5282  id001 = ind1 + 1
5283  id011 = ind1 +10
5284  id101 = ind1
5285  id111 = ind1 + 9
5286  id201 = ind1 - 1
5287  id211 = ind1 + 8
5288  else
5289  fk00 = f_one - fs
5290  fk10 = fs
5291  fk20 = f_zero
5292 
5293  fk01 = f_one - fs1
5294  fk11 = fs1
5295  fk21 = f_zero
5296 
5297  id000 = ind0
5298  id010 = ind0 + 9
5299  id100 = ind0 + 1
5300  id110 = ind0 +10
5301  id200 = ind0
5302  id210 = ind0
5303 
5304  id001 = ind1
5305  id011 = ind1 + 9
5306  id101 = ind1 + 1
5307  id111 = ind1 +10
5308  id201 = ind1
5309  id211 = ind1
5310  endif
5311 
5312  fac000 = fk00 * fac00(k)
5313  fac100 = fk10 * fac00(k)
5314  fac200 = fk20 * fac00(k)
5315  fac010 = fk00 * fac10(k)
5316  fac110 = fk10 * fac10(k)
5317  fac210 = fk20 * fac10(k)
5318 
5319  fac001 = fk01 * fac01(k)
5320  fac101 = fk11 * fac01(k)
5321  fac201 = fk21 * fac01(k)
5322  fac011 = fk01 * fac11(k)
5323  fac111 = fk11 * fac11(k)
5324  fac211 = fk21 * fac11(k)
5325 
5326  do ig = 1, ng09
5327  tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) &
5328  & * (selfref(ig,indsp) - selfref(ig,inds)))
5329  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
5330  & * (forref(ig,indfp) - forref(ig,indf)))
5331  n2om1 = ka_mn2o(ig,jmn2o,indm) + fmn2o &
5332  & * (ka_mn2o(ig,jmn2op,indm) - ka_mn2o(ig,jmn2o,indm))
5333  n2om2 = ka_mn2o(ig,jmn2o,indmp) + fmn2o &
5334  & * (ka_mn2o(ig,jmn2op,indmp) - ka_mn2o(ig,jmn2o,indmp))
5335  absn2o = n2om1 + minorfrac(k) * (n2om2 - n2om1)
5336 
5337  taug(ns09+ig,k) = speccomb &
5338  & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) &
5339  & + fac100*absa(ig,id100) + fac110*absa(ig,id110) &
5340  & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) &
5341  & + speccomb1 &
5342  & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) &
5343  & + fac101*absa(ig,id101) + fac111*absa(ig,id111) &
5344  & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) &
5345  & + tauself + taufor + adjcoln2o*absn2o
5346 
5347  fracs(ns09+ig,k) = fracrefa(ig,jpl) + fpl &
5348  & * (fracrefa(ig,jplp) - fracrefa(ig,jpl))
5349  enddo
5350  enddo
5351 
5352 ! --- ... upper atmosphere loop
5353 
5354  do k = laytrop+1, nlay
5355  ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(9) + 1
5356  ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(9) + 1
5357 
5358  indm = indminor(k)
5359  ind0p = ind0 + 1
5360  ind1p = ind1 + 1
5361  indmp = indm + 1
5362 
5363 ! --- ... in atmospheres where the amount of n2o is too great to be considered
5364 ! a minor species, adjust the column amount of n2o by an empirical factor
5365 ! to obtain the proper contribution.
5366 
5367  temp = coldry(k) * chi_mls(4,jp(k)+1)
5368  ratn2o = colamt(k,4) / temp
5369  if (ratn2o > 1.5) then
5370  adjfac = 0.5 + (ratn2o - 0.5)**0.65
5371  adjcoln2o = adjfac * temp
5372  else
5373  adjcoln2o = colamt(k,4)
5374  endif
5375 
5376  do ig = 1, ng09
5377  absn2o = kb_mn2o(ig,indm) + minorfrac(k) &
5378  & * (kb_mn2o(ig,indmp) - kb_mn2o(ig,indm))
5379 
5380  taug(ns09+ig,k) = colamt(k,5) &
5381  & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) &
5382  & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) &
5383  & + adjcoln2o*absn2o
5384 
5385  fracs(ns09+ig,k) = fracrefb(ig)
5386  enddo
5387  enddo
5388 
5389 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb03::ka_mn2o
real(kind=kind_phys), dimension(ng03, maf03, mmn03), public ka_mn2o
Definition: radlw_datatb.f:3260
module_radlw_kgb09
This module sets up absorption coefficients for band 09: 1180-1390 cm-1 (low - h2o, ch4; high - ch4)
Definition: radlw_datatb.f:25347
module_radlw_kgb01::absb
real(kind=kind_phys), dimension(ng01, msb01), public absb
Definition: radlw_datatb.f:1620
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::fracrefb
real(kind=kind_phys), dimension(ng01), public fracrefb
Definition: radlw_datatb.f:1620
module_radlw_kgb03::kb_mn2o
real(kind=kind_phys), dimension(ng03, mbf03, mmn03), public kb_mn2o
Definition: radlw_datatb.f:3260
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function:

subroutine taumol::taugb10 ( )

Definition at line 5395 of file radlw_main.f.

References module_radlw_kgb10::absa, module_radlw_kgb10::absb, module_radlw_kgb10::forref, module_radlw_kgb10::fracrefa, module_radlw_kgb10::fracrefb, module_radlw_parameters::ng10, module_radlw_parameters::ns10, module_radlw_main::nspa, module_radlw_main::nspb, and module_radlw_kgb10::selfref.

Referenced by module_radlw_main::taumol().

5395 ! ..................................
5396 
5397 ! ------------------------------------------------------------------ !
5398 ! band 10: 1390-1480 cm-1 (low key - h2o; high key - h2o) !
5399 ! ------------------------------------------------------------------ !
5400 
5401  use module_radlw_kgb10
5402 
5403 ! --- locals:
5404  integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, &
5405  & ig
5406 
5407  real (kind=kind_phys) :: tauself, taufor
5408 !
5409 !===> ... begin here
5410 !
5411 ! --- ... lower atmosphere loop
5412 
5413  do k = 1, laytrop
5414  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(10) + 1
5415  ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(10) + 1
5416 
5417  inds = indself(k)
5418  indf = indfor(k)
5419  ind0p = ind0 + 1
5420  ind1p = ind1 + 1
5421  indsp = inds + 1
5422  indfp = indf + 1
5423 
5424  do ig = 1, ng10
5425  tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) &
5426  & * (selfref(ig,indsp) - selfref(ig,inds)))
5427  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
5428  & * (forref(ig,indfp) - forref(ig,indf)))
5429 
5430  taug(ns10+ig,k) = colamt(k,1) &
5431  & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) &
5432  & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) &
5433  & + tauself + taufor
5434 
5435  fracs(ns10+ig,k) = fracrefa(ig)
5436  enddo
5437  enddo
5438 
5439 ! --- ... upper atmosphere loop
5440 
5441  do k = laytrop+1, nlay
5442  ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(10) + 1
5443  ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(10) + 1
5444 
5445  indf = indfor(k)
5446  ind0p = ind0 + 1
5447  ind1p = ind1 + 1
5448  indfp = indf + 1
5449 
5450  do ig = 1, ng10
5451  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
5452  & * (forref(ig,indfp) - forref(ig,indf)))
5453 
5454  taug(ns10+ig,k) = colamt(k,1) &
5455  & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) &
5456  & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) &
5457  & + taufor
5458 
5459  fracs(ns10+ig,k) = fracrefb(ig)
5460  enddo
5461  enddo
5462 
5463 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::absb
real(kind=kind_phys), dimension(ng01, msb01), public absb
Definition: radlw_datatb.f:1620
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb10
This module sets up absorption coefficients for band 10: 1390-1480 cm-1 (low - h2o; high - h2o) ...
Definition: radlw_datatb.f:27987
module_radlw_kgb01::fracrefb
real(kind=kind_phys), dimension(ng01), public fracrefb
Definition: radlw_datatb.f:1620
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function:

subroutine taumol::taugb11 ( )

Definition at line 5469 of file radlw_main.f.

References module_radlw_kgb11::absa, module_radlw_kgb11::absb, module_radlw_kgb11::forref, module_radlw_kgb11::fracrefa, module_radlw_kgb11::fracrefb, module_radlw_kgb11::ka_mo2, module_radlw_kgb11::kb_mo2, module_radlw_parameters::ng11, module_radlw_parameters::ns11, module_radlw_main::nspa, module_radlw_main::nspb, and module_radlw_kgb11::selfref.

Referenced by module_radlw_main::taumol().

5469 ! ..................................
5470 
5471 ! ------------------------------------------------------------------ !
5472 ! band 11: 1480-1800 cm-1 (low - h2o; low minor - o2) !
5473 ! (high key - h2o; high minor - o2) !
5474 ! ------------------------------------------------------------------ !
5475 
5476  use module_radlw_kgb11
5477 
5478 ! --- locals:
5479  integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, &
5480  & indm, indmp, ig
5481 
5482  real (kind=kind_phys) :: scaleo2, tauself, taufor, tauo2
5483 !
5484 !===> ... begin here
5485 !
5486 ! --- ... minor gas mapping level :
5487 ! lower - o2, p = 706.2720 mbar, t = 278.94 k
5488 ! upper - o2, p = 4.758820 mbarm t = 250.85 k
5489 
5490 ! --- ... lower atmosphere loop
5491 
5492  do k = 1, laytrop
5493  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(11) + 1
5494  ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(11) + 1
5495 
5496  inds = indself(k)
5497  indf = indfor(k)
5498  indm = indminor(k)
5499  ind0p = ind0 + 1
5500  ind1p = ind1 + 1
5501  indsp = inds + 1
5502  indfp = indf + 1
5503  indmp = indm + 1
5504 
5505  scaleo2 = colamt(k,6) * scaleminor(k)
5506 
5507  do ig = 1, ng11
5508  tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) &
5509  & * (selfref(ig,indsp) - selfref(ig,inds)))
5510  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
5511  & * (forref(ig,indfp) - forref(ig,indf)))
5512  tauo2 = scaleo2 * (ka_mo2(ig,indm) + minorfrac(k) &
5513  & * (ka_mo2(ig,indmp) - ka_mo2(ig,indm)))
5514 
5515  taug(ns11+ig,k) = colamt(k,1) &
5516  & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) &
5517  & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) &
5518  & + tauself + taufor + tauo2
5519 
5520  fracs(ns11+ig,k) = fracrefa(ig)
5521  enddo
5522  enddo
5523 
5524 ! --- ... upper atmosphere loop
5525 
5526  do k = laytrop+1, nlay
5527  ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(11) + 1
5528  ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(11) + 1
5529 
5530  indf = indfor(k)
5531  indm = indminor(k)
5532  ind0p = ind0 + 1
5533  ind1p = ind1 + 1
5534  indfp = indf + 1
5535  indmp = indm + 1
5536 
5537  scaleo2 = colamt(k,6) * scaleminor(k)
5538 
5539  do ig = 1, ng11
5540  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
5541  & * (forref(ig,indfp) - forref(ig,indf)))
5542  tauo2 = scaleo2 * (kb_mo2(ig,indm) + minorfrac(k) &
5543  & * (kb_mo2(ig,indmp) - kb_mo2(ig,indm)))
5544 
5545  taug(ns11+ig,k) = colamt(k,1) &
5546  & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) &
5547  & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) &
5548  & + taufor + tauo2
5549 
5550  fracs(ns11+ig,k) = fracrefb(ig)
5551  enddo
5552  enddo
5553 
5554 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb11
This module sets up absorption coefficients for band 11: 1480-1800 cm-1 (low - h2o; high - h2o) ...
Definition: radlw_datatb.f:28445
module_radlw_kgb01::absb
real(kind=kind_phys), dimension(ng01, msb01), public absb
Definition: radlw_datatb.f:1620
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb11::ka_mo2
real(kind=kind_phys), dimension(ng11, mmo11), public ka_mo2
Definition: radlw_datatb.f:28458
module_radlw_kgb01::fracrefb
real(kind=kind_phys), dimension(ng01), public fracrefb
Definition: radlw_datatb.f:1620
module_radlw_kgb11::kb_mo2
real(kind=kind_phys), dimension(ng11, mmo11), public kb_mo2
Definition: radlw_datatb.f:28458
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function:

subroutine taumol::taugb12 ( )

Definition at line 5560 of file radlw_main.f.

References module_radlw_kgb12::absa, module_radlw_ref::chi_mls, module_radlw_main::f_one, module_radlw_main::f_zero, module_radlw_kgb12::forref, module_radlw_kgb12::fracrefa, module_radlw_parameters::ng12, module_radlw_parameters::ns12, module_radlw_main::nspa, module_radlw_main::oneminus, and module_radlw_kgb12::selfref.

Referenced by module_radlw_main::taumol().

5560 ! ..................................
5561 
5562 ! ------------------------------------------------------------------ !
5563 ! band 12: 1800-2080 cm-1 (low - h2o,co2; high - nothing) !
5564 ! ------------------------------------------------------------------ !
5565 
5566  use module_radlw_kgb12
5567 
5568 ! --- locals:
5569  integer :: k, ind0, ind1, inds, indsp, indf, indfp, jpl, jplp, &
5570  & id000, id010, id100, id110, id200, id210, ig, js, js1, &
5571  & id001, id011, id101, id111, id201, id211
5572 
5573  real (kind=kind_phys) :: tauself, taufor, refrat_planck_a, &
5574  & speccomb, specparm, specmult, fs, &
5575  & speccomb1, specparm1, specmult1, fs1, &
5576  & speccomb_planck,specparm_planck,specmult_planck,fpl, &
5577  & fac000, fac100, fac200, fac010, fac110, fac210, &
5578  & fac001, fac101, fac201, fac011, fac111, fac211, &
5579  & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21
5580 !
5581 !===> ... begin here
5582 !
5583 ! --- ... calculate reference ratio to be used in calculation of Planck
5584 ! fraction in lower/upper atmosphere.
5585 
5586  refrat_planck_a = chi_mls(1,10)/chi_mls(2,10) ! P = 174.164 mb
5587 
5588 ! --- ... lower atmosphere loop
5589 
5590  do k = 1, laytrop
5591  speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2)
5592  specparm = colamt(k,1) / speccomb
5593  specmult = 8.0 * min(specparm, oneminus)
5594  js = 1 + int(specmult)
5595  fs = mod(specmult, f_one)
5596  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(12) + js
5597 
5598  speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2)
5599  specparm1 = colamt(k,1) / speccomb1
5600  specmult1 = 8.0 * min(specparm1, oneminus)
5601  js1 = 1 + int(specmult1)
5602  fs1 = mod(specmult1, f_one)
5603  ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(12) + js1
5604 
5605  speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,2)
5606  specparm_planck = colamt(k,1) / speccomb_planck
5607  if (specparm_planck >= oneminus) specparm_planck=oneminus
5608  specmult_planck = 8.0 * specparm_planck
5609  jpl = 1 + int(specmult_planck)
5610  fpl = mod(specmult_planck, f_one)
5611 
5612  inds = indself(k)
5613  indf = indfor(k)
5614  indsp = inds + 1
5615  indfp = indf + 1
5616  jplp = jpl + 1
5617 
5618  if (specparm < 0.125 .and. specparm1 < 0.125) then
5619  p0 = fs - f_one
5620  p40 = p0**4
5621  fk00 = p40
5622  fk10 = f_one - p0 - 2.0*p40
5623  fk20 = p0 + p40
5624 
5625  p1 = fs1 - f_one
5626  p41 = p1**4
5627  fk01 = p41
5628  fk11 = f_one - p1 - 2.0*p41
5629  fk21 = p1 + p41
5630 
5631  id000 = ind0
5632  id010 = ind0 + 9
5633  id100 = ind0 + 1
5634  id110 = ind0 +10
5635  id200 = ind0 + 2
5636  id210 = ind0 +11
5637 
5638  id001 = ind1
5639  id011 = ind1 + 9
5640  id101 = ind1 + 1
5641  id111 = ind1 +10
5642  id201 = ind1 + 2
5643  id211 = ind1 +11
5644  elseif (specparm > 0.875 .and. specparm1 > 0.875) then
5645  p0 = -fs
5646  p40 = p0**4
5647  fk00 = p40
5648  fk10 = f_one - p0 - 2.0*p40
5649  fk20 = p0 + p40
5650 
5651  p1 = -fs1
5652  p41 = p1**4
5653  fk01 = p41
5654  fk11 = f_one - p1 - 2.0*p41
5655  fk21 = p1 + p41
5656 
5657  id000 = ind0 + 1
5658  id010 = ind0 +10
5659  id100 = ind0
5660  id110 = ind0 + 9
5661  id200 = ind0 - 1
5662  id210 = ind0 + 8
5663 
5664  id001 = ind1 + 1
5665  id011 = ind1 +10
5666  id101 = ind1
5667  id111 = ind1 + 9
5668  id201 = ind1 - 1
5669  id211 = ind1 + 8
5670  else
5671  fk00 = f_one - fs
5672  fk10 = fs
5673  fk20 = f_zero
5674 
5675  fk01 = f_one - fs1
5676  fk11 = fs1
5677  fk21 = f_zero
5678 
5679  id000 = ind0
5680  id010 = ind0 + 9
5681  id100 = ind0 + 1
5682  id110 = ind0 +10
5683  id200 = ind0
5684  id210 = ind0
5685 
5686  id001 = ind1
5687  id011 = ind1 + 9
5688  id101 = ind1 + 1
5689  id111 = ind1 +10
5690  id201 = ind1
5691  id211 = ind1
5692  endif
5693 
5694  fac000 = fk00 * fac00(k)
5695  fac100 = fk10 * fac00(k)
5696  fac200 = fk20 * fac00(k)
5697  fac010 = fk00 * fac10(k)
5698  fac110 = fk10 * fac10(k)
5699  fac210 = fk20 * fac10(k)
5700 
5701  fac001 = fk01 * fac01(k)
5702  fac101 = fk11 * fac01(k)
5703  fac201 = fk21 * fac01(k)
5704  fac011 = fk01 * fac11(k)
5705  fac111 = fk11 * fac11(k)
5706  fac211 = fk21 * fac11(k)
5707 
5708  do ig = 1, ng12
5709  tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) &
5710  & * (selfref(ig,indsp) - selfref(ig,inds)))
5711  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
5712  & * (forref(ig,indfp) - forref(ig,indf)))
5713 
5714  taug(ns12+ig,k) = speccomb &
5715  & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) &
5716  & + fac100*absa(ig,id100) + fac110*absa(ig,id110) &
5717  & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) &
5718  & + speccomb1 &
5719  & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) &
5720  & + fac101*absa(ig,id101) + fac111*absa(ig,id111) &
5721  & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) &
5722  & + tauself + taufor
5723 
5724  fracs(ns12+ig,k) = fracrefa(ig,jpl) + fpl &
5725  & *(fracrefa(ig,jplp) - fracrefa(ig,jpl))
5726  enddo
5727  enddo
5728 
5729 ! --- ... upper atmosphere loop
5730 
5731  do k = laytrop+1, nlay
5732  do ig = 1, ng12
5733  taug(ns12+ig,k) = f_zero
5734  fracs(ns12+ig,k) = f_zero
5735  enddo
5736  enddo
5737 
5738 ! ..................................
module_radlw_kgb12
This module sets up absorption coefficients for band 12: 1800-2080 cm-1 (low - h2o, co2; high - /)
Definition: radlw_datatb.f:29113
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function:

subroutine taumol::taugb13 ( )

Definition at line 5744 of file radlw_main.f.

References module_radlw_kgb13::absa, module_radlw_ref::chi_mls, module_radlw_main::f_one, module_radlw_main::f_zero, module_radlw_kgb13::forref, module_radlw_kgb13::fracrefa, module_radlw_kgb13::fracrefb, module_radlw_kgb13::ka_mco, module_radlw_kgb13::ka_mco2, module_radlw_kgb13::kb_mo3, module_radlw_parameters::ng13, module_radlw_parameters::ns13, module_radlw_main::nspa, module_radlw_main::oneminus, and module_radlw_kgb13::selfref.

Referenced by module_radlw_main::taumol().

5744 ! ..................................
5745 
5746 ! ------------------------------------------------------------------ !
5747 ! band 13: 2080-2250 cm-1 (low key-h2o,n2o; high minor-o3 minor) !
5748 ! ------------------------------------------------------------------ !
5749 
5750  use module_radlw_kgb13
5751 
5752 ! --- locals:
5753  integer :: k, ind0, ind1, inds, indsp, indf, indfp, indm, indmp, &
5754  & id000, id010, id100, id110, id200, id210, jmco2, jpl, &
5755  & id001, id011, id101, id111, id201, id211, jmco2p, jplp, &
5756  & jmco, jmcop, ig, js, js1
5757 
5758  real (kind=kind_phys) :: tauself, taufor, co2m1, co2m2, absco2, &
5759  & speccomb, specparm, specmult, fs, &
5760  & speccomb1, specparm1, specmult1, fs1, &
5761  & speccomb_mco2, specparm_mco2, specmult_mco2, fmco2, &
5762  & speccomb_mco, specparm_mco, specmult_mco, fmco, &
5763  & speccomb_planck,specparm_planck,specmult_planck,fpl, &
5764  & refrat_planck_a, refrat_m_a, refrat_m_a3, ratco2, &
5765  & adjfac, adjcolco2, com1, com2, absco, abso3, &
5766  & fac000, fac100, fac200, fac010, fac110, fac210, &
5767  & fac001, fac101, fac201, fac011, fac111, fac211, &
5768  & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21, temp
5769 !
5770 !===> ... begin here
5771 !
5772 ! --- ... minor gas mapping levels :
5773 ! lower - co2, p = 1053.63 mb, t = 294.2 k
5774 ! lower - co, p = 706 mb, t = 278.94 k
5775 ! upper - o3, p = 95.5835 mb, t = 215.7 k
5776 
5777 ! --- ... calculate reference ratio to be used in calculation of Planck
5778 ! fraction in lower/upper atmosphere.
5779 
5780  refrat_planck_a = chi_mls(1,5)/chi_mls(4,5) ! P = 473.420 mb (Level 5)
5781  refrat_m_a = chi_mls(1,1)/chi_mls(4,1) ! P = 1053. (Level 1)
5782  refrat_m_a3 = chi_mls(1,3)/chi_mls(4,3) ! P = 706. (Level 3)
5783 
5784 ! --- ... lower atmosphere loop
5785 
5786  do k = 1, laytrop
5787  speccomb = colamt(k,1) + rfrate(k,3,1)*colamt(k,4)
5788  specparm = colamt(k,1) / speccomb
5789  specmult = 8.0 * min(specparm, oneminus)
5790  js = 1 + int(specmult)
5791  fs = mod(specmult, f_one)
5792  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(13) + js
5793 
5794  speccomb1 = colamt(k,1) + rfrate(k,3,2)*colamt(k,4)
5795  specparm1 = colamt(k,1) / speccomb1
5796  specmult1 = 8.0 * min(specparm1, oneminus)
5797  js1 = 1 + int(specmult1)
5798  fs1 = mod(specmult1, f_one)
5799  ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(13) + js1
5800 
5801  speccomb_mco2 = colamt(k,1) + refrat_m_a*colamt(k,4)
5802  specparm_mco2 = colamt(k,1) / speccomb_mco2
5803  specmult_mco2 = 8.0 * min(specparm_mco2, oneminus)
5804  jmco2 = 1 + int(specmult_mco2)
5805  fmco2 = mod(specmult_mco2, f_one)
5806 
5807 ! --- ... in atmospheres where the amount of co2 is too great to be considered
5808 ! a minor species, adjust the column amount of co2 by an empirical factor
5809 ! to obtain the proper contribution.
5810 
5811  speccomb_mco = colamt(k,1) + refrat_m_a3*colamt(k,4)
5812  specparm_mco = colamt(k,1) / speccomb_mco
5813  specmult_mco = 8.0 * min(specparm_mco, oneminus)
5814  jmco = 1 + int(specmult_mco)
5815  fmco = mod(specmult_mco, f_one)
5816 
5817  speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,4)
5818  specparm_planck = colamt(k,1) / speccomb_planck
5819  specmult_planck = 8.0 * min(specparm_planck, oneminus)
5820  jpl = 1 + int(specmult_planck)
5821  fpl = mod(specmult_planck, f_one)
5822 
5823  inds = indself(k)
5824  indf = indfor(k)
5825  indm = indminor(k)
5826  indsp = inds + 1
5827  indfp = indf + 1
5828  indmp = indm + 1
5829  jplp = jpl + 1
5830  jmco2p= jmco2+ 1
5831  jmcop = jmco + 1
5832 
5833 ! --- ... in atmospheres where the amount of co2 is too great to be considered
5834 ! a minor species, adjust the column amount of co2 by an empirical factor
5835 ! to obtain the proper contribution.
5836 
5837  temp = coldry(k) * 3.55e-4
5838  ratco2 = colamt(k,2) / temp
5839  if (ratco2 > 3.0) then
5840  adjfac = 2.0 + (ratco2-2.0)**0.68
5841  adjcolco2 = adjfac * temp
5842  else
5843  adjcolco2 = colamt(k,2)
5844  endif
5845 
5846  if (specparm < 0.125 .and. specparm1 < 0.125) then
5847  p0 = fs - f_one
5848  p40 = p0**4
5849  fk00 = p40
5850  fk10 = f_one - p0 - 2.0*p40
5851  fk20 = p0 + p40
5852 
5853  p1 = fs1 - f_one
5854  p41 = p1**4
5855  fk01 = p41
5856  fk11 = f_one - p1 - 2.0*p41
5857  fk21 = p1 + p41
5858 
5859  id000 = ind0
5860  id010 = ind0 + 9
5861  id100 = ind0 + 1
5862  id110 = ind0 +10
5863  id200 = ind0 + 2
5864  id210 = ind0 +11
5865 
5866  id001 = ind1
5867  id011 = ind1 + 9
5868  id101 = ind1 + 1
5869  id111 = ind1 +10
5870  id201 = ind1 + 2
5871  id211 = ind1 +11
5872  elseif (specparm > 0.875 .and. specparm1 > 0.875) then
5873  p0 = -fs
5874  p40 = p0**4
5875  fk00 = p40
5876  fk10 = f_one - p0 - 2.0*p40
5877  fk20 = p0 + p40
5878 
5879  p1 = -fs1
5880  p41 = p1**4
5881  fk01 = p41
5882  fk11 = f_one - p1 - 2.0*p41
5883  fk21 = p1 + p41
5884 
5885  id000 = ind0 + 1
5886  id010 = ind0 +10
5887  id100 = ind0
5888  id110 = ind0 + 9
5889  id200 = ind0 - 1
5890  id210 = ind0 + 8
5891 
5892  id001 = ind1 + 1
5893  id011 = ind1 +10
5894  id101 = ind1
5895  id111 = ind1 + 9
5896  id201 = ind1 - 1
5897  id211 = ind1 + 8
5898  else
5899  fk00 = f_one - fs
5900  fk10 = fs
5901  fk20 = f_zero
5902 
5903  fk01 = f_one - fs1
5904  fk11 = fs1
5905  fk21 = f_zero
5906 
5907  id000 = ind0
5908  id010 = ind0 + 9
5909  id100 = ind0 + 1
5910  id110 = ind0 +10
5911  id200 = ind0
5912  id210 = ind0
5913 
5914  id001 = ind1
5915  id011 = ind1 + 9
5916  id101 = ind1 + 1
5917  id111 = ind1 +10
5918  id201 = ind1
5919  id211 = ind1
5920  endif
5921 
5922  fac000 = fk00 * fac00(k)
5923  fac100 = fk10 * fac00(k)
5924  fac200 = fk20 * fac00(k)
5925  fac010 = fk00 * fac10(k)
5926  fac110 = fk10 * fac10(k)
5927  fac210 = fk20 * fac10(k)
5928 
5929  fac001 = fk01 * fac01(k)
5930  fac101 = fk11 * fac01(k)
5931  fac201 = fk21 * fac01(k)
5932  fac011 = fk01 * fac11(k)
5933  fac111 = fk11 * fac11(k)
5934  fac211 = fk21 * fac11(k)
5935 
5936  do ig = 1, ng13
5937  tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) &
5938  & * (selfref(ig,indsp) - selfref(ig,inds)))
5939  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
5940  & * (forref(ig,indfp) - forref(ig,indf)))
5941  co2m1 = ka_mco2(ig,jmco2,indm) + fmco2 &
5942  & * (ka_mco2(ig,jmco2p,indm) - ka_mco2(ig,jmco2,indm))
5943  co2m2 = ka_mco2(ig,jmco2,indmp) + fmco2 &
5944  & * (ka_mco2(ig,jmco2p,indmp) - ka_mco2(ig,jmco2,indmp))
5945  absco2 = co2m1 + minorfrac(k) * (co2m2 - co2m1)
5946  com1 = ka_mco(ig,jmco,indm) + fmco &
5947  & * (ka_mco(ig,jmcop,indm) - ka_mco(ig,jmco,indm))
5948  com2 = ka_mco(ig,jmco,indmp) + fmco &
5949  & * (ka_mco(ig,jmcop,indmp) - ka_mco(ig,jmco,indmp))
5950  absco = com1 + minorfrac(k) * (com2 - com1)
5951 
5952  taug(ns13+ig,k) = speccomb &
5953  & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) &
5954  & + fac100*absa(ig,id100) + fac110*absa(ig,id110) &
5955  & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) &
5956  & + speccomb1 &
5957  & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) &
5958  & + fac101*absa(ig,id101) + fac111*absa(ig,id111) &
5959  & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) &
5960  & + tauself + taufor + adjcolco2*absco2 &
5961  & + colamt(k,7)*absco
5962 
5963  fracs(ns13+ig,k) = fracrefa(ig,jpl) + fpl &
5964  & * (fracrefa(ig,jplp) - fracrefa(ig,jpl))
5965  enddo
5966  enddo
5967 
5968 ! --- ... upper atmosphere loop
5969 
5970  do k = laytrop+1, nlay
5971  indm = indminor(k)
5972  indmp = indm + 1
5973 
5974  do ig = 1, ng13
5975  abso3 = kb_mo3(ig,indm) + minorfrac(k) &
5976  & * (kb_mo3(ig,indmp) - kb_mo3(ig,indm))
5977 
5978  taug(ns13+ig,k) = colamt(k,3)*abso3
5979 
5980  fracs(ns13+ig,k) = fracrefb(ig)
5981  enddo
5982  enddo
5983 
5984 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb13::kb_mo3
real(kind=kind_phys), dimension(ng13, mmo13), public kb_mo3
Definition: radlw_datatb.f:30180
module_radlw_kgb01::fracrefb
real(kind=kind_phys), dimension(ng01), public fracrefb
Definition: radlw_datatb.f:1620
module_radlw_kgb13
This module sets up absorption coefficients for band 13: 2080-2250 cm-1 (low - h2o, n2o; high - /)
Definition: radlw_datatb.f:30167
module_radlw_kgb06::ka_mco2
real(kind=kind_phys), dimension(ng06, mmc06), public ka_mco2
Definition: radlw_datatb.f:21712
module_radlw_kgb13::ka_mco
real(kind=kind_phys), dimension(ng13, maf13, mmo13), public ka_mco
Definition: radlw_datatb.f:30180
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function:

subroutine taumol::taugb14 ( )

Definition at line 5990 of file radlw_main.f.

References module_radlw_kgb14::absa, module_radlw_kgb14::absb, module_radlw_kgb14::forref, module_radlw_kgb14::fracrefa, module_radlw_kgb14::fracrefb, module_radlw_parameters::ng14, module_radlw_parameters::ns14, module_radlw_main::nspa, module_radlw_main::nspb, and module_radlw_kgb14::selfref.

Referenced by module_radlw_main::taumol().

5990 ! ..................................
5991 
5992 ! ------------------------------------------------------------------ !
5993 ! band 14: 2250-2380 cm-1 (low - co2; high - co2) !
5994 ! ------------------------------------------------------------------ !
5995 
5996  use module_radlw_kgb14
5997 
5998 ! --- locals:
5999  integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, &
6000  & ig
6001 
6002  real (kind=kind_phys) :: tauself, taufor
6003 !
6004 !===> ... begin here
6005 !
6006 ! --- ... lower atmosphere loop
6007 
6008  do k = 1, laytrop
6009  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(14) + 1
6010  ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(14) + 1
6011 
6012  inds = indself(k)
6013  indf = indfor(k)
6014  ind0p = ind0 + 1
6015  ind1p = ind1 + 1
6016  indsp = inds + 1
6017  indfp = indf + 1
6018 
6019  do ig = 1, ng14
6020  tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) &
6021  & * (selfref(ig,indsp) - selfref(ig,inds)))
6022  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
6023  & * (forref(ig,indfp) - forref(ig,indf)))
6024 
6025  taug(ns14+ig,k) = colamt(k,2) &
6026  & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) &
6027  & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) &
6028  & + tauself + taufor
6029 
6030  fracs(ns14+ig,k) = fracrefa(ig)
6031  enddo
6032  enddo
6033 
6034 ! --- ... upper atmosphere loop
6035 
6036  do k = laytrop+1, nlay
6037  ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(14) + 1
6038  ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(14) + 1
6039 
6040  ind0p = ind0 + 1
6041  ind1p = ind1 + 1
6042 
6043  do ig = 1, ng14
6044  taug(ns14+ig,k) = colamt(k,2) &
6045  & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) &
6046  & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p))
6047 
6048  fracs(ns14+ig,k) = fracrefb(ig)
6049  enddo
6050  enddo
6051 
6052 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::absb
real(kind=kind_phys), dimension(ng01, msb01), public absb
Definition: radlw_datatb.f:1620
module_radlw_kgb14
This module sets up absorption coefficients for band 14: 2250-2380 cm-1 (low - co2; high - co2) ...
Definition: radlw_datatb.f:31044
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::fracrefb
real(kind=kind_phys), dimension(ng01), public fracrefb
Definition: radlw_datatb.f:1620
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function:

subroutine taumol::taugb15 ( )

Definition at line 6058 of file radlw_main.f.

References module_radlw_kgb15::absa, module_radlw_ref::chi_mls, module_radlw_main::f_one, module_radlw_main::f_zero, module_radlw_kgb15::forref, module_radlw_kgb15::fracrefa, module_radlw_kgb15::ka_mn2, module_radlw_parameters::ng15, module_radlw_parameters::ns15, module_radlw_main::nspa, module_radlw_main::oneminus, and module_radlw_kgb15::selfref.

Referenced by module_radlw_main::taumol().

6058 ! ..................................
6059 
6060 ! ------------------------------------------------------------------ !
6061 ! band 15: 2380-2600 cm-1 (low - n2o,co2; low minor - n2) !
6062 ! (high - nothing) !
6063 ! ------------------------------------------------------------------ !
6064 
6065  use module_radlw_kgb15
6066 
6067 ! --- locals:
6068  integer :: k, ind0, ind1, inds, indsp, indf, indfp, indm, indmp, &
6069  & id000, id010, id100, id110, id200, id210, jpl, jplp, &
6070  & id001, id011, id101, id111, id201, id211, jmn2, jmn2p, &
6071  & ig, js, js1
6072 
6073  real (kind=kind_phys) :: scalen2, tauself, taufor, &
6074  & speccomb, specparm, specmult, fs, &
6075  & speccomb1, specparm1, specmult1, fs1, &
6076  & speccomb_mn2, specparm_mn2, specmult_mn2, fmn2, &
6077  & speccomb_planck,specparm_planck,specmult_planck,fpl, &
6078  & refrat_planck_a, refrat_m_a, n2m1, n2m2, taun2, &
6079  & fac000, fac100, fac200, fac010, fac110, fac210, &
6080  & fac001, fac101, fac201, fac011, fac111, fac211, &
6081  & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21
6082 !
6083 !===> ... begin here
6084 !
6085 ! --- ... minor gas mapping level :
6086 ! lower - nitrogen continuum, P = 1053., T = 294.
6087 
6088 ! --- ... calculate reference ratio to be used in calculation of Planck
6089 ! fraction in lower atmosphere.
6090 
6091  refrat_planck_a = chi_mls(4,1)/chi_mls(2,1) ! P = 1053. mb (Level 1)
6092  refrat_m_a = chi_mls(4,1)/chi_mls(2,1) ! P = 1053. mb
6093 
6094 ! --- ... lower atmosphere loop
6095 
6096  do k = 1, laytrop
6097  speccomb = colamt(k,4) + rfrate(k,5,1)*colamt(k,2)
6098  specparm = colamt(k,4) / speccomb
6099  specmult = 8.0 * min(specparm, oneminus)
6100  js = 1 + int(specmult)
6101  fs = mod(specmult, f_one)
6102  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(15) + js
6103 
6104  speccomb1 = colamt(k,4) + rfrate(k,5,2)*colamt(k,2)
6105  specparm1 = colamt(k,4) / speccomb1
6106  specmult1 = 8.0 * min(specparm1, oneminus)
6107  js1 = 1 + int(specmult1)
6108  fs1 = mod(specmult1, f_one)
6109  ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(15) + js1
6110 
6111  speccomb_mn2 = colamt(k,4) + refrat_m_a*colamt(k,2)
6112  specparm_mn2 = colamt(k,4) / speccomb_mn2
6113  specmult_mn2 = 8.0 * min(specparm_mn2, oneminus)
6114  jmn2 = 1 + int(specmult_mn2)
6115  fmn2 = mod(specmult_mn2, f_one)
6116 
6117  speccomb_planck = colamt(k,4) + refrat_planck_a*colamt(k,2)
6118  specparm_planck = colamt(k,4) / speccomb_planck
6119  specmult_planck = 8.0 * min(specparm_planck, oneminus)
6120  jpl = 1 + int(specmult_planck)
6121  fpl = mod(specmult_planck, f_one)
6122 
6123  scalen2 = colbrd(k) * scaleminor(k)
6124 
6125  inds = indself(k)
6126  indf = indfor(k)
6127  indm = indminor(k)
6128  indsp = inds + 1
6129  indfp = indf + 1
6130  indmp = indm + 1
6131  jplp = jpl + 1
6132  jmn2p = jmn2 + 1
6133 
6134  if (specparm < 0.125 .and. specparm1 < 0.125) then
6135  p0 = fs - f_one
6136  p40 = p0**4
6137  fk00 = p40
6138  fk10 = f_one - p0 - 2.0*p40
6139  fk20 = p0 + p40
6140 
6141  p1 = fs1 - f_one
6142  p41 = p1**4
6143  fk01 = p41
6144  fk11 = f_one - p1 - 2.0*p41
6145  fk21 = p1 + p41
6146 
6147  id000 = ind0
6148  id010 = ind0 + 9
6149  id100 = ind0 + 1
6150  id110 = ind0 +10
6151  id200 = ind0 + 2
6152  id210 = ind0 +11
6153 
6154  id001 = ind1
6155  id011 = ind1 + 9
6156  id101 = ind1 + 1
6157  id111 = ind1 +10
6158  id201 = ind1 + 2
6159  id211 = ind1 +11
6160  elseif (specparm > 0.875 .and. specparm1 > 0.875) then
6161  p0 = -fs
6162  p40 = p0**4
6163  fk00 = p40
6164  fk10 = f_one - p0 - 2.0*p40
6165  fk20 = p0 + p40
6166 
6167  p1 = -fs1
6168  p41 = p1**4
6169  fk01 = p41
6170  fk11 = f_one - p1 - 2.0*p41
6171  fk21 = p1 + p41
6172 
6173  id000 = ind0 + 1
6174  id010 = ind0 +10
6175  id100 = ind0
6176  id110 = ind0 + 9
6177  id200 = ind0 - 1
6178  id210 = ind0 + 8
6179 
6180  id001 = ind1 + 1
6181  id011 = ind1 +10
6182  id101 = ind1
6183  id111 = ind1 + 9
6184  id201 = ind1 - 1
6185  id211 = ind1 + 8
6186  else
6187  fk00 = f_one - fs
6188  fk10 = fs
6189  fk20 = f_zero
6190 
6191  fk01 = f_one - fs1
6192  fk11 = fs1
6193  fk21 = f_zero
6194 
6195  id000 = ind0
6196  id010 = ind0 + 9
6197  id100 = ind0 + 1
6198  id110 = ind0 +10
6199  id200 = ind0
6200  id210 = ind0
6201 
6202  id001 = ind1
6203  id011 = ind1 + 9
6204  id101 = ind1 + 1
6205  id111 = ind1 +10
6206  id201 = ind1
6207  id211 = ind1
6208  endif
6209 
6210  fac000 = fk00 * fac00(k)
6211  fac100 = fk10 * fac00(k)
6212  fac200 = fk20 * fac00(k)
6213  fac010 = fk00 * fac10(k)
6214  fac110 = fk10 * fac10(k)
6215  fac210 = fk20 * fac10(k)
6216 
6217  fac001 = fk01 * fac01(k)
6218  fac101 = fk11 * fac01(k)
6219  fac201 = fk21 * fac01(k)
6220  fac011 = fk01 * fac11(k)
6221  fac111 = fk11 * fac11(k)
6222  fac211 = fk21 * fac11(k)
6223 
6224  do ig = 1, ng15
6225  tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) &
6226  & * (selfref(ig,indsp) - selfref(ig,inds)))
6227  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
6228  & * (forref(ig,indfp) - forref(ig,indf)))
6229  n2m1 = ka_mn2(ig,jmn2,indm) + fmn2 &
6230  & * (ka_mn2(ig,jmn2p,indm) - ka_mn2(ig,jmn2,indm))
6231  n2m2 = ka_mn2(ig,jmn2,indmp) + fmn2 &
6232  & * (ka_mn2(ig,jmn2p,indmp) - ka_mn2(ig,jmn2,indmp))
6233  taun2 = scalen2 * (n2m1 + minorfrac(k) * (n2m2 - n2m1))
6234 
6235  taug(ns15+ig,k) = speccomb &
6236  & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) &
6237  & + fac100*absa(ig,id100) + fac110*absa(ig,id110) &
6238  & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) &
6239  & + speccomb1 &
6240  & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) &
6241  & + fac101*absa(ig,id101) + fac111*absa(ig,id111) &
6242  & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) &
6243  & + tauself + taufor + taun2
6244 
6245  fracs(ns15+ig,k) = fracrefa(ig,jpl) + fpl &
6246  & * (fracrefa(ig,jplp) - fracrefa(ig,jpl))
6247  enddo
6248  enddo
6249 
6250 ! --- ... upper atmosphere loop
6251 
6252  do k = laytrop+1, nlay
6253  do ig = 1, ng15
6254  taug(ns15+ig,k) = f_zero
6255 
6256  fracs(ns15+ig,k) = f_zero
6257  enddo
6258  enddo
6259 
6260 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
module_radlw_kgb15
This module sets up absorption coefficients for band 15: 2380-2600 cm-1 (low - n2o, co2; high - /)
Definition: radlw_datatb.f:31244
module_radlw_kgb01::ka_mn2
real(kind=kind_phys), dimension(ng01, mmn01), public ka_mn2
Definition: radlw_datatb.f:1620
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function:

subroutine taumol::taugb16 ( )

Definition at line 6266 of file radlw_main.f.

References module_radlw_kgb16::absa, module_radlw_kgb16::absb, module_radlw_ref::chi_mls, module_radlw_main::f_one, module_radlw_main::f_zero, module_radlw_kgb16::forref, module_radlw_kgb16::fracrefa, module_radlw_kgb16::fracrefb, module_radlw_parameters::ng16, module_radlw_parameters::ns16, module_radlw_main::nspa, module_radlw_main::nspb, module_radlw_main::oneminus, and module_radlw_kgb16::selfref.

Referenced by module_radlw_main::taumol().

6266 ! ..................................
6267 
6268 ! ------------------------------------------------------------------ !
6269 ! band 16: 2600-3250 cm-1 (low key- h2o,ch4; high key - ch4) !
6270 ! ------------------------------------------------------------------ !
6271 
6272  use module_radlw_kgb16
6273 
6274 ! --- locals:
6275  integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, &
6276  & id000, id010, id100, id110, id200, id210, jpl, jplp, &
6277  & id001, id011, id101, id111, id201, id211, ig, js, js1
6278 
6279  real (kind=kind_phys) :: tauself, taufor, refrat_planck_a, &
6280  & speccomb, specparm, specmult, fs, &
6281  & speccomb1, specparm1, specmult1, fs1, &
6282  & speccomb_planck,specparm_planck,specmult_planck,fpl, &
6283  & fac000, fac100, fac200, fac010, fac110, fac210, &
6284  & fac001, fac101, fac201, fac011, fac111, fac211, &
6285  & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21
6286 !
6287 !===> ... begin here
6288 !
6289 ! --- ... calculate reference ratio to be used in calculation of Planck
6290 ! fraction in lower atmosphere.
6291 
6292  refrat_planck_a = chi_mls(1,6)/chi_mls(6,6) ! P = 387. mb (Level 6)
6293 
6294 ! --- ... lower atmosphere loop
6295 
6296  do k = 1, laytrop
6297  speccomb = colamt(k,1) + rfrate(k,4,1)*colamt(k,5)
6298  specparm = colamt(k,1) / speccomb
6299  specmult = 8.0 * min(specparm, oneminus)
6300  js = 1 + int(specmult)
6301  fs = mod(specmult, f_one)
6302  ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(16) + js
6303 
6304  speccomb1 = colamt(k,1) + rfrate(k,4,2)*colamt(k,5)
6305  specparm1 = colamt(k,1) / speccomb1
6306  specmult1 = 8.0 * min(specparm1, oneminus)
6307  js1 = 1 + int(specmult1)
6308  fs1 = mod(specmult1, f_one)
6309  ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(16) + js1
6310 
6311  speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,5)
6312  specparm_planck = colamt(k,1) / speccomb_planck
6313  specmult_planck = 8.0 * min(specparm_planck, oneminus)
6314  jpl = 1 + int(specmult_planck)
6315  fpl = mod(specmult_planck, f_one)
6316 
6317  inds = indself(k)
6318  indf = indfor(k)
6319  indsp = inds + 1
6320  indfp = indf + 1
6321  jplp = jpl + 1
6322 
6323  if (specparm < 0.125 .and. specparm1 < 0.125) then
6324  p0 = fs - f_one
6325  p40 = p0**4
6326  fk00 = p40
6327  fk10 = f_one - p0 - 2.0*p40
6328  fk20 = p0 + p40
6329 
6330  p1 = fs1 - f_one
6331  p41 = p1**4
6332  fk01 = p41
6333  fk11 = f_one - p1 - 2.0*p41
6334  fk21 = p1 + p41
6335 
6336  id000 = ind0
6337  id010 = ind0 + 9
6338  id100 = ind0 + 1
6339  id110 = ind0 +10
6340  id200 = ind0 + 2
6341  id210 = ind0 +11
6342 
6343  id001 = ind1
6344  id011 = ind1 + 9
6345  id101 = ind1 + 1
6346  id111 = ind1 +10
6347  id201 = ind1 + 2
6348  id211 = ind1 +11
6349  elseif (specparm > 0.875 .and. specparm1 > 0.875) then
6350  p0 = -fs
6351  p40 = p0**4
6352  fk00 = p40
6353  fk10 = f_one - p0 - 2.0*p40
6354  fk20 = p0 + p40
6355 
6356  p1 = -fs1
6357  p41 = p1**4
6358  fk01 = p41
6359  fk11 = f_one - p1 - 2.0*p41
6360  fk21 = p1 + p41
6361 
6362  id000 = ind0 + 1
6363  id010 = ind0 +10
6364  id100 = ind0
6365  id110 = ind0 + 9
6366  id200 = ind0 - 1
6367  id210 = ind0 + 8
6368 
6369  id001 = ind1 + 1
6370  id011 = ind1 +10
6371  id101 = ind1
6372  id111 = ind1 + 9
6373  id201 = ind1 - 1
6374  id211 = ind1 + 8
6375  else
6376  fk00 = f_one - fs
6377  fk10 = fs
6378  fk20 = f_zero
6379 
6380  fk01 = f_one - fs1
6381  fk11 = fs1
6382  fk21 = f_zero
6383 
6384  id000 = ind0
6385  id010 = ind0 + 9
6386  id100 = ind0 + 1
6387  id110 = ind0 +10
6388  id200 = ind0
6389  id210 = ind0
6390 
6391  id001 = ind1
6392  id011 = ind1 + 9
6393  id101 = ind1 + 1
6394  id111 = ind1 +10
6395  id201 = ind1
6396  id211 = ind1
6397  endif
6398 
6399  fac000 = fk00 * fac00(k)
6400  fac100 = fk10 * fac00(k)
6401  fac200 = fk20 * fac00(k)
6402  fac010 = fk00 * fac10(k)
6403  fac110 = fk10 * fac10(k)
6404  fac210 = fk20 * fac10(k)
6405 
6406  fac001 = fk01 * fac01(k)
6407  fac101 = fk11 * fac01(k)
6408  fac201 = fk21 * fac01(k)
6409  fac011 = fk01 * fac11(k)
6410  fac111 = fk11 * fac11(k)
6411  fac211 = fk21 * fac11(k)
6412 
6413  do ig = 1, ng16
6414  tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) &
6415  & * (selfref(ig,indsp) - selfref(ig,inds)))
6416  taufor = forfac(k) * (forref(ig,indf) + forfrac(k) &
6417  & * (forref(ig,indfp) - forref(ig,indf)))
6418 
6419  taug(ns16+ig,k) = speccomb &
6420  & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) &
6421  & + fac100*absa(ig,id100) + fac110*absa(ig,id110) &
6422  & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) &
6423  & + speccomb1 &
6424  & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) &
6425  & + fac101*absa(ig,id101) + fac111*absa(ig,id111) &
6426  & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) &
6427  & + tauself + taufor
6428 
6429  fracs(ns16+ig,k) = fracrefa(ig,jpl) + fpl &
6430  & * (fracrefa(ig,jplp) - fracrefa(ig,jpl))
6431  enddo
6432  enddo
6433 
6434 ! --- ... upper atmosphere loop
6435 
6436  do k = laytrop+1, nlay
6437  ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(16) + 1
6438  ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(16) + 1
6439 
6440  ind0p = ind0 + 1
6441  ind1p = ind1 + 1
6442 
6443  do ig = 1, ng16
6444  taug(ns16+ig,k) = colamt(k,5) &
6445  & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) &
6446  & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p))
6447 
6448  fracs(ns16+ig,k) = fracrefb(ig)
6449  enddo
6450  enddo
6451 
6452 ! ..................................
6453  end subroutine taugb16
6454 ! ----------------------------------
6455 
6456 ! ..................................
module_radlw_kgb01::fracrefa
real(kind=kind_phys), dimension(ng01), public fracrefa
Definition: radlw_datatb.f:1620
module_radlw_kgb01::forref
real(kind=kind_phys), dimension(ng01, mfr01), public forref
Definition: radlw_datatb.f:1620
taugb16
subroutine taugb16
Definition: radlw_main.f:6266
module_radlw_kgb01::absb
real(kind=kind_phys), dimension(ng01, msb01), public absb
Definition: radlw_datatb.f:1620
module_radlw_kgb01::selfref
real(kind=kind_phys), dimension(ng01, msf01), public selfref
Definition: radlw_datatb.f:1620
module_radlw_kgb01::fracrefb
real(kind=kind_phys), dimension(ng01), public fracrefb
Definition: radlw_datatb.f:1620
module_radlw_kgb16
This module sets up absorption coefficients for band 16: 2600-3000 cm-1 (low - h2o, ch4; high - /)
Definition: radlw_datatb.f:31635
module_radlw_kgb01::absa
real(kind=kind_phys), dimension(ng01, msa01), public absa
Definition: radlw_datatb.f:1620

Here is the caller graph for this function: