SUBROUTINE table
  !
  ! $Author: CPTEC $
  ! $Date: 2000/02/24 13:15:43 $
  ! $Revision: 1.0 $
  !
  !subroutine table computes table entries used in the longwave radia
  !program. also calculated are indices used in strip-mining and for
  !some pre-computable functions.
  !outputs:
  !       em1,em1wde,table1,table2,table3         tabcom
  !       em3,source,dsrce,ind,indx2,kmaxv        tabcom
  !       kmaxvm,                                 tabcom
  !       ao3rnd,bo3rnd,ab15                      bandta
  !       ab15wd,skc1r,sko3r,sko2d                bdwide
  IMPLICIT NONE
  REAL :: amolwt,csubp,diffctr,g,gravdr,o3difctr,p0,p0xzp2,p0xzp8,p0x2
  REAL :: radcon,rgas,rgassp,secpda,ratco2mw,rath2omw,radcon1,ginv,p0inv,gp0inv
  REAL :: hundred,hninety,sixty,fifty,ten,eight,five,four,three,two,one,haf
  REAL :: quartr,zero,h83e26,h71e26,h1e15,h1e13,h1e11,h1e8,h4e5,h165e5,h5725e4
  REAL :: h488e4,h1e4,h24e3,h20788e3,h2075e3,h1224e3,h5e2,h3082e2,h3e2,h2945e2 
  REAL :: h23e2,h15e2,h35e1,h3p6,h181e1,h18e1,h2p9,h2p8,h2p5,h1p8,h1p4387,h1p4
  REAL :: h1p25892,hp8,hp518, hp369,hp1,h44871m2,h559m3,h1m3,h987m4,h285m4,h1m4
  REAL :: h6938m5,h394m5,h37412m5,h1439m5,h128m5,h1m5,h7m6,h4999m6,h25452m6,h1m6
  REAL :: h391m7,h1174m7,h8725m8,h327m8,h257m8,h1m8,h23m10,h14m10,h11m10,h1m10
  REAL :: h83m11,h82m11,h8m11,h77m11,h72m11,h53m11,h48m11,h44m11,h42m11,h37m11
  REAL :: h35m11,h32m11,h3m11,h28m11,h24m11,h23m11,h2m11,h18m11,h15m11,h14m11
  REAL :: h114m11,h11m11,h1m11,h96m12,h93m12,h77m12,h74m12,h65m12,h62m12,h6m12
  REAL :: h45m12,h44m12,h4m12,h38m12,h37m12,h3m12,h29m12,h28m12,h24m12,h21m12  
  REAL :: h16m12,h14m12,h12m12,h8m13,h46m13,h36m13,h135m13,h12m13,h1m13,h3m14
  REAL :: h15m14,h14m14,h1m17,h1m18,h1m19,h1m20,h1m21,h1m22,h1m23,h1m24,h26m30
  REAL :: h14m30,h25m31,h21m31,h12m31,h9m32,h55m32,h45m32,h4m33,h62m34,h1m60
  REAL :: hmp575,hm13ez,hm19ez,hm1e1,hm181e1,hm1e2,h1e6,h2e6,h1m2,hmp66667
  REAL :: hm6666m2,hp166666,h41666m2,hmp5,hm2m2,h29316e2,h1226e1,h3116e1,h9p94
  REAL :: hp6,h625m2,hp228,hp60241,hm1797e1,h8121e1,h2e2,hm1ez,h26e2,h44194m2
  REAL :: h1p41819,hp219,hp144,hp816,h69766e5,h235m3,hp26,h129m2,h75826m4,h1p082
  REAL :: hp805,h1386e2, h658m2,h1036e2,h2118m2,h42m2,h323m4,h67390e2,hp3795
  REAL :: hp5048,h102m5,h451m6,h16e1,hm161e1,h161e1,h3m3,h101m16,hm1597e1,h25e2
  REAL :: hp118666,h15m5,h3p5,h18e3,h6p08108,hmp805,hp602409,hp526315,h28571m2
  REAL :: h1m16,h3m4,hm8e1,h28e1
  INTEGER :: n,i,i1,i2,i2e,icnt,j,jp,nsb,ia,nsubds
  REAL :: cent,del,bdlo,bdhi,c1,anu 

  COMMON/phycon/amolwt,csubp,diffctr,g,gravdr,o3difctr,p0,  &
       p0xzp2,p0xzp8,p0x2,radcon,rgas,rgassp,secpda
  COMMON/phycon/ratco2mw,rath2omw
  COMMON/phycon/radcon1
  COMMON/phycon/ginv,p0inv,gp0inv
  COMMON/hcon/hundred,hninety,sixty,fifty,ten,eight,five,  &
       four,three,two,one,haf,quartr,zero
  COMMON/hcon/h83e26,h71e26,h1e15,h1e13,h1e11,h1e8,h4e5,  &
       h165e5,h5725e4,h488e4,h1e4,h24e3,h20788e3,  &
       h2075e3,h1224e3,h5e2,h3082e2,h3e2,h2945e2,  &
       h23e2,h15e2,h35e1,h3p6,h181e1,h18e1,h2p9,h2p8,  &
       h2p5,h1p8,h1p4387,h1p4,h1p25892,hp8,hp518, hp369,hp1
  COMMON/hcon/h44871m2,h559m3,h1m3,h987m4,h285m4,h1m4,  &
       h6938m5,h394m5,h37412m5,h1439m5,h128m5,h1m5,  &
       h7m6,h4999m6,h25452m6,h1m6,h391m7,h1174m7,  &
       h8725m8,h327m8,h257m8,h1m8,h23m10,h14m10,  &
       h11m10,h1m10,h83m11,h82m11,h8m11,h77m11,  &
       h72m11,h53m11,h48m11,h44m11,h42m11,h37m11,  &
       h35m11,h32m11,h3m11,h28m11,h24m11,h23m11,  &
       h2m11,h18m11,h15m11,h14m11,h114m11,h11m11,  &
       h1m11,h96m12,h93m12,h77m12,h74m12,h65m12,  &
       h62m12,h6m12,h45m12,h44m12,h4m12,h38m12,  &
       h37m12,h3m12,h29m12,h28m12,h24m12,h21m12,  &
       h16m12,h14m12,h12m12,h8m13,h46m13,h36m13,  &
       h135m13,h12m13,h1m13,h3m14,h15m14,h14m14,  &
       h1m17,h1m18,h1m19,h1m20,h1m21,h1m22,h1m23,  &
       h1m24,h26m30,h14m30,h25m31,h21m31,h12m31,  &
       h9m32,h55m32,h45m32,h4m33,h62m34,h1m60
  COMMON/hcon/hmp575,hm13ez,hm19ez,hm1e1,hm181e1,hm1e2
  COMMON/hcon/h1e6,h2e6,h1m2,hmp66667,hm6666m2,hp166666,  &
       h41666m2,hmp5,hm2m2,h29316e2,h1226e1,h3116e1,  &
       h9p94,hp6,h625m2,hp228,hp60241,hm1797e1,  &
       h8121e1,h2e2,hm1ez,h26e2,h44194m2,h1p41819
  COMMON/hcon/hp219,hp144,hp816,h69766e5,h235m3,hp26,  &
       h129m2,h75826m4,h1p082,hp805,h1386e2, h658m2,h1036e2,h2118m2,h42m2,h323m4,  &
       h67390e2,hp3795,hp5048,h102m5,h451m6
  COMMON/hcon/h16e1,hm161e1,h161e1,h3m3,h101m16,  &
       hm1597e1,h25e2,hp118666,h15m5,h3p5,h18e3,  &
       h6p08108,hmp805,hp602409,hp526315, h28571m2,h1m16
  COMMON/hcon/h3m4
  COMMON/hcon/hm8e1
  COMMON/hcon/h28e1

  INCLUDE "parmeta.f90"

  !parameter settings for the longwave and shortwave radiation code:
  !  imax   =  no. points along the lat. circle used in calcs.
  !  l      =  no. vertical levels (also layers) in model
  !note: the user normally will modify only the imax and l parameters
  !  nblw   =  no. freq. bands for approx computations. see
  !          bandta for definition
  !  nblx   =  no. freq bands for approx cts computations
  !  nbly   =  no. freq. bands for exact cts computations. see
  !          bdcomb for definition
  !  inlte  =  no. levels used for nlte calcs.
  !  nnlte  =  index no. of freq. band in nlte calcs.
  !  nb,ko2 are shortwave parameters; other quantities are derived
  !          from the above parameters.
  INTEGER, PARAMETER :: l=lm,imax=2*im-1,ncol=imax,nblw=163,nblx=47,nbly=15
  INTEGER, PARAMETER :: nblm=nbly-1,lp1=l+1,lp2=l+2,lp3=l+3,lm1=l-1,lm2=l-2
  INTEGER, PARAMETER :: lm3=l-3,ll=2*l,llp1=ll+1,llp2=ll+2,llp3=ll+3,llm1=ll-1
  INTEGER, PARAMETER :: llm2=ll-2,llm3=ll-3,lp1m=lp1*lp1,lp1m1=lp1m-1
  INTEGER, PARAMETER :: lp1v=lp1*(1+2*l/2),lp121=lp1*nbly,ll3p=3*l+2,nb=12
  INTEGER, PARAMETER :: inlte=3,inltep=inlte+1,nnlte=56,lp1i=imax*lp1
  INTEGER, PARAMETER :: llp1i=imax*llp1,ll3pi=imax*ll3p,nb1=nb-1,ko2=12
  INTEGER, PARAMETER :: ko21=ko2+1,ko2m=ko2-1

  !     parameter settings for the longwave and shortwave radiation code:
  !          imax   =  no. points sent to radfs
  !          l      =  no. vertical levels (also layers) in model
  !***note: the user normally will modify only the imax and l parameters
  !          nblw   =  no. freq. bands for approx computations. see
  !                      bandta for definition
  !          nblx   =  no. freq bands for approx cts computations
  !          nbly   =  no. freq. bands for exact cts computations. see
  !                      bdcomb for definition
  !          inlte  =  no. levels used for nlte calcs.
  !          nnlte  =  index no. of freq. band in nlte calcs.
  !          nb,ko2 are shortwave parameters; other quantities are derived
  !                    from the above parameters.
  !    common block bandta contains random band parameters for the lw
  !    calculations using 10 cm-1 wide bands.the 15 um co2 complex
  !    is 2 bands,560-670 and 670-800 cm-1. ozone coefficients are
  !    in 3 bands,670-800 (14.1 um),990-1070 and 1070-1200 (9.6 um).
  !    the  (nblw) bands now include:
  !                56 bands, 10  cm-1 wide    0  -   560  cm-1
  !                 2 bands, 15 um complex  560  -   670  cm-1
  !                                         670  -   800  cm-1
  !                 3 "continuum" bands     800  -   900  cm-1
  !                                         900  -   990  cm-1
  !                                        1070  -   1200 cm-1
  !                 1 band for 9.6 um band  990  -   1070 cm-1
  !               100 bands, 10 cm-1 wide  1200  -   2200 cm-1
  !                 1 band for 4.3 um src  2270  -   2380 cm-1
  !    thus nblw presently equals    163
  !    all bands are arranged in order of increasing wavenumber

  !        arndm   =   random "a" parameter for (nblw) bands
  !        brndm   =   random "b" parameter for (nblw) bands
  !        betad   =   continuum coefficients for (nblw) bands
  !        ap,bp   =   capphi coefficients for (nblw) bands
  !        atp,btp =   cappsi coefficients for (nblw) bands
  !        bandlo  =   lowest frequency in each of (nblw) freq. bands
  !        bandhi  =   highest frequency in each of (nblw) freq. bands
  !        ao3rnd  =   random "a" parameter for ozone in (3) ozone
  !                    bands
  !        bo3rnd  =   random "b" parameter for ozone in (3) ozone
  !                    bands
  !        ab15    =   the product arndm*brndm for the two bands
  !                    representing the 15 um band complex of co2
  !     data for arndm,brndm,ap,bp,atp,btp,ao3rnd,bo3rnd are obtained by
  !     using the afgl 1982 catalog. continuum coefficients are from
  !     roberts (1976).
  REAL, DIMENSION(nblw) :: arndm,brndm,betad,ap,bp,atp,btp,bandlo,bandhi
  REAL, DIMENSION(3)    :: ao3rnd,bo3rnd
  REAL, DIMENSION(2)    :: ab15
  COMMON / bandta / arndm,brndm,betad,ap,bp,atp,btp,bandlo,bandhi,ao3rnd, &
       bo3rnd,ab15

  !    common block bdwide contains random band parameters for specific
  !    wide bands. at present,the information consists of 1) random
  !    model parameters for the 15 um band,560-800 cm-1; 2) the
  !    continuum coefficient for the 800-990,1070-1200 cm-1 band
  !        specifically:
  !        awide       =   random "a" parameter for  band
  !        bwide       =   random "b" parameter for  band
  !        betawd      =   continuum coefficients for band
  !        apwd,bpwd   =   capphi coefficients for  band
  !        atpwd,btpwd =   cappsi coefficients for band
  !        bdlowd      =   lowest frequency in each  freq  band
  !        bdhiwd      =   highest frequency in each freq  band
  !        ab15wd      =   the product arndm*brndm for the one band
  !                        representing the 15 um band complex of co2
  !        betinw      =   cont.coefficient for a specified wide
  !                        freq.band (800-990 and 1070-1200 cm-1).
  !        sko2d       =   1./betinw, used in spa88 for cont. coeffs
  !        skc1r       =   betawd/betinw, used for cont. coeff. for
  !                        15 um band in fst88
  !        sko3r       =   ratio of cont. coeff. for 9.9 um band to
  !                        betinw, used for 9.6 um cont coeff in fst88
  !     data for awide,bwide,apwd,bpwd,atpwd,btpwd,ao3wd,bo3wd are
  !     obtained by using the afgl 1982 catalog. continuum coefficients
  !     are from roberts (1976).
  REAL :: awide,bwide,betawd, apwd,bpwd,atpwd,btpwd,bdlowd,bdhiwd,betinw,ab15wd
  REAL :: sko2d,skc1r,sko3r
  COMMON / bdwide / awide,bwide,betawd, apwd,bpwd,atpwd,btpwd,  &
       bdlowd,bdhiwd,betinw, ab15wd,sko2d,skc1r,sko3r

  !    common block bdcomb contains random band parameters for the lw
  !    calculations using combined wide frequency bands between 160 and
  !    1200 cm-1,as well as the 2270-2380 band for source calc.
  !        bands 1-8: combined wide frequency bands for 160-560 cm-1
  !        bands 9-14: frequency bands,as in bandta (narrow bands)
  !                    for 560-1200 cm-1
  !        band  15:  frequency band 2270-2380 cm-1,used for source
  !                   calculation only
  !        thus nbly presently equals   15

  !        bands are arranged in order of increasing wavenumber
  !        acomb       =   random "a" parameter for (nbly) bands
  !        bcomb       =   random "b" parameter for (nbly) bands
  !        betacm      =   continuum coefficients for (nbly) bands
  !        apcm,bpcm   =   capphi coefficients for (nbly) bands
  !        atpcm,btpcm =   cappsi coefficients for (nbly) bands
  !        bdlocm      =   lowest frequency in each of (nbly) freq. bands
  !        bdhicm      =   highest frequency in each of (nbly) freq. bands
  !        ao3cm       =   random "a" parameter for ozone in (3) ozone
  !                        bands
  !        bo3cm       =   random "b" parameter for ozone in (3) ozone
  !                        bands
  !        ab15cm      =   the product arndm*brndm for the two bands
  !                        representing the 15 um band complex of co2
  !        betinc      =   cont.coefficient for a specified wide
  !                        freq.band (800-990 and 1070-1200 cm-1).
  !        iband       =   index no of the 40 wide bands used in
  !                        combined wide band calculations. in other
  !                        words,index telling which of the 40 wide
  !                        bands between 160-560 cm-1 are included in
  !                        each of the first 8 combined wide bands
  !     data for acomb,bcomb,apcm,bpcm,atpcm,btpcm,ao3cm,bo3cm are
  !     obtained by using the afgl 1982 catalog. continuum coefficients
  !     are from roberts (1976). iband index values are obtained by
  !     experimentation.
  INTEGER, DIMENSION(40) :: iband
  REAL, DIMENSION(nbly) :: acomb,bcomb,betacm,apcm,bpcm,atpcm,btpcm,bdlocm
  REAL, DIMENSION(nbly) :: bdhicm
  REAL, DIMENSION(3) :: ao3cm,bo3cm
  REAL, DIMENSION(2) :: ab15cm
  REAL :: betinc
  COMMON / bdcomb / iband,acomb,bcomb,betacm,apcm,bpcm,atpcm,btpcm,bdlocm, &
       bdhicm,betinc,ao3cm,bo3cm,ab15cm

  !common block tabcom contains quantities precomputed in subroutine
  !table for use in the longwave radiation program:
  ! em1     =  e1 function, evaluated over the 0-560 and
  !            1200-2200 cm-1 intervals
  ! em1wde  =  e1 function, evaluated over the 160-560 cm-1
  !            interval
  ! table1  =  e2 function, evaluated over the 0-560 and
  !            1200-2200 cm-1 intervals
  ! table2  =  temperature derivative of table1
  ! table3  =  mass derivative of table1
  ! em3     =  e3 function, evaluated over the 0-560 and
  !            1200-2200 cm-1 intervals
  ! source  =  planck function, evaluated at specified temps. for
  !            bands used in cts calculations
  ! dsrce   =  temperature derivative of source
  ! ind     =  index, with value ind(i)=i. used in fst88
  ! indx2   =  index values used in obtaining "lower triangle"
  !            elements of avephi,etc.,in fst88
  ! kmaxv   =  index values used in obtaining "upper triangle"
  !            elements of avephi,etc.,in fst88
  ! kmaxvm  =  kmaxv(l),used for do loop indices
  INTEGER, DIMENSION(imax) :: ind
  INTEGER, DIMENSION(lp1v) :: indx2
  INTEGER, DIMENSION(lp1)  :: kmaxv
  INTEGER :: kmaxvm
  REAL, DIMENSION(28,180)  :: em1,em1wde,table1,table2,table3,em3,sum,pertsm
  REAL, DIMENSION(28,180)  :: sum3,sumwde
  REAL, DIMENSION(28,nblx) :: srcwd
  REAL, DIMENSION(28,nbly) :: source,dsrce
  REAL, DIMENSION(28,nblw) :: src1nb,dbdtnb
  REAL, DIMENSION(181)     :: zmass,zroot
  REAL, DIMENSION(28)      :: sc,dsc,xtemv,tfour,fortcu,x,x1,srcs,sum4,sum6
  REAL, DIMENSION(28)      :: sum7,sum8,sum4wd,r1,r2,s2,t3,r1wd
  REAL, DIMENSION(180)     :: x2,expo,fac 
  REAL, DIMENSION(30)      :: cnusb,dnusb
  REAL, DIMENSION(nblw)    :: alfanb,arotnb,anb,bnb,centnb,delnb,betanb
  REAL, DIMENSION(nbly)    :: delcm

  COMMON / tabcom / ind,indx2,kmaxv,kmaxvm
  COMMON/tabcom/em1,em1wde,table1,table2,table3,em3,source,dsrce
  !% #npadl = #page*#npage -  4*28*180  -  2*181 - 7*28 - 180 ;
  !% #npadl = #npadl       -  11*28  - 2*180 - 2*30 ;
  !     parameter (npadl = #npadl - 28*nblx - 2*28*nblw - 7*nblw)
  COMMON /scrtch/ sum,pertsm,sum3,sumwde,srcwd,src1nb,dbdtnb
  COMMON /scrtch/ zmass,zroot,sc,dsc,xtemv,tfour,fortcu,x,x1,x2,srcs,sum4, &
       sum6,sum7,sum8,sum4wd,r1,r2,s2,t3,r1wd
  COMMON /scrtch/ expo,fac
  COMMON/scrtch/cnusb,dnusb
  COMMON/scrtch/alfanb,arotnb
  COMMON/scrtch/anb,bnb,centnb,delnb,betanb
  !     common/scrtch/padloc(npadl)
  COMMON/tbltmp/ delcm

  !compute local quantities and ao3,bo3,ab15
  !for narrow-bands
  DO  n=1,nblw
     anb(n)=arndm(n)
     bnb(n)=brndm(n)
     centnb(n)=haf*(bandlo(n)+bandhi(n))
     delnb(n)=bandhi(n)-bandlo(n)
     betanb(n)=betad(n)
  END DO
  ab15(1)=anb(57)*bnb(57)
  ab15(2)=anb(58)*bnb(58)
  !for wide bands...
  ab15wd=awide*bwide

  !compute indices: ind,indx2,kmaxv
  DO  i=1,imax
     ind(i)=i
  END DO
  icnt=0
  DO  i1=1,l
     i2e=lp1-i1
     DO  i2=1,i2e
        icnt=icnt+1
        indx2(icnt)=lp1*(i2-1)+lp2*i1
     END DO
  END DO
  kmaxv(1)=1
  DO  i=2,l
     kmaxv(i)=kmaxv(i-1)+(lp2-i)
  END DO
  kmaxvm=kmaxv(l)
  !compute ratios of cont. coeffs
  skc1r=betawd/betinw
  sko3r=betad(61)/betinw
  sko2d=one/betinw

  !begin table computations here***
  !compute temps, masses for table entries
  !note: the dimensioning and initialization of xtemv and other arrays
  !   with dimension of 28 imply a restriction of model temperatures from
  !   100k to 370k.
  !the dimensioning of zmass,zroot and other arrays with dimension of
  !   180 imply a restriction of model h2o amounts such that optical paths
  !   are between 10**-16 and 10**2, in cgs units.
  zmass(1)=h1m16
  DO  j=1,180
     jp=j+1
     zroot(j)=SQRT(zmass(j))
     zmass(jp)=zmass(j)*h1p25892
  END DO
  DO  i=1,28
     xtemv(i)=hninety+ten*i
     tfour(i)=xtemv(i)*xtemv(i)*xtemv(i)*xtemv(i)
     fortcu(i)=four*xtemv(i)*xtemv(i)*xtemv(i)
  END DO

  !the computation of source,dsrce is  needed only
  !for the combined wide-band case.to obtain them,the source
  !must be computed for each of the (nblx) wide bands(=srcwd)
  !then combined (using iband) into source.
  DO  n=1,nbly
     DO  i=1,28
        source(i,n)=zero
     END DO
  END DO
  DO  n=1,nblx
     DO  i=1,28
        srcwd(i,n)=zero
     END DO
  END DO
  !begin freq. loop (on n)
  DO  n=1,nblx
     IF (n <= 46) THEN
        !the 160-1200 band cases
        cent=centnb(n+16)
        del=delnb(n+16)
        bdlo=bandlo(n+16)
        bdhi=bandhi(n+16)
     END IF
     IF (n == nblx) THEN
        !the 2270-2380 band case
        cent=centnb(nblw)
        del=delnb(nblw)
        bdlo=bandlo(nblw)
        bdhi=bandhi(nblw)
     END IF
     !for purposes of accuracy, all evaluations of planck fctns are made
     !on 10 cm-1 intervals, then summed into the (nblx) wide bands.
     nsubds=(del-h1m3)/10+1
     DO  nsb=1,nsubds
        IF (nsb /= nsubds) THEN
           cnusb(nsb)=ten*(nsb-1)+bdlo+five
           dnusb(nsb)=ten
        ELSE
           cnusb(nsb)=haf*(ten*(nsb-1)+bdlo+bdhi)
           dnusb(nsb)=bdhi-(ten*(nsb-1)+bdlo)
        END IF
        c1=(h37412m5)*cnusb(nsb)**3
        !begin temp. loop (on i)
        DO  i=1,28
           x(i)=h1p4387*cnusb(nsb)/xtemv(i)
           x1(i)=EXP(x(i))
           srcs(i)=c1/(x1(i)-one)
           srcwd(i,n)=srcwd(i,n)+srcs(i)*dnusb(nsb)
        END DO
     END DO
  END DO
  !the following loops create the combined wide band quantities source
  !and dsrce
  DO  n=1,40
     DO  i=1,28
        source(i,iband(n))=source(i,iband(n))+srcwd(i,n)
     END DO
  END DO
  DO  n=9,nbly
     DO  i=1,28
        source(i,n)=srcwd(i,n+32)
     END DO
  END DO
  DO  n=1,nbly
     DO  i=1,27
        dsrce(i,n)=(source(i+1,n)-source(i,n))*hp1
     END DO
  END DO
  DO  n=1,nblw
     alfanb(n)=bnb(n)*anb(n)
     arotnb(n)=SQRT(alfanb(n))
  END DO
  !first compute planck fctns (src1nb) and derivatives (dbdtnb) for
  !use in table evaluations. these are different from source,dsrce
  !because different frequency pts are used in evaluation, the freq.
  !ranges are different, and the derivative algorithm is different.

  DO  n=1,nblw
     cent=centnb(n)
     del=delnb(n)
     !note: at present, the ia loop is only used for ia=2. the loop struct
     !is kept so that in the future, we may use a quadrature scheme for
     !the planck fctn evaluation, rather than use the mid-band frequency.
     DO  ia=1,3
        anu=cent+haf*(ia-2)*del
        c1=(h37412m5)*anu*anu*anu+h1m20
        !temperature loop
        DO  i=1,28
           x(i)=h1p4387*anu/xtemv(i)
           x1(i)=EXP(x(i))
           sc(i)=c1/((x1(i)-one)+h1m20)
           dsc(i)=sc(i)*sc(i)*x(i)*x1(i)/(xtemv(i)*c1)
        END DO
        IF (ia == 2) THEN
           DO  i=1,28
              src1nb(i,n)=del*sc(i)
              dbdtnb(i,n)=del*dsc(i)
           END DO
        END IF
     END DO
  END DO
  !next compute r1,r2,s2,and t3- coefficients used for e3 function
  !when the optical path is less than 10-4. in this case, we assume a
  !different dependence on (zmass).
  !also obtain r1wd, which is r1 summed over the 160-560 cm-1 range
  DO  i=1,28
     sum4(i)=zero
     sum6(i)=zero
     sum7(i)=zero
     sum8(i)=zero
     sum4wd(i)=zero
  END DO
  DO  n=1,nblw
     cent=centnb(n)
     !perform summations for freq. ranges of 0-560,1200-2200 cm-1 for sum4
     !sum6,sum7,sum8
     IF (cent < 560. .OR. cent > 1200..AND.cent <= 2200.) THEN
        DO  i=1,28
           sum4(i)=sum4(i)+src1nb(i,n)
           sum6(i)=sum6(i)+dbdtnb(i,n)
           sum7(i)=sum7(i)+dbdtnb(i,n)*arotnb(n)
           sum8(i)=sum8(i)+dbdtnb(i,n)*alfanb(n)
        END DO
     END IF
     !perform summations over 160-560 cm-1 freq range for e1 calcs (sum4wd
     IF (cent > 160. .AND. cent < 560.) THEN
        DO  i=1,28
           sum4wd(i)=sum4wd(i)+src1nb(i,n)
        END DO
     END IF
  END DO
  DO  i=1,28
     r1(i)=sum4(i)/tfour(i)
     r2(i)=sum6(i)/fortcu(i)
     s2(i)=sum7(i)/fortcu(i)
     t3(i)=sum8(i)/fortcu(i)
     r1wd(i)=sum4wd(i)/tfour(i)
  END DO
  DO  j=1,180
     DO  i=1,28
        SUM(i,j)=zero
        pertsm(i,j)=zero
        sum3(i,j)=zero
        sumwde(i,j)=zero
     END DO
  END DO
  !frequency loop begins
  DO  n=1,nblw
     cent=centnb(n)
     !perform calculations for freq. ranges of 0-560,1200-2200 cm-1
     IF (cent < 560. .OR. cent > 1200..AND.cent <= 2200.) THEN
        DO  j=1,180
           x2(j)=arotnb(n)*zroot(j)
           expo(j)=EXP(-x2(j))
        END DO
        DO  j=1,180
           IF (x2(j) >= hundred) THEN
              expo(j)=zero
           END IF
        END DO
        DO  j=121,180
           fac(j)=zmass(j)*(one-(one+x2(j))*expo(j))/(x2(j)*x2(j))
        END DO
        DO  j=1,180
           DO  i=1,28
              SUM(i,j)=SUM(i,j)+src1nb(i,n)*expo(j)
              pertsm(i,j)=pertsm(i,j)+dbdtnb(i,n)*expo(j)
           END DO
        END DO
        DO  j=121,180
           DO  i=1,28
              sum3(i,j)=sum3(i,j)+dbdtnb(i,n)*fac(j)
           END DO
        END DO
     END IF
     !compute sum over 160-560 cm-1 range for use in e1 calcs (sumwde)
     IF (cent > 160. .AND. cent < 560.) THEN
        DO  j=1,180
           DO  i=1,28
              sumwde(i,j)=sumwde(i,j)+src1nb(i,n)*expo(j)
           END DO
        END DO
     END IF
  END DO
  DO  j=1,180
     DO  i=1,28
        em1(i,j)=SUM(i,j)/tfour(i)
        table1(i,j)=pertsm(i,j)/fortcu(i)
     END DO
  END DO
  DO  j=121,180
     DO  i=1,28
        em3(i,j)=sum3(i,j)/fortcu(i)
     END DO
  END DO
  DO  j=1,179
     DO  i=1,28
        table2(i,j)=(table1(i,j+1)-table1(i,j))*ten
     END DO
  END DO
  DO  j=1,180
     DO  i=1,27
        table3(i,j)=(table1(i+1,j)-table1(i,j))*hp1
     END DO
  END DO
  DO  i=1,28
     table2(i,180)=zero
  END DO
  DO  j=1,180
     table3(28,j)=zero
  END DO
  DO  j=1,2
     DO  i=1,28
        em1(i,j)=r1(i)
     END DO
  END DO
  DO  j=1,120
     DO  i=1,28
        em3(i,j)=r2(i)/two-s2(i)*SQRT(zmass(j))/three+t3(i)*zmass(j)/eight
     END DO
  END DO
  DO  j=121,180
     DO  i=1,28
        em3(i,j)=em3(i,j)/zmass(j)
     END DO
  END DO
  !now compute e1 tables for 160-560 cm-1 bands only.
  !we use r1wd and sumwde obtained above.
  DO  j=1,180
     DO  i=1,28
        em1wde(i,j)=sumwde(i,j)/tfour(i)
     END DO
  END DO
  DO  j=1,2
     DO  i=1,28
        em1wde(i,j)=r1wd(i)
     END DO
  END DO
END SUBROUTINE table
