    SUBROUTINE TABLE
#include "sp.h"
!     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.
!         INPUTS:
!         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

    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"
    INCLUDE "mpp.h"
!-----------------------------------------------------------------------
!     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.
    PARAMETER (L=LM)
    PARAMETER (IMAX=IM,NCOL=IMAX)
    PARAMETER (NBLW=163,NBLX=47,NBLY=15)
    PARAMETER (NBLM=NBLY-1)
    PARAMETER (LP1=L+1,LP2=L+2,LP3=L+3)
    PARAMETER (LM1=L-1,LM2=L-2,LM3=L-3)
    PARAMETER (LL=2*L,LLP1=LL+1,LLP2=LL+2,LLP3=LL+3)
    PARAMETER (LLM1=LL-1,LLM2=LL-2,LLM3=LL-3)
    PARAMETER (LP1M=LP1*LP1,LP1M1=LP1M-1)
    PARAMETER (LP1V=LP1*(1+2*L/2))
    PARAMETER (LP121=LP1*NBLY)
    PARAMETER (LL3P=3*L+2)
    PARAMETER (NB=12)
    PARAMETER (INLTE=3,INLTEP=INLTE+1,NNLTE=56)
    PARAMETER (LP1I=IMAX*LP1,LLP1I=IMAX*LLP1,LL3PI=IMAX*LL3P)
    PARAMETER (NB1=NB-1)
    PARAMETER (KO2=12)
    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).
    COMMON / BANDTA / ARNDM(NBLW),BRNDM(NBLW),BETAD(NBLW),AP(NBLW), &
    BP(NBLW),ATP(NBLW),BTP(NBLW),BANDLO(NBLW), &
    BANDHI(NBLW),AO3RND(3),BO3RND(3),AB15(2)

!    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).
    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.
    COMMON / BDCOMB / IBAND(40),ACOMB(NBLY),BCOMB(NBLY), &
    BETACM(NBLY),APCM(NBLY),BPCM(NBLY),ATPCM(NBLY), &
    BTPCM(NBLY),BDLOCM(NBLY),BDHICM(NBLY),BETINC, &
    AO3CM(3),BO3CM(3),AB15CM(2)

!     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

    COMMON / TABCOM / IND(IMAX),INDX2(LP1V),KMAXV(LP1), &
    KMAXVM
    COMMON/TABCOM/EM1(28,180),EM1WDE(28,180),TABLE1(28,180), &
    TABLE2(28,180),TABLE3(28,180),EM3(28,180),SOURCE(28,NBLY), &
    DSRCE(28,NBLY)

!% #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(28,180),PERTSM(28,180),SUM3(28,180), &
    SUMWDE(28,180),SRCWD(28,NBLX),SRC1NB(28,NBLW),DBDTNB(28,NBLW)
    COMMON /SCRTCH/ ZMASS(181),ZROOT(181),SC(28),DSC(28),XTEMV(28), &
    TFOUR(28),FORTCU(28),X(28),X1(28),X2(180),SRCS(28), &
    SUM4(28),SUM6(28),SUM7(28),SUM8(28),SUM4WD(28), &
    R1(28),R2(28),S2(28),T3(28),R1WD(28)
    COMMON /SCRTCH/ EXPO(180),FAC(180)
    COMMON/SCRTCH/CNUSB(30),DNUSB(30)
    COMMON/SCRTCH/ALFANB(NBLW),AROTNB(NBLW)
    COMMON/SCRTCH/ANB(NBLW),BNB(NBLW),CENTNB(NBLW),DELNB(NBLW), &
    BETANB(NBLW)
!     COMMON/SCRTCH/PADLOC(NPADL)
    COMMON/TBLTMP/ DELCM(NBLY)
!****************************************
!***COMPUTE LOCAL QUANTITIES AND AO3,BO3,AB15
!....FOR NARROW-BANDS...
    DO 101 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)
    101 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 111 I=1,IMAX
        IND(I)=I
    111 END DO
    ICNT=0
    DO 113 I1=1,L
        I2E=LP1-I1
        DO 115 I2=1,I2E
            ICNT=ICNT+1
            INDX2(ICNT)=LP1*(I2-1)+LP2*I1
        115 END DO
    113 END DO
    KMAXV(1)=1
    DO 117 I=2,L
        KMAXV(I)=KMAXV(I-1)+(LP2-I)
    117 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 201 J=1,180
        JP=J+1
        ZROOT(J)=SQRT(ZMASS(J))
        ZMASS(JP)=ZMASS(J)*H1P25892
    201 END DO
    DO 203 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)
    203 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 205 N=1,NBLY
        DO 205 I=1,28
            SOURCE(I,N)=ZERO
    205 END DO
    DO 207 N=1,NBLX
        DO 207 I=1,28
            SRCWD(I,N)=ZERO
    207 END DO
!---BEGIN FREQ. LOOP (ON N)
    DO 211 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)
        ENDIF
        IF (N == NBLX) THEN
        !***THE 2270-2380 BAND CASE
            CENT=CENTNB(NBLW)
            DEL=DELNB(NBLW)
            BDLO=BANDLO(NBLW)
            BDHI=BANDHI(NBLW)
        ENDIF
    !***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 213 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)
            ENDIF
            C1=(H37412M5)*CNUSB(NSB)**3
        !---BEGIN TEMP. LOOP (ON I)
            DO 215 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)
            215 END DO
        213 END DO
    211 END DO
!***THE FOLLOWING LOOPS CREATE THE COMBINED WIDE BAND QUANTITIES SOURCE
!   AND DSRCE
    DO 221 N=1,40
        DO 221 I=1,28
            SOURCE(I,IBAND(N))=SOURCE(I,IBAND(N))+SRCWD(I,N)
    221 END DO
    DO 223 N=9,NBLY
        DO 223 I=1,28
            SOURCE(I,N)=SRCWD(I,N+32)
    223 END DO
    DO 225 N=1,NBLY
        DO 225 I=1,27
            DSRCE(I,N)=(SOURCE(I+1,N)-SOURCE(I,N))*HP1
    225 END DO
    DO 231 N=1,NBLW
        ALFANB(N)=BNB(N)*ANB(N)
        AROTNB(N)=SQRT(ALFANB(N))
    231 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 301 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 303 IA=1,3
            ANU=CENT+HAF*(IA-2)*DEL
            C1=(H37412M5)*ANU*ANU*ANU+H1M20
        !---TEMPERATURE LOOP---
            DO 305 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)
            305 END DO
            IF (IA == 2) THEN
                DO 307 I=1,28
                    SRC1NB(I,N)=DEL*SC(I)
                    DBDTNB(I,N)=DEL*DSC(I)
                307 END DO
            ENDIF
        303 END DO
    301 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 311 I=1,28
        SUM4(I)=ZERO
        SUM6(I)=ZERO
        SUM7(I)=ZERO
        SUM8(I)=ZERO
        SUM4WD(I)=ZERO
    311 END DO
    DO 313 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 315 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)
            315 END DO
        ENDIF
    !***PERFORM SUMMATIONS OVER 160-560 CM-1 FREQ RANGE FOR E1 CALCS (SUM4WD
        IF (CENT > 160. .AND. CENT < 560.) THEN
            DO 316 I=1,28
                SUM4WD(I)=SUM4WD(I)+SRC1NB(I,N)
            316 END DO
        ENDIF
    313 END DO
    DO 317 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)
    317 END DO
    DO 401 J=1,180
        DO 401 I=1,28
            SUM(I,J)=ZERO
            PERTSM(I,J)=ZERO
            SUM3(I,J)=ZERO
            SUMWDE(I,J)=ZERO
    401 END DO
!---FREQUENCY LOOP BEGINS---
    DO 411 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 413 J=1,180
                X2(J)=AROTNB(N)*ZROOT(J)
                EXPO(J)=EXP(-X2(J))
            413 END DO
            DO 415 J=1,180
                IF (X2(J) >= HUNDRED) THEN
                    EXPO(J)=ZERO
                ENDIF
            415 END DO
            DO 417 J=121,180
                FAC(J)=ZMASS(J)*(ONE-(ONE+X2(J))*EXPO(J))/(X2(J)*X2(J))
            417 END DO
            DO 419 J=1,180
                DO 419 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)
            419 END DO
            DO 421 J=121,180
                DO 421 I=1,28
                    SUM3(I,J)=SUM3(I,J)+DBDTNB(I,N)*FAC(J)
            421 END DO
        ENDIF
    !---COMPUTE SUM OVER 160-560 CM-1 RANGE FOR USE IN E1 CALCS (SUMWDE)
        IF (CENT > 160. .AND. CENT < 560.) THEN
            DO 420 J=1,180
                DO 420 I=1,28
                    SUMWDE(I,J)=SUMWDE(I,J)+SRC1NB(I,N)*EXPO(J)
            420 END DO
        ENDIF
    411 END DO
    DO 431 J=1,180
        DO 431 I=1,28
            EM1(I,J)=SUM(I,J)/TFOUR(I)
            TABLE1(I,J)=PERTSM(I,J)/FORTCU(I)
    431 END DO
    DO 433 J=121,180
        DO 433 I=1,28
            EM3(I,J)=SUM3(I,J)/FORTCU(I)
    433 END DO
    DO 441 J=1,179
        DO 441 I=1,28
            TABLE2(I,J)=(TABLE1(I,J+1)-TABLE1(I,J))*TEN
    441 END DO
    DO 443 J=1,180
        DO 443 I=1,27
            TABLE3(I,J)=(TABLE1(I+1,J)-TABLE1(I,J))*HP1
    443 END DO
    DO 445 I=1,28
        TABLE2(I,180)=ZERO
    445 END DO
    DO 447 J=1,180
        TABLE3(28,J)=ZERO
    447 END DO
    DO 449 J=1,2
        DO 449 I=1,28
            EM1(I,J)=R1(I)
    449 END DO
    DO 451 J=1,120
        DO 451 I=1,28
            EM3(I,J)=R2(I)/TWO-S2(I)*SQRT(ZMASS(J))/THREE+T3(I)*ZMASS(J)/EIGHT
    451 END DO
    DO 453 J=121,180
        DO 453 I=1,28
            EM3(I,J)=EM3(I,J)/ZMASS(J)
    453 END DO
!***NOW COMPUTE E1 TABLES FOR 160-560 CM-1 BANDS ONLY.
!   WE USE R1WD AND SUMWDE OBTAINED ABOVE.
    DO 501 J=1,180
        DO 501 I=1,28
            EM1WDE(I,J)=SUMWDE(I,J)/TFOUR(I)
    501 END DO
    DO 503 J=1,2
        DO 503 I=1,28
            EM1WDE(I,J)=R1WD(I)
    503 END DO
    RETURN
    END SUBROUTINE TABLE
