
MODULE module_ra_rrtm

! Parameters

      INTEGER, PRIVATE :: IDATA
      INTEGER, PARAMETER :: MG=16 
      INTEGER, PARAMETER :: NBANDS=16
      INTEGER, PARAMETER :: NGPT=140
      INTEGER, PARAMETER :: NG1=8
      INTEGER, PARAMETER :: NG2=14
      INTEGER, PARAMETER :: NG3=16
      INTEGER, PARAMETER :: NG4=14
      INTEGER, PARAMETER :: NG5=16 
      INTEGER, PARAMETER :: NG6=8
      INTEGER, PARAMETER :: NG7=12
      INTEGER, PARAMETER :: NG8=8
      INTEGER, PARAMETER :: NG9=12
      INTEGER, PARAMETER :: NG10=6 
      INTEGER, PARAMETER :: NG11=8
      INTEGER, PARAMETER :: NG12=8
      INTEGER, PARAMETER :: NG13=4
      INTEGER, PARAMETER :: NG14=2
      INTEGER, PARAMETER :: NG15=2
      INTEGER, PARAMETER :: NG16=2
      INTEGER, PARAMETER :: MAXINPX=35
      INTEGER, PARAMETER :: MAXXSEC=4

      INTEGER, PARAMETER :: NMOL = 6
      REAL, PARAMETER :: ONEMINUS = 1. - 1.E-6

! var

      REAL    , SAVE    :: FLUXFAC
      INTEGER , SAVE    :: NLAYERS
!
! data 1
!
      REAL,SAVE ::  abscoefL1(5,13,MG),    abscoefH1(5,13:59,MG),   &
                    SELFREF1(10,MG)
      REAL,SAVE ::  abscoefL2(5,13,MG),    abscoefH2(5,13:59,MG),   &
                    SELFREF2(10,MG)
      REAL,SAVE ::  abscoefL3(10,5,13,MG), abscoefH3(5,5,13:59,MG), &
                    SELFREF3(10,MG)
      REAL,SAVE ::  abscoefL4(9,5,13,MG),  abscoefH4(6,5,13:59,MG), &
                    SELFREF4(10,MG)
      REAL,SAVE ::  abscoefL5(9,5,13,MG),  abscoefH5(5,5,13:59,MG), &
                    SELFREF5(10,MG)
      REAL,SAVE ::  abscoefL6(5,13,MG),    SELFREF6(10,MG)
      REAL,SAVE ::  abscoefL7(9,5,13,MG),  abscoefH7(5,13:59,MG),   &
                    SELFREF7(10,MG)
      REAL,SAVE ::  abscoefL8(5,7,MG),     abscoefH8(5,7:59,MG),    &
                    SELFREF8(10,MG)
      REAL,SAVE ::  abscoefL9(11,5,13,MG), abscoefH9(5,13:59,MG),   &
                    SELFREF9(10,MG)
      REAL,SAVE ::  abscoefL10(5,13,MG),   abscoefH10(5,13:59,MG)  
      REAL,SAVE ::  abscoefL11(5,13,MG),   abscoefH11(5,13:59,MG),  &
                    SELFREF11(10,MG)
      REAL,SAVE ::  abscoefL12(9,5,13,MG), SELFREF12(10,MG)
      REAL,SAVE ::  abscoefL13(9,5,13,MG), SELFREF13(10,MG)
      REAL,SAVE ::  abscoefL14(5,13,MG),   abscoefH14(5,13:59,MG),  &
                    SELFREF14(10,MG)
      REAL,SAVE ::  abscoefL15(9,5,13,MG), SELFREF15(10,MG)
      REAL,SAVE ::  abscoefL16(9,5,13,MG), SELFREF16(10,MG)

!
! data 2
!
      INTEGER,SAVE ::  NGM(MG*NBANDS), NGC(NBANDS), NGS(NBANDS),       &
                    NGN(NGPT), NGB(NGPT)
      REAL,SAVE ::  WT(MG)
!
! data 3
!
      REAL,SAVE ::  FRACREFA1(MG), FRACREFB1(MG), FORREF1(MG)   
      REAL,SAVE ::  FRACREFA2(MG,13), FRACREFB2(MG), FORREF2(MG)
      REAL,SAVE ::  FRACREFA3(MG,10), FRACREFB3(MG,5)        
      REAL,SAVE ::  FORREF3(MG), ABSN2OA3(MG), ABSN2OB3(MG)   
      REAL,SAVE ::  FRACREFA4(MG,9), FRACREFB4(MG,6)        
      REAL,SAVE ::  FRACREFA5(MG,9), FRACREFB5(MG,5), CCL45(MG) 
      REAL,SAVE ::  FRACREFA6(MG), ABSCO26(MG), CFC11ADJ6(MG), CFC126(MG)    
      REAL,SAVE ::  FRACREFA7(MG,9), FRACREFB7(MG), ABSCO27(MG)        
      REAL,SAVE ::  FRACREFA8(MG), FRACREFB8(MG), ABSCO2A8(MG), ABSCO2B8(MG)
      REAL,SAVE ::  ABSN2OA8(MG), ABSN2OB8(MG), CFC128(MG), CFC22ADJ8(MG)  
      REAL,SAVE ::  FRACREFA9(MG,9), FRACREFB9(MG), ABSN2O9(3*MG)
      REAL,SAVE ::  FRACREFA10(MG), FRACREFB10(MG)        
      REAL,SAVE ::  FRACREFA11(MG), FRACREFB11(MG)        
      REAL,SAVE ::  FRACREFA12(MG,9)        
      REAL,SAVE ::  FRACREFA13(MG,9)        
      REAL,SAVE ::  FRACREFA14(MG), FRACREFB14(MG)
      REAL,SAVE ::  FRACREFA15(MG,9)
      REAL,SAVE ::  FRACREFA16(MG,9)
!
! data 4
!
      INTEGER,SAVE :: NXMOL, IXINDX(MAXINPX)

! data 5 

      REAL,SAVE    :: WAVENUM1(NBANDS),WAVENUM2(NBANDS),DELWAVE(NBANDS)

! data 6

      INTEGER,SAVE :: NG(NBANDS),NSPA(NBANDS),NSPB(NBANDS)
      REAL,   SAVE :: HEATFAC
      REAL,   SAVE :: PREF(59),PREFLOG(59),TREF(59)

! data 7 

      REAL,   SAVE :: TOTPLNK(181,NBANDS), TOTPLK16(181)

! data

      REAL,    SAVE :: TAU(0:5000),TF(0:5000),TRANS(0:5000)
!
      REAL,    SAVE :: ABSA1(5*13,NG1), ABSB1(5*(59-13+1),NG1),         &
                       SELFREFC1(10,NG1), FORREFC1(NG1)
      REAL,    SAVE :: ABSA2(5*13,NG2), ABSB2(5*(59-13+1),NG2),         &
                       SELFREFC2(10,NG2), FORREFC2(NG2)
      REAL,    SAVE :: ABSA3(10*5*13,NG3), ABSB3(5*5*(59-13+1),NG3),    &     
                       SELFREFC3(10,NG3), FORREFC3(NG3),                &
                       ABSN2OAC3(NG3), ABSN2OBC3(NG3)        
      REAL,    SAVE :: ABSA4(9*5*13,NG4), ABSB4(6*5*(59-13+1),NG4),     &
                       SELFREFC4(10,NG4)        
      REAL,    SAVE :: ABSA5(9*5*13,NG5), ABSB5(5*5*(59-13+1),NG5),     &
                       SELFREFC5(10,NG5), CCL4C5(NG5)        
      REAL,    SAVE :: ABSA6(5*13,NG6), SELFREFC6(10,NG6),              &        
                       ABSCO2C6(NG6), CFC11ADJC6(NG6), CFC12C6(NG6)  
      REAL,    SAVE :: ABSA7(9*5*13,NG7), ABSB7(5*(59-13+1),NG7),       &  
                       SELFREFC7(10,NG7), ABSCO2C7(NG7)        
      REAL,    SAVE :: ABSA8(5*7,NG8), ABSB8(5*(59-7+1),NG8),           &
                       SELFREFC8(10,NG8),                               &
                       ABSCO2AC8(NG8), ABSCO2BC8(NG8),                  &
                       ABSN2OAC8(NG8), ABSN2OBC8(NG8),                  &       
                       CFC12C8(NG8), CFC22ADJC8(NG8)      
      REAL,    SAVE :: ABSA9(11*5*13,NG9), ABSB9(5*(59-13+1),NG9),      &
                       SELFREFC9(10,NG9), ABSN2OC9(3*NG9)
      REAL,    SAVE :: ABSA10(5*13,NG10), ABSB10(5*(59-13+1),NG10)
      REAL,    SAVE :: ABSA11(5*13,NG11), ABSB11(5*(59-13+1),NG11),     &
                       SELFREFC11(10,NG11)
      REAL,    SAVE :: ABSA12(9*5*13,NG12), SELFREFC12(10,NG12)
      REAL,    SAVE :: ABSA13(9*5*13,NG13), SELFREFC13(10,NG13)
      REAL,    SAVE :: ABSA14(5*13,NG14), ABSB14(5*(59-13+1),NG14),    &
                       SELFREFC14(10,NG14)
      REAL,    SAVE :: ABSA15(9*5*13,NG15), SELFREFC15(10,NG15)
      REAL,    SAVE :: ABSA16(9*5*13,NG16), SELFREFC16(10,NG16)

      REAL,    SAVE :: FRACREFAC1(NG1), FRACREFBC1(NG1)
      REAL,    SAVE :: FRACREFAC2(NG2,13), FRACREFBC2(NG2)
      REAL,    SAVE :: FRACREFAC3(NG3,10), FRACREFBC3(NG3,5)
      REAL,    SAVE :: FRACREFAC4(NG4,9), FRACREFBC4(NG4,6)
      REAL,    SAVE :: FRACREFAC5(NG5,9), FRACREFBC5(NG5,5)      
      REAL,    SAVE :: FRACREFAC6(NG6)                              
      REAL,    SAVE :: FRACREFAC7(NG7,9), FRACREFBC7(NG7)    
      REAL,    SAVE :: FRACREFAC8(NG8), FRACREFBC8(NG8)  
      REAL,    SAVE :: FRACREFAC9(NG9,9), FRACREFBC9(NG9)      
      REAL,    SAVE :: FRACREFAC10(NG10), FRACREFBC10(NG10)       
      REAL,    SAVE :: FRACREFAC11(NG11), FRACREFBC11(NG11)  
      REAL,    SAVE :: FRACREFAC12(NG12,9)                     
      REAL,    SAVE :: FRACREFAC13(NG13,9)           
      REAL,    SAVE :: FRACREFAC14(NG14), FRACREFBC14(NG14)    
      REAL,    SAVE :: FRACREFAC15(NG15,9)                      
      REAL,    SAVE :: FRACREFAC16(NG16,9)                 
      
      REAL,    SAVE :: CORR1(0:200),CORR2(0:200)
      REAL,    SAVE :: BPADE
      REAL,    SAVE :: RWGT(MG*NBANDS)

!----------------------------------------------------------------------------
!
! start data 2
                                                                                 
!     Arrays for the g-point reduction from 256 to 140 for the 16 LW bands:      
!     This mapping from 256 to 140 points has been carefully selected to         
!     minimize the effect on the resulting fluxes and cooling rates, and         
!     caution should be used if the mapping is modified.                         
!                                                                                
!     NGPT    The total number of new g-points                                   
!     NGC     The number of new g-points in each band                            
!     NGM     The index of each new g-point relative to the original             
!             16 g-points for each band.                                         
!     NGN     The number of original g-points that are combined to make          
!             each new g-point in each band.                                     
!     NGB     The band index for each new g-point.                               
!     WT      RRTM weights for 16 g-points.                                      
                                                                                 
! Data Statements                                                                
      DATA NGC  /8,14,16,14,16,8,12,8,12,6,8,8,4,2,2,2/                          
      DATA NGS  /8,22,38,52,68,76,88,96,108,114,122,130,134,136,138,140/         
      DATA NGM  /1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, &             ! Band 1            
                 1,2,3,4,5,6,7,8,9,10,11,12,13,13,14,14, &      ! Band 2            
                 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &      ! Band 3            
                 1,2,3,4,5,6,7,8,9,10,11,12,13,14,14,14, &      ! Band 4            
                 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &      ! Band 5            
                 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, &             ! Band 6            
                 1,1,2,2,3,4,5,6,7,8,9,10,11,11,12,12, &        ! Band 7            
                 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, &             ! Band 8            
                 1,2,3,4,5,6,7,8,9,9,10,10,11,11,12,12, &       ! Band 9            
                 1,1,2,2,3,3,4,4,5,5,5,5,6,6,6,6, &             ! Band 10           
                 1,2,3,3,4,4,5,5,6,6,7,7,7,8,8,8, &             ! Band 11           
                 1,2,3,4,5,5,6,6,7,7,7,7,8,8,8,8, &             ! Band 12           
                 1,1,1,2,2,2,3,3,3,3,4,4,4,4,4,4, &             ! Band 13           
                 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, &             ! Band 14           
                 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, &             ! Band 15           
                 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2/               ! Band 16           
      DATA NGN  /2,2,2,2,2,2,2,2, &                             ! Band 1            
                 1,1,1,1,1,1,1,1,1,1,1,1,2,2, &                 ! Band 2            
                 16*1, &                                        ! Band 3            
                 1,1,1,1,1,1,1,1,1,1,1,1,1,3, &                 ! Band 4            
                 16*1, &                                        ! Band 5            
                 2,2,2,2,2,2,2,2, &                             ! Band 6            
                 2,2,1,1,1,1,1,1,1,1,2,2, &                     ! Band 7            
                 2,2,2,2,2,2,2,2, &                             ! Band 8            
                 1,1,1,1,1,1,1,1,2,2,2,2, &                     ! Band 9            
                 2,2,2,2,4,4, &                                 ! Band 10           
                 1,1,2,2,2,2,3,3, &                             ! Band 11           
                 1,1,1,1,2,2,4,4, &                             ! Band 12           
                 3,3,4,6, &                                     ! Band 13           
                 8,8, &                                         ! Band 14           
                 8,8, &                                         ! Band 15           
                 8,8/                                           ! Band 16           
      DATA NGB  /8*1, &                                         ! Band 1            
                 14*2, &                                        ! Band 2            
                 16*3, &                                        ! Band 3            
                 14*4, &                                        ! Band 4            
                 16*5, &                                        ! Band 5            
                 8*6, &                                         ! Band 6            
                 12*7, &                                        ! Band 7            
                 8*8, &                                         ! Band 8            
                 12*9, &                                        ! Band 9            
                 6*10, &                                        ! Band 10           
                 8*11, &                                        ! Band 11           
                 8*12, &                                        ! Band 12           
                 4*13, &                                        ! Band 13           
                 2*14, &                                        ! Band 14           
                 2*15, &                                        ! Band 15           
                 2*16/                                       ! Band 16           
      DATA WT/ &                                                                  
           0.1527534276,0.1491729617,0.1420961469,0.1316886544, &                   
           0.1181945205,0.1019300893,0.0832767040,0.0626720116, &                   
           0.0424925,0.0046269894,0.0038279891,0.0030260086, &                      
           0.0022199750,0.0014140010,0.000533,0.000075/                          

!
! end of data 2
!
!-----------------------------------------------------------------------

! start data 3

                                                                                 
! Data

      DATA FRACREFA1/ &                                                            
          0.08452097,0.17952873,0.16214369,0.13602182, &                            
          0.12760490,0.10302561,0.08392423,0.06337652, &                            
          0.04206551,0.00487497,0.00410743,0.00344421, &                            
          0.00285731,0.00157327,0.00080648,0.00012406/                           
      DATA FRACREFB1/ &                                                            
          0.15492001,0.17384727,0.15165100,0.12675308, &                            
          0.10986247,0.09006091,0.07584465,0.05990077, &                            
          0.04113461,0.00438638,0.00374754,0.00313924, &                            
          0.00234381,0.00167167,0.00062744,0.00010889/                           
                                                                                 
      DATA FORREF1/   &                                                            
         -4.50470E-02,-1.18908E-01,-7.21730E-02,-2.83862E-02, &                     
         -3.01961E-02,-1.56877E-02,-1.53684E-02,-1.29135E-02, &                     
         -1.27963E-02,-1.81742E-03, 4.40008E-05, 1.05260E-02, &                     
          2.17290E-02, 1.65571E-02, 7.60751E-02, 1.47405E-01/                    

                                                                                 
! Data                                                                           
                                                                                 
!     The ith set of reference fractions are from the ith reference              
!     pressure level.                                                            

      DATA FRACREFA2/ &
          0.18068060,0.16803175,0.15140158,0.12221480, 0.10240850,0.09330297,0.07518960,0.05611294, &
          0.03781487,0.00387192,0.00321285,0.00244440, 0.00179546,0.00107704,0.00038798,0.00005060, &
          0.17927621,0.16731168,0.15129538,0.12328085, 0.10243484,0.09354796,0.07538418,0.05633071, &
          0.03810832,0.00398347,0.00320262,0.00250029, 0.00178666,0.00111127,0.00039438,0.00005169, &
          0.17762886,0.16638555,0.15115446,0.12470623, 0.10253213,0.09383459,0.07560240,0.05646568, &
          0.03844077,0.00409142,0.00322521,0.00254918, 0.00179296,0.00113652,0.00040169,0.00005259, &
          0.17566043,0.16539773,0.15092199,0.12571971, 0.10340609,0.09426189,0.07559051,0.05678188, &
          0.03881499,0.00414102,0.00328551,0.00258795, 0.00181648,0.00115145,0.00040969,0.00005357, &
          0.17335825,0.16442548,0.15070701,0.12667464, 0.10452303,0.09450833,0.07599410,0.05706393, &
          0.03910370,0.00417880,0.00335256,0.00261708, 0.00185491,0.00116627,0.00041759,0.00005464, &
          0.17082544,0.16321516,0.15044247,0.12797612, 0.10574646,0.09470057,0.07647423,0.05738756, &
          0.03935621,0.00423789,0.00342651,0.00264549, 0.00190188,0.00118281,0.00042592,0.00005583, &
          0.16809277,0.16193336,0.15013184,0.12937409, 0.10720784,0.09485368,0.07692636,0.05771774, &
          0.03966988,0.00427754,0.00349696,0.00268946, 0.00193536,0.00120222,0.00043462,0.00005712, &
          0.16517997,0.16059248,0.14984852,0.13079269, 0.10865030,0.09492947,0.07759736,0.05812201, &
          0.03997169,0.00432356,0.00355308,0.00274031, 0.00197243,0.00122401,0.00044359,0.00005849, &
          0.16209179,0.15912023,0.14938223,0.13198245, 0.11077233,0.09487948,0.07831636,0.05863440, &
          0.04028239,0.00436804,0.00360407,0.00279885, 0.00200364,0.00124861,0.00045521,0.00005996, &
          0.15962425,0.15789343,0.14898103,0.13275230, 0.11253940,0.09503502,0.07884382,0.05908009, &
          0.04053524,0.00439971,0.00364269,0.00284965, 0.00202758,0.00127076,0.00046408,0.00006114, &
          0.15926200,0.15770932,0.14891729,0.13283882, 0.11276010,0.09507311,0.07892222,0.05919230, &
          0.04054824,0.00440833,0.00365575,0.00286459, 0.00203786,0.00128405,0.00046504,0.00006146, &
          0.15926351,0.15770483,0.14891177,0.13279966, 0.11268171,0.09515216,0.07890341,0.05924807, &
          0.04052851,0.00440870,0.00365425,0.00286878, 0.00205747,0.00128916,0.00046589,0.00006221, &
          0.15937765,0.15775780,0.14892603,0.13273248, 0.11252731,0.09521657,0.07885858,0.05927679, &
          0.04050184,0.00440285,0.00365748,0.00286791, 0.00207507,0.00129193,0.00046679,0.00006308/
!     From P = 0.432 mb.                                                         
      DATA FRACREFB2/ &                                                             
          0.17444289,0.16467269,0.15021490,0.12460902, &                         
          0.10400643,0.09481928,0.07590704,0.05752856, &                         
          0.03931715,0.00428572,0.00349352,0.00278938, &                         
          0.00203448,0.00130037,0.00051560,0.00006255/                           
                                                                                 
      DATA FORREF2/ &                                                               
         -2.34550E-03,-8.42698E-03,-2.01816E-02,-5.66701E-02, &                  
         -8.93189E-02,-6.37487E-02,-4.56455E-02,-4.41417E-02, &                  
         -4.48605E-02,-4.74696E-02,-5.16648E-02,-5.63099E-02, &                  
         -4.74781E-02,-3.84704E-02,-2.49905E-02, 2.02114E-03/                    
                                                                                 
! Data                                                                           
                                                                                 
      DATA FRACREFA3/ &                                                             
!     From P = 1053.6 mb.                                                        
          0.15116400,0.14875700,0.14232300,0.13234501, 0.11881600,0.10224100,0.08345580,0.06267490, &                         
          0.04250650,0.00462650,0.00382259,0.00302600, 0.00222004,0.00141397,0.00053379,0.00007421, &                         
          0.15266000,0.14888400,0.14195900,0.13179500, 0.11842700,0.10209000,0.08336130,0.06264370, &                         
          0.04247660,0.00461946,0.00381536,0.00302601, 0.00222004,0.00141397,0.00053302,0.00007498, &                         
          0.15282799,0.14903000,0.14192399,0.13174300, 0.11835300,0.10202700,0.08329830,0.06264830, &                         
          0.04246910,0.00460242,0.00381904,0.00301573, 0.00222004,0.00141397,0.00053379,0.00007421, &                         
          0.15298399,0.14902800,0.14193401,0.13173500, 0.11833300,0.10195800,0.08324730,0.06264770, &                         
          0.04246490,0.00460489,0.00381123,0.00301893, 0.00221093,0.00141397,0.00053379,0.00007421, &                         
          0.15307599,0.14907201,0.14198899,0.13169800, 0.11827300,0.10192300,0.08321600,0.06263490, &                         
          0.04245600,0.00460846,0.00380836,0.00301663, 0.00221402,0.00141167,0.00052807,0.00007376, &                         
          0.15311401,0.14915401,0.14207301,0.13167299, 0.11819300,0.10188900,0.08318760,0.06261960, &                         
          0.04243890,0.00461584,0.00380929,0.00300815, 0.00221736,0.00140588,0.00052776,0.00007376, &                         
          0.15316001,0.14925499,0.14213000,0.13170999, 0.11807700,0.10181400,0.08317400,0.06260300, &                         
          0.04242720,0.00461520,0.00381381,0.00301285, 0.00220275,0.00140371,0.00052776,0.00007376, &                         
          0.15321200,0.14940999,0.14222500,0.13164200, 0.11798200,0.10174500,0.08317500,0.06253640, &                         
          0.04243130,0.00461724,0.00381534,0.00300320, 0.00220091,0.00140364,0.00052852,0.00007300, &                         
          0.15312800,0.14973100,0.14234400,0.13168900, 0.11795200,0.10156100,0.08302990,0.06252240, &                         
          0.04240980,0.00461035,0.00381381,0.00300176, 0.00220160,0.00140284,0.00052774,0.00007376, &                         
          0.15292500,0.14978001,0.14242400,0.13172600, 0.11798800,0.10156400,0.08303050,0.06251670, &                         
          0.04240970,0.00461302,0.00381452,0.00300250, 0.00220126,0.00140324,0.00052850,0.00007300/                           
      DATA FRACREFB3/ &                                                             
!     From P = 64.1 mb.                                                          
          0.16340201,0.15607700,0.14601400,0.13182700, &                         
          0.11524700,0.09666570,0.07825360,0.05849780, &                         
          0.03949650,0.00427980,0.00353719,0.00279303, &                         
          0.00204788,0.00130139,0.00049055,0.00006904, &                         
          0.15762900,0.15494700,0.14659800,0.13267800, &                         
          0.11562700,0.09838360,0.07930420,0.05962700, &                         
          0.04036360,0.00438053,0.00361463,0.00285723, &                         
          0.00208345,0.00132135,0.00050528,0.00008003, &                         
          0.15641500,0.15394500,0.14633600,0.13180400, &                         
          0.11617100,0.09924170,0.08000510,0.06021420, &                         
          0.04082730,0.00441694,0.00365364,0.00287723, &                         
          0.00210914,0.00135784,0.00054651,0.00008003, &                         
          0.15482700,0.15286300,0.14392500,0.13244100, &                         
          0.11712000,0.09994920,0.08119200,0.06104360, &                         
          0.04135600,0.00446685,0.00368377,0.00290767, &                         
          0.00215445,0.00142865,0.00056142,0.00008003, &                         
          0.15975100,0.15653500,0.14214399,0.12892200, &                         
          0.11508400,0.09906020,0.08087940,0.06078190, &                         
          0.04140530,0.00452724,0.00374558,0.00295328, &                         
          0.00218509,0.00138644,0.00056018,0.00008003/                           
                                                                                 
      DATA ABSN2OA3/ &                                                              
          1.50387E-01,2.91407E-01,6.28803E-01,9.65619E-01, &                     
          1.15054E-00,2.23424E-00,1.83392E-00,1.39033E-00, &                     
          4.28457E-01,2.73502E-01,1.84307E-01,1.61325E-01, &                     
          7.66314E-02,1.33862E-01,6.71196E-07,1.59293E-06/                       
      DATA ABSN2OB3/ &                                                              
          9.37044E-05,1.23318E-03,7.91720E-03,5.33005E-02, &                     
          1.72343E-01,4.29571E-01,1.01288E+00,3.83863E+00, &                     
          1.15312E+01,1.08383E+00,2.24847E+00,1.51268E+00, &                     
          3.33177E-01,7.82102E-01,3.44631E-01,1.61039E-03/                       
      DATA FORREF3/ &                                                               
          1.76842E-04, 1.77913E-04, 1.25186E-04, 1.07912E-04, &                  
          1.05217E-04, 7.48726E-05, 1.11701E-04, 7.68921E-05, &                  
          9.87242E-05, 9.85711E-05, 6.16557E-05,-1.61291E-05, &                  
         -1.26794E-04,-1.19011E-04,-2.67814E-04, 6.95005E-05/                    
                                                                                 
! Data                                                                           
                                                                                 
      DATA FRACREFA4/ &                                                             
!     From P =                                                                   
          0.15579100,0.14918099,0.14113800,0.13127001, &                         
          0.11796300,0.10174300,0.08282370,0.06238150, &                         
          0.04213440,0.00458968,0.00377949,0.00298736, &                         
          0.00220743,0.00140644,0.00053024,0.00007459, &                         
          0.15292799,0.15004000,0.14211500,0.13176700, &                         
          0.11821100,0.10186300,0.08288040,0.06241390, &                         
          0.04220720,0.00459006,0.00377919,0.00298743, &                         
          0.00220743,0.00140644,0.00053024,0.00007459, &                         
          0.14386199,0.15125300,0.14650001,0.13377000, &                         
          0.11895900,0.10229400,0.08312110,0.06239520, &                         
          0.04225560,0.00459428,0.00378865,0.00298860, &                         
          0.00220743,0.00140644,0.00053024,0.00007459, &                         
          0.14359100,0.14561599,0.14479300,0.13740200, &                         
          0.12150100,0.10315400,0.08355480,0.06247240, &                         
          0.04230980,0.00459916,0.00378373,0.00300063, &                         
          0.00221111,0.00140644,0.00053024,0.00007459, &                         
          0.14337599,0.14451601,0.14238000,0.13520500, &                         
          0.12354200,0.10581200,0.08451810,0.06262440, &                         
          0.04239590,0.00460297,0.00378701,0.00300466, &                         
          0.00221899,0.00141020,0.00053024,0.00007459, &                         
          0.14322001,0.14397401,0.14117201,0.13401900, &                         
          0.12255500,0.10774100,0.08617650,0.06296420, &                         
          0.04249590,0.00463406,0.00378241,0.00302037, &                         
          0.00221583,0.00141103,0.00053814,0.00007991, &                         
          0.14309500,0.14364301,0.14043900,0.13348100, &                         
          0.12211600,0.10684700,0.08820590,0.06374610, &                         
          0.04264730,0.00464231,0.00384022,0.00303427, &                         
          0.00221825,0.00140943,0.00055564,0.00007991, &                         
          0.15579100,0.14918099,0.14113800,0.13127001, &                         
          0.11796300,0.10174300,0.08282370,0.06238150, &                         
          0.04213440,0.00458968,0.00377949,0.00298736, &                         
          0.00220743,0.00140644,0.00053024,0.00007459, &                         
          0.15937001,0.15159500,0.14242800,0.13078900, &                         
          0.11671300,0.10035700,0.08143450,0.06093850, &                         
          0.04105320,0.00446233,0.00369844,0.00293784, &                         
          0.00216425,0.00143403,0.00054571,0.00007991/                           
      DATA FRACREFB4/ &                                                             
!     From P = 1.17 mb.                                                          
          0.15558299,0.14930600,0.14104301,0.13124099, &                         
          0.11792900,0.10159200,0.08314130,0.06240450, &                         
          0.04217020,0.00459313,0.00379798,0.00299835, &                         
          0.00218950,0.00140615,0.00053010,0.00007457, &                         
          0.15592700,0.14918999,0.14095700,0.13115700, &                         
          0.11788900,0.10158000,0.08313780,0.06240240, &                         
          0.04217000,0.00459313,0.00379798,0.00299835, &                         
          0.00218950,0.00140615,0.00053010,0.00007457, &                         
          0.15949000,0.15014900,0.14162201,0.13080800, &                         
          0.11713500,0.10057100,0.08170080,0.06128110, &                         
          0.04165600,0.00459202,0.00379835,0.00299717, &                         
          0.00218958,0.00140616,0.00053010,0.00007457, &                         
          0.15967900,0.15038200,0.14196999,0.13074800, &                         
          0.11701700,0.10053000,0.08160790,0.06122690, &                         
          0.04128310,0.00456598,0.00379486,0.00299457, &                         
          0.00219016,0.00140619,0.00053011,0.00007456, &                         
          0.15989800,0.15057300,0.14207700,0.13068600, &                         
          0.11682900,0.10053900,0.08163610,0.06121870, &                         
          0.04121690,0.00449061,0.00371235,0.00294207, &                         
          0.00217778,0.00139877,0.00053011,0.00007455, &                         
          0.15950100,0.15112500,0.14199100,0.13071300, &                         
          0.11680800,0.10054600,0.08179050,0.06120910, &                         
          0.04126050,0.00444324,0.00366843,0.00289369, &                         
          0.00211550,0.00134746,0.00050874,0.00007863/                           
                                                                                 
! Data                                                                           
                                                                                 
      DATA FRACREFA5/ &                                                             
!     From P = 387.6 mb.                                                         
          0.13966499,0.14138900,0.13763399,0.13076700, &                         
          0.12299100,0.10747700,0.08942000,0.06769200, &                         
          0.04587610,0.00501173,0.00415809,0.00328398, &                         
          0.00240015,0.00156222,0.00059104,0.00008323, &                         
          0.13958199,0.14332899,0.13785399,0.13205400, &                         
          0.12199700,0.10679600,0.08861080,0.06712320, &                         
          0.04556030,0.00500863,0.00416315,0.00328629, &                         
          0.00240023,0.00156220,0.00059104,0.00008323, &                         
          0.13907100,0.14250501,0.13889600,0.13297300, &                         
          0.12218700,0.10683800,0.08839260,0.06677310, &                         
          0.04538570,0.00495402,0.00409863,0.00328219, &                         
          0.00240805,0.00156266,0.00059104,0.00008323, &                         
          0.13867700,0.14190100,0.13932300,0.13327099, &                         
          0.12280800,0.10692500,0.08844510,0.06658510, &                         
          0.04519340,0.00492276,0.00408832,0.00323856, &                         
          0.00239289,0.00155698,0.00059104,0.00008323, &                         
          0.13845000,0.14158800,0.13929300,0.13295600, &                         
          0.12348300,0.10736700,0.08859480,0.06650610, &                         
          0.04498230,0.00491335,0.00406968,0.00322901, &                         
          0.00234666,0.00155235,0.00058813,0.00008323, &                         
          0.13837101,0.14113200,0.13930500,0.13283101, &                         
          0.12349200,0.10796400,0.08890490,0.06646480, &                         
          0.04485990,0.00489554,0.00405264,0.00320313, &                         
          0.00234742,0.00151159,0.00058438,0.00008253, &                         
          0.13834500,0.14093500,0.13896500,0.13262001, &                         
          0.12326900,0.10828900,0.08950050,0.06674610, &                         
          0.04476560,0.00489624,0.00400962,0.00317423, &                         
          0.00233479,0.00148249,0.00058590,0.00008253, &                         
          0.13831300,0.14069000,0.13871400,0.13247600, &                         
          0.12251400,0.10831300,0.08977090,0.06776920, &                         
          0.04498390,0.00484111,0.00398948,0.00316069, &                         
          0.00229741,0.00150104,0.00058608,0.00008253, &                         
          0.14027201,0.14420401,0.14215700,0.13446601, &                         
          0.12303700,0.10596100,0.08650370,0.06409570, &                         
          0.04312310,0.00471110,0.00393954,0.00310850, &                         
          0.00229588,0.00146366,0.00058194,0.00008253/                           
      DATA FRACREFB5/ &                                                             
!     From P = 1.17 mb.                                                          
          0.14339100,0.14358699,0.13935301,0.13306700, &                         
          0.12135700,0.10590600,0.08688240,0.06553220, &                         
          0.04446740,0.00483580,0.00399413,0.00316225, &                         
          0.00233007,0.00149135,0.00056246,0.00008059, &                         
          0.14330500,0.14430299,0.14053699,0.13355300, &                         
          0.12151200,0.10529100,0.08627630,0.06505230, &                         
          0.04385850,0.00476555,0.00395010,0.00313878, &                         
          0.00232273,0.00149354,0.00056246,0.00008059, &                         
          0.14328399,0.14442700,0.14078601,0.13390100, &                         
          0.12132600,0.10510600,0.08613660,0.06494630, &                         
          0.04381310,0.00475378,0.00394166,0.00313076, &                         
          0.00231235,0.00149159,0.00056301,0.00008059, &                         
          0.14326900,0.14453100,0.14114200,0.13397101, &                         
          0.12127200,0.10493400,0.08601380,0.06483360, &                         
          0.04378900,0.00474655,0.00393549,0.00312583, &                         
          0.00230686,0.00148433,0.00056502,0.00008059, &                         
          0.14328900,0.14532700,0.14179000,0.13384600, &                         
          0.12093700,0.10461500,0.08573010,0.06461340, &                         
          0.04366570,0.00473087,0.00392539,0.00311238, &                         
          0.00229865,0.00147572,0.00056517,0.00007939/                           
                                                                                 
      DATA CCL45/ &                                                                 
           26.1407,  53.9776,  63.8085,  36.1701, &                              
           15.4099, 10.23116,  4.82948,  5.03836, &                              
           1.75558,0.,0.,0., &                                                   
           0.,0.,0.,0./                                                          
                                                                                 
! Data                                                                           
                                                                                 
      DATA FRACREFA6/ &                                                             
!     From P = 706 mb.                                                           
          0.13739009,0.14259538,0.14033118,0.13547136, &                         
          0.12569460,0.11028396,0.08626066,0.06245148, &                         
          0.04309394,0.00473551,0.00403920,0.00321695, &                         
          0.00232470,0.00147662,0.00056095,0.00007373/                           
                                                                                 
      DATA CFC11ADJ6/ &                                                             
           0.,  0., 36.7627,  150.757,   &                                      
           81.4109, 74.9112, 56.9325, 49.3226, &                                 
           57.1074, 66.1202, 109.557, 89.0562, &                                 
           149.865, 196.140, 258.393, 80.9923/                                   
      DATA CFC126/ &                                                                
           62.8368, 43.2626, 26.7549, 22.2487, &                                 
           23.5029, 34.8323, 26.2335, 23.2306, &                                 
           18.4062, 13.9534, 22.6268, 24.2604, &                                 
           30.0088, 26.3634, 15.8237, 57.5050/                                   
      DATA ABSCO26/ &                                                               
           7.44852E-05, 6.29208E-05, 7.34031E-05, 6.65218E-05, &                 
           7.87511E-05, 1.22489E-04, 3.39785E-04, 9.33040E-04, &                 
           1.54323E-03, 4.07220E-04, 4.34332E-04, 8.76418E-05, &                 
           9.80381E-05, 3.51680E-05, 5.31766E-05, 1.01542E-05/                   
                                                                                 
! Data                                                                           
                                                                                 
      DATA FRACREFA7/ &                                                             
          0.16461779, 0.14889984, 0.14233345, 0.13156526, &                      
          0.11679733, 0.09988949, 0.08078653, 0.06006384, &                      
          0.04028391, 0.00435899, 0.00359173, 0.00281707, &                      
          0.00206767, 0.00135012, 0.00050720, 0.00007146, &                      
          0.16442357, 0.14944240, 0.14245804, 0.13111183, &                      
          0.11688625, 0.09983791, 0.08085148, 0.05993948, &                      
          0.04028057, 0.00435939, 0.00358708, 0.00284036, &                      
          0.00208869, 0.00133256, 0.00049260, 0.00006931, &                      
          0.16368519, 0.15018989, 0.14262174, 0.13084342, &                      
          0.11682195, 0.09996257, 0.08074036, 0.05985692, &                      
          0.04045362, 0.00436208, 0.00358257, 0.00287122, &                      
          0.00211004, 0.00133804, 0.00049260, 0.00006931, &                      
          0.16274056, 0.15133780, 0.14228874, 0.13081114, &                      
          0.11688486, 0.09979610, 0.08073687, 0.05996741, &                      
          0.04040616, 0.00439869, 0.00368910, 0.00293041, &                      
          0.00211604, 0.00133536, 0.00049260, 0.00006931, &                      
          0.16176532, 0.15207882, 0.14226955, 0.13079646, &                      
          0.11688191, 0.09966998, 0.08066384, 0.06020275, &                      
          0.04047901, 0.00446696, 0.00377456, 0.00294410, &                      
          0.00211082, 0.00133536, 0.00049260, 0.00006931, &                      
          0.15993737, 0.15305527, 0.14259829, 0.13078023, &                      
          0.11686983, 0.09980131, 0.08058286, 0.06031430, &                      
          0.04082833, 0.00450509, 0.00377574, 0.00294823, &                      
          0.00210977, 0.00133302, 0.00049260, 0.00006931, &                      
          0.15371189, 0.15592396, 0.14430280, 0.13076764, &                      
          0.11720382, 0.10023471, 0.08066396, 0.06073554, &                      
          0.04121581, 0.00451202, 0.00377832, 0.00294609, &                      
          0.00210943, 0.00133336, 0.00049260, 0.00006931, &                      
          0.14262275, 0.14572631, 0.14560597, 0.13736825, &                      
          0.12271351, 0.10419556, 0.08294533, 0.06199794, &                      
          0.04157615, 0.00452842, 0.00377704, 0.00293852, &                      
          0.00211034, 0.00133278, 0.00049259, 0.00006931, &                      
          0.14500433, 0.14590444, 0.14430299, 0.13770708, &                      
          0.12288283, 0.10350952, 0.08269450, 0.06130579, &                      
          0.04144571, 0.00452096, 0.00377382, 0.00294532, &                      
          0.00210943, 0.00133228, 0.00049260, 0.00006931/                        
      DATA FRACREFB7/ &                                                             
          0.15355594,0.15310939,0.14274909,0.13129812, &                         
          0.11736792,0.10118213,0.08215259,0.06165591, &                         
          0.04164486,0.00451141,0.00372837,0.00294095, &                         
          0.00215259,0.00136792,0.00051233,0.00007075/                           
                                                                                 
      DATA ABSCO27/ &                                                               
          9.30038E-05, 1.74061E-04, 2.09293E-04, 2.52360E-04, &                  
          3.13404E-04, 4.16619E-04, 6.27394E-04, 1.29386E-03, &                  
          4.05192E-03, 3.97050E-03, 7.00634E-04, 6.06617E-04, &                  
          7.66978E-04, 6.70661E-04, 7.89971E-04, 7.55709E-04/                    
                                                                                 
! Data                                                                           
                                                                                 
      DATA FRACREFA8/ &                                                             
!     From P = 1053.6 mb.                                                        
          0.15309700,0.15450300,0.14458799,0.13098200, &                         
          0.11817900,0.09953490,0.08132080,0.06139960, &                         
          0.04132010,0.00446788,0.00372533,0.00294053, &                         
          0.00211371,0.00128122,0.00048050,0.00006759/                           
      DATA FRACREFB8/ &                                                             
!     From P = 28.9 mb.                                                          
          0.14105400,0.14728899,0.14264800,0.13331699, &                         
          0.12034100,0.10467000,0.08574980,0.06469390, &                         
          0.04394640,0.00481284,0.00397375,0.00315006, &                         
          0.00228636,0.00144606,0.00054604,0.00007697/                           
                                                                                 
      DATA CFC128/ &                                                                
           85.4027, 89.4696, 74.0959, 67.7480, &                                 
           61.2444, 59.9073, 60.8296, 63.0998, &                                 
           59.6110, 64.0735, 57.2622, 58.9721, &                                 
           43.5505, 26.1192, 32.7023, 32.8667/                                   
      DATA CFC22ADJ8/ &                                                             
!     Original CFC22 is multiplied by 1.485 to account for the 780-850 cm-1      
!     and 1290-1335 cm-1 bands.                                                  
           135.335, 89.6642, 76.2375, 65.9748, &                                 
           63.1164, 60.2935, 64.0299, 75.4264, &                                 
           51.3018, 7.07911, 5.86928, 0.398693, &                                
           2.82885, 9.12751, 6.28271, 0./                                        
      DATA ABSCO2A8/ &                                                              
           1.11233E-05, 3.92400E-05, 6.62059E-05, 8.51687E-05, &                 
           7.79035E-05, 1.34058E-04, 2.82553E-04, 5.41741E-04, &                 
           1.47029E-05, 2.34982E-05, 6.91094E-08, 8.48917E-08, &                 
           6.58783E-08, 4.64849E-08, 3.62742E-08, 3.62742E-08/                   
      DATA ABSCO2B8/ &                                                              
           4.10977E-09, 5.65200E-08, 1.70800E-07, 4.16840E-07, &                 
           9.53684E-07, 2.36468E-06, 7.29502E-06, 4.93883E-05, &                 
           5.10440E-04, 9.75248E-04, 1.36495E-03, 2.40451E-03, &                 
           4.50277E-03, 2.24486E-02, 4.06756E-02, 2.17447E-10/                   
      DATA ABSN2OA8/ &                                                              
           1.28527E-02,5.28651E-02,1.01668E-01,1.57224E-01, &                    
           2.76947E-01,4.93048E-01,6.71387E-01,3.48809E-01, &                    
           4.19840E-01,3.13558E-01,2.44432E-01,2.05108E-01, &                    
           1.21423E-01,1.22158E-01,1.49702E-01,1.47799E-01/                      
      DATA ABSN2OB8/ &                                                              
           3.15864E-03,4.87347E-03,8.63235E-03,2.16053E-02, &                    
           3.63699E-02,7.89149E-02,3.53807E-01,1.27140E-00, &                    
           2.31464E-00,7.75834E-02,5.15063E-02,4.07059E-02, &                    
           5.91947E-02,5.83546E-02,3.12716E-01,1.47456E-01/                      
                                                                                 
!  Data                                                                          
                                                                                 
      DATA FRACREFA9/ &                                                             
!     From P = 1053.6 mb.                                                        
          0.16898900,0.15898301,0.13575301,0.12600900, &                         
          0.11545800,0.09879170,0.08106830,0.06063440, &                         
          0.03988780,0.00421760,0.00346635,0.00278779, &                         
          0.00206225,0.00132324,0.00050033,0.00007038, &                         
          0.18209399,0.15315101,0.13571000,0.12504999, &                         
          0.11379100,0.09680810,0.08008570,0.05970280, &                         
          0.03942860,0.00413383,0.00343186,0.00275558, &                         
          0.00204657,0.00130219,0.00045454,0.00005664, &                         
          0.18459500,0.15512000,0.13395500,0.12576801, &                         
          0.11276800,0.09645190,0.07956650,0.05903340, &                         
          0.03887050,0.00412226,0.00339453,0.00273518, &                         
          0.00196922,0.00119411,0.00040263,0.00005664, &                         
          0.18458800,0.15859900,0.13278100,0.12589300, &                         
          0.11272700,0.09599660,0.07903030,0.05843600, &                         
          0.03843400,0.00405181,0.00337980,0.00263818, &                         
          0.00186869,0.00111807,0.00040263,0.00005664, &                         
          0.18459301,0.16176100,0.13235000,0.12528200, &                         
          0.11237100,0.09618840,0.07833760,0.05800770, &                         
          0.03787610,0.00408253,0.00330363,0.00250445, &                         
          0.00176725,0.00111753,0.00040263,0.00005664, &                         
          0.18454400,0.16505300,0.13221300,0.12476600, &                         
          0.11158300,0.09618120,0.07797340,0.05740380, &                         
          0.03742820,0.00392691,0.00312208,0.00246306, &                         
          0.00176735,0.00111721,0.00040263,0.00005664, &                         
          0.18452001,0.16697501,0.13445500,0.12391300, &                         
          0.11059100,0.09596890,0.07761050,0.05643200, &                         
          0.03686520,0.00377086,0.00309351,0.00246297, &                         
          0.00176765,0.00111700,0.00040263,0.00005664, &                         
          0.18460999,0.16854499,0.13922299,0.12266400, &                         
          0.10962200,0.09452030,0.07653800,0.05551340, &                         
          0.03609660,0.00377043,0.00309367,0.00246304, &                         
          0.00176749,0.00111689,0.00040263,0.00005664, &                         
          0.18312500,0.16787501,0.14720701,0.12766500, &                         
          0.10890900,0.08935530,0.07310870,0.05443140, &                         
          0.03566380,0.00376446,0.00309521,0.00246510, &                         
          0.00176139,0.00111543,0.00040263,0.00005664/                           
      DATA FRACREFB9/ &                                                             
!     From P = 0.071 mb.                                                         
          0.20148601,0.15252700,0.13376500,0.12184600, &                         
          0.10767800,0.09307410,0.07674570,0.05876940, &                         
          0.04001480,0.00424612,0.00346896,0.00269954, &                         
          0.00196864,0.00122562,0.00043628,0.00004892/                           
                                                                                 
      DATA ABSN2O9/ &                                                               
!     From P = 952 mb.                                                           
           3.26267E-01,2.42869E-00,1.15455E+01,7.39478E-00, &                    
           5.16550E-00,2.54474E-00,3.53082E-00,3.82278E-00, &                    
           1.81297E-00,6.65313E-01,1.23652E-01,1.83895E-03, &                    
           1.70592E-03,2.68434E-09,0.,0., &                                      
!     From P = 620 mb.                                                           
           2.08632E-01,1.11865E+00,4.95975E+00,8.10907E+00, &                    
           1.10408E+01,5.45460E+00,4.18611E+00,3.53422E+00, &                    
           2.54164E+00,3.65093E-01,5.84480E-01,2.26918E-01, &                    
           1.36230E-03,5.54400E-10,6.83703E-10,0., &                             
!     From P = 313 mb.                                                           
           6.20022E-02,2.69521E-01,9.81928E-01,1.65004E-00, &                    
           3.08089E-00,5.38696E-00,1.14600E+01,2.41211E+01, &                    
           1.69655E+01,1.37556E-00,5.43254E-01,3.52079E-01, &                    
           4.31888E-01,4.82523E-06,5.74747E-11,0./                               
                                                                                 
! Data                                                                           
                                                                                 
      DATA FRACREFA10/ &                                                             
!     From P = 473 mb.                                                           
          0.16271301,0.15141940,0.14065412,0.12899506, &                         
          0.11607002,0.10142808,0.08116794,0.06104711, &                         
          0.04146209,0.00447386,0.00372902,0.00287258, &                         
          0.00206028,0.00134634,0.00049232,0.00006927/                           
      DATA FRACREFB10/ &                                                             
!     From P = 1.17 mb.                                                          
          0.16571465,0.15262246,0.14036226,0.12620729, &                         
          0.11477834,0.09967982,0.08155201,0.06159503, &                         
          0.04196607,0.00453940,0.00376881,0.00300437, &                         
          0.00223034,0.00139432,0.00051516,0.00007095/                           
                                                                                 
! Data                                                                           
                                                                                 
      DATA FRACREFA11/ &                                                             
!     From P = 473 mb.                                                           
          0.14152819,0.13811260,0.14312185,0.13705885, &                         
          0.11944738,0.10570189,0.08866373,0.06565409, &                         
          0.04428961,0.00481540,0.00387058,0.00329187, &                         
          0.00238294,0.00150971,0.00049287,0.00005980/                           
      DATA FRACREFB11/ &                                                             
!     From P = 1.17 mb.                                                          
          0.10874039,0.15164889,0.15149839,0.14515044, &                         
          0.12486220,0.10725017,0.08715712,0.06463144, &                         
          0.04332319,0.00441193,0.00393819,0.00305960, &                         
          0.00224221,0.00145100,0.00055586,0.00007934/                           
                                                                                 
! Data                                                                           
                                                                                 
      DATA FRACREFA12/ &                                                             
!     From P = 706.3 mb.                                                         
          0.21245100,0.15164700,0.14486700,0.13075501, &                         
          0.11629600,0.09266050,0.06579930,0.04524000, &                         
          0.03072870,0.00284297,0.00234660,0.00185208, &                         
          0.00133978,0.00082214,0.00031016,0.00004363, &                         
          0.14703900,0.16937999,0.15605700,0.14159000, &                         
          0.12088500,0.10058500,0.06809110,0.05131470, &                         
          0.03487040,0.00327281,0.00250183,0.00190024, &                         
          0.00133978,0.00082214,0.00031016,0.00004363, &                         
          0.13689300,0.16610400,0.15723500,0.14299500, &                         
          0.12399400,0.09907820,0.07169690,0.05367370, &                         
          0.03671630,0.00378148,0.00290510,0.00221076, &                         
          0.00142810,0.00093527,0.00031016,0.00004363, &                         
          0.13054299,0.16273800,0.15874299,0.14279599, &                         
          0.12674300,0.09664900,0.07462200,0.05620080, &                         
          0.03789090,0.00411690,0.00322920,0.00245036, &                         
          0.00178303,0.00098595,0.00040802,0.00010150, &                         
          0.12828299,0.15824600,0.15688400,0.14449100, &                         
          0.12787800,0.09517830,0.07679350,0.05890820, &                         
          0.03883570,0.00442304,0.00346796,0.00255333, &                         
          0.00212519,0.00116168,0.00067065,0.00010150, &                         
          0.12649800,0.15195100,0.15646499,0.14569700, &                         
          0.12669300,0.09653520,0.07887920,0.06106920, &                         
          0.04043910,0.00430390,0.00364453,0.00314360, &                         
          0.00203206,0.00187787,0.00067075,0.00010150, &                         
          0.12500300,0.14460599,0.15672199,0.14724600, &                         
          0.11978900,0.10190200,0.08196710,0.06315770, &                         
          0.04240100,0.00433645,0.00404097,0.00329466, &                         
          0.00288491,0.00187803,0.00067093,0.00010150, &                         
          0.12317200,0.14118700,0.15242000,0.13794300, &                         
          0.12119200,0.10655400,0.08808350,0.06521370, &                         
          0.04505680,0.00485949,0.00477105,0.00401468, &                         
          0.00288491,0.00187786,0.00067110,0.00010150, &                         
          0.10193600,0.11693000,0.13236099,0.14053200, &                         
          0.13749801,0.12193100,0.10221000,0.07448910, &                         
          0.05205320,0.00572312,0.00476882,0.00403380, &                         
          0.00288871,0.00187396,0.00067218,0.00010150/                           
                                                                                 
! Data                                                                           
                                                                                 
      DATA FRACREFA13/ &                                                             
!     From P = 706.3 mb.                                                         
          0.17683899,0.17319500,0.15712699,0.13604601, &                         
          0.10776200,0.08750010,0.06808820,0.04905150, &                         
          0.03280360,0.00350836,0.00281864,0.00219862, &                         
          0.00160943,0.00101885,0.00038147,0.00005348, &                         
          0.17535400,0.16999300,0.15610200,0.13589200, &                         
          0.10842100,0.08988550,0.06943920,0.04974900, &                         
          0.03323400,0.00352752,0.00289402,0.00231003, &                         
          0.00174659,0.00101884,0.00038147,0.00005348, &                         
          0.17409500,0.16846400,0.15641899,0.13503000, &                         
          0.10838600,0.08985800,0.07092720,0.05075710, &                         
          0.03364180,0.00354241,0.00303507,0.00243391, &                         
          0.00177502,0.00114638,0.00043585,0.00005348, &                         
          0.17248300,0.16778600,0.15543500,0.13496999, &                         
          0.10826300,0.09028740,0.07156720,0.05187120, &                         
          0.03424890,0.00363933,0.00324715,0.00255030, &                         
          0.00187380,0.00116978,0.00051229,0.00009768, &                         
          0.17061099,0.16715799,0.15405200,0.13471501, &                         
          0.10896400,0.09069460,0.07229760,0.05218280, &                         
          0.03555340,0.00379576,0.00330240,0.00274693, &                         
          0.00201587,0.00119598,0.00061885,0.00009768, &                         
          0.16789700,0.16629100,0.15270300,0.13360199, &                         
          0.11047200,0.09151080,0.07325000,0.05261450, &                         
          0.03657990,0.00450092,0.00349537,0.00283321, &                         
          0.00208396,0.00140354,0.00066587,0.00009768, &                         
          0.16412200,0.16387400,0.15211500,0.13062200, &                         
          0.11325100,0.09348130,0.07381380,0.05434740, &                         
          0.03803160,0.00481346,0.00393592,0.00296633, &                         
          0.00222532,0.00163762,0.00066648,0.00009768, &                         
          0.15513401,0.15768200,0.14850400,0.13330200, &                         
          0.11446500,0.09868230,0.07642050,0.05624170, &                         
          0.04197810,0.00502288,0.00429452,0.00315347, &                         
          0.00263559,0.00171772,0.00066860,0.00009768, &                         
          0.15732600,0.15223300,0.14271900,0.13563600, &                         
          0.11859600,0.10274200,0.07934560,0.05763410, &                         
          0.03921740,0.00437741,0.00337921,0.00280212, &                         
          0.00200156,0.00124812,0.00064664,0.00009768/                           
                                                                                 
! Data                                                                           
                                                                                 
      DATA FRACREFA14/ &                                                             
!     From P = 1053.6 mb.                                                        
          0.18446200,0.16795200,0.14949700,0.12036000, &                         
          0.10440100,0.09024280,0.07435880,0.05629380, &                         
          0.03825420,0.00417276,0.00345278,0.00272949, &                         
          0.00200378,0.00127404,0.00050721,0.00004141/                           
      DATA FRACREFB14/ &                                                             
!     From P = 0.64 mb.                                                          
          0.19128500,0.16495700,0.14146100,0.11904500, &                         
          0.10350200,0.09151190,0.07604270,0.05806020, &                         
          0.03979950,0.00423959,0.00357439,0.00287559, &                         
          0.00198860,0.00116529,0.00043616,0.00005987/                           
                                                                                 
! Data                                                                           
                                                                                 
      DATA FRACREFA15/ &                                                             
!     From P = 1053.6 mb.                                                        
          0.11287100,0.12070200,0.12729000,0.12858100, &                         
          0.12743001,0.11961800,0.10290400,0.07888980, &                         
          0.05900120,0.00667979,0.00552926,0.00436993, &                         
          0.00320611,0.00204765,0.00077371,0.00010894, &                         
          0.13918801,0.16353001,0.16155800,0.14090499, &                         
          0.11322300,0.08757720,0.07225720,0.05173390, &                         
          0.04731360,0.00667979,0.00552926,0.00436993, &                         
          0.00320611,0.00204765,0.00077371,0.00010894, &                         
          0.14687300,0.17853101,0.15664500,0.13351700, &                         
          0.10791200,0.08684320,0.07158090,0.05198410, &                         
          0.04340110,0.00667979,0.00552926,0.00436993, &                         
          0.00320611,0.00204765,0.00077371,0.00010894, &                         
          0.15760700,0.17759100,0.15158001,0.13193300, &                         
          0.10742800,0.08693760,0.07159490,0.05196250, &                         
          0.04065270,0.00667979,0.00552926,0.00436993, &                         
          0.00320611,0.00204765,0.00077371,0.00010894, &                         
          0.16646700,0.17299300,0.15018500,0.13138700, &                         
          0.10735900,0.08713110,0.07130330,0.05279420, &                         
          0.03766730,0.00667979,0.00552926,0.00436993, &                         
          0.00320611,0.00204765,0.00077371,0.00010894, &                         
          0.17546000,0.16666500,0.14969499,0.13105400, &                         
          0.10782500,0.08718610,0.07156770,0.05308320, &                         
          0.03753960,0.00432465,0.00509623,0.00436993, &                         
          0.00320611,0.00204765,0.00077371,0.00010894, &                         
          0.18378501,0.16064601,0.14940400,0.13146400, &                         
          0.10810300,0.08775740,0.07115360,0.05400040, &                         
          0.03689970,0.00388333,0.00323610,0.00353414, &                         
          0.00320611,0.00204765,0.00077371,0.00010894, &                         
          0.18966800,0.15744300,0.14993000,0.13152599, &                         
          0.10899200,0.08858690,0.07142920,0.05399600, &                         
          0.03433460,0.00374886,0.00302066,0.00240653, &                         
          0.00199205,0.00204765,0.00077371,0.00010894, &                         
          0.11887100,0.12479600,0.12569501,0.12839900, &                         
          0.12473500,0.12012800,0.11086700,0.08493590, &                         
          0.05063770,0.00328723,0.00266849,0.00210232, &                         
          0.00152114,0.00095635,0.00035374,0.00004980/                           
                                                                                 
! Data                                                                           
                                                                                 
      DATA FRACREFA16/ &                                                             
!     From P = 862.6 mb.                                                         
          0.17356300,0.18880001,0.17704099,0.13661300, &                         
          0.10691600,0.08222480,0.05939860,0.04230810, &                         
          0.02526330,0.00244532,0.00193541,0.00150415, &                         
          0.00103528,0.00067068,0.00024951,0.00003348, &                         
          0.17779499,0.19837400,0.16557600,0.13470000, &                         
          0.11013600,0.08342720,0.05987030,0.03938700, &                         
          0.02293650,0.00238849,0.00192400,0.00149921, &                         
          0.00103539,0.00067150,0.00024822,0.00003348, &                         
          0.18535601,0.19407199,0.16053200,0.13300700, &                         
          0.10779000,0.08408500,0.06480450,0.04070160, &                         
          0.02203590,0.00227779,0.00189074,0.00146888, &                         
          0.00103147,0.00066770,0.00024751,0.00003348, &                         
          0.19139200,0.18917400,0.15748601,0.13240699, &                         
          0.10557300,0.08383260,0.06724060,0.04364450, &                         
          0.02175820,0.00225436,0.00184421,0.00143153, &                         
          0.00103027,0.00066066,0.00024222,0.00003148, &                         
          0.19547801,0.18539500,0.15442000,0.13114899, &                         
          0.10515600,0.08350350,0.06909780,0.04671630, &                         
          0.02168820,0.00224400,0.00182009,0.00139098, &                         
          0.00102582,0.00065367,0.00023202,0.00003148, &                         
          0.19757500,0.18266800,0.15208900,0.12897800, &                         
          0.10637200,0.08391220,0.06989830,0.04964120, &                         
          0.02155800,0.00224310,0.00177358,0.00138184, &                         
          0.00101538,0.00063370,0.00023227,0.00003148, &                         
          0.20145500,0.17692900,0.14940600,0.12690400, &                         
          0.10828800,0.08553720,0.07004940,0.05153430, &                         
          0.02268740,0.00216943,0.00178603,0.00137754, &                         
          0.00098344,0.00063165,0.00023218,0.00003148, &                         
          0.20383500,0.17047501,0.14570600,0.12679300, &                         
          0.11043100,0.08719150,0.07045440,0.05345420, &                         
          0.02448340,0.00215839,0.00175893,0.00138296, &                         
          0.00098318,0.00063188,0.00023199,0.00003148, &                         
          0.18680701,0.15961801,0.15092900,0.13049100, &                         
          0.11418400,0.09380540,0.07093450,0.05664280, &                         
          0.02938410,0.00217751,0.00176766,0.00138275, &                         
          0.00098377,0.00063181,0.00023193,0.00003148/                           
               

!
! end of data 3
!

!-----------------------------------------------------------------------

! start data 4

      DATA NXMOL  /2/
      DATA IXINDX /0,2,3,0,31*0/
                                                                  
!
! end of data 4
!
!-----------------------------------------------------------------------

! start data 5
                                                                  
!     
!  Longwave spectral band data                                                   

      DATA WAVENUM1(1) /10./, WAVENUM2(1) /250./, DELWAVE(1) /240./              
      DATA WAVENUM1(2) /250./, WAVENUM2(2) /500./, DELWAVE(2) /250./             
      DATA WAVENUM1(3) /500./, WAVENUM2(3) /630./, DELWAVE(3) /130./             
      DATA WAVENUM1(4) /630./, WAVENUM2(4) /700./, DELWAVE(4) /70./              
      DATA WAVENUM1(5) /700./, WAVENUM2(5) /820./, DELWAVE(5) /120./             
      DATA WAVENUM1(6) /820./, WAVENUM2(6) /980./, DELWAVE(6) /160./             
      DATA WAVENUM1(7) /980./, WAVENUM2(7) /1080./, DELWAVE(7) /100./            
      DATA WAVENUM1(8) /1080./, WAVENUM2(8) /1180./, DELWAVE(8) /100./           
      DATA WAVENUM1(9) /1180./, WAVENUM2(9) /1390./, DELWAVE(9) /210./           
      DATA WAVENUM1(10) /1390./,WAVENUM2(10) /1480./,DELWAVE(10) /90./           
      DATA WAVENUM1(11) /1480./,WAVENUM2(11) /1800./,DELWAVE(11) /320./          
      DATA WAVENUM1(12) /1800./,WAVENUM2(12) /2080./,DELWAVE(12) /280./          
      DATA WAVENUM1(13) /2080./,WAVENUM2(13) /2250./,DELWAVE(13) /170./          
      DATA WAVENUM1(14) /2250./,WAVENUM2(14) /2380./,DELWAVE(14) /130./          
      DATA WAVENUM1(15) /2380./,WAVENUM2(15) /2600./,DELWAVE(15) /220./          
      DATA WAVENUM1(16) /2600./,WAVENUM2(16) /3000./,DELWAVE(16) /400./          
                                                                                 
!
! end of data 5
!
!-----------------------------------------------------------------------

! start data 6

              
      DATA NG  /16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16/                 
      DATA NSPA /1, 1,10, 9, 9, 1, 9, 1,11, 1, 1, 9, 9, 1, 9, 9/                 
      DATA NSPB /1, 1, 5, 6, 5, 0, 1, 1, 1, 1, 1, 0, 0, 1, 0, 0/                 
                                                                                 
!     HEATFAC is the factor by which one must multiply delta-flux/               
!     delta-pressure, with flux in w/m-2 and pressure in mbar, to get            
!     the heating rate in units of degrees/day.  It is equal to                  
!           (g)x(#sec/day)x(1e-5)/(specific heat of air at const. p)             
!        =  (9.8066)(3600)(1e-5)/(1.004)                                         

      DATA HEATFAC /8.4391/                                                      
                                                                           
!     These pressures are chosen such that the ln of the first pressure          
!     has only a few non-zero digits (i.e. ln(PREF(1)) = 6.96000) and            
!     each subsequent ln(pressure) differs from the previous one by 0.2.         

      DATA PREF / &                                                                 
          1.05363E+03,8.62642E+02,7.06272E+02,5.78246E+02,4.73428E+02, & 
          3.87610E+02,3.17348E+02,2.59823E+02,2.12725E+02,1.74164E+02, & 
          1.42594E+02,1.16746E+02,9.55835E+01,7.82571E+01,6.40715E+01, & 
          5.24573E+01,4.29484E+01,3.51632E+01,2.87892E+01,2.35706E+01, & 
          1.92980E+01,1.57998E+01,1.29358E+01,1.05910E+01,8.67114E+00, & 
          7.09933E+00,5.81244E+00,4.75882E+00,3.89619E+00,3.18993E+00, & 
          2.61170E+00,2.13828E+00,1.75067E+00,1.43333E+00,1.17351E+00, & 
          9.60789E-01,7.86628E-01,6.44036E-01,5.27292E-01,4.31710E-01, & 
          3.53455E-01,2.89384E-01,2.36928E-01,1.93980E-01,1.58817E-01, & 
          1.30029E-01,1.06458E-01,8.71608E-02,7.13612E-02,5.84256E-02, & 
          4.78349E-02,3.91639E-02,3.20647E-02,2.62523E-02,2.14936E-02, & 
          1.75975E-02,1.44076E-02,1.17959E-02,9.65769E-03/                       
      DATA PREFLOG / &                                                              
           6.9600E+00, 6.7600E+00, 6.5600E+00, 6.3600E+00, 6.1600E+00, & 
           5.9600E+00, 5.7600E+00, 5.5600E+00, 5.3600E+00, 5.1600E+00, & 
           4.9600E+00, 4.7600E+00, 4.5600E+00, 4.3600E+00, 4.1600E+00, & 
           3.9600E+00, 3.7600E+00, 3.5600E+00, 3.3600E+00, 3.1600E+00, & 
           2.9600E+00, 2.7600E+00, 2.5600E+00, 2.3600E+00, 2.1600E+00, & 
           1.9600E+00, 1.7600E+00, 1.5600E+00, 1.3600E+00, 1.1600E+00, & 
           9.6000E-01, 7.6000E-01, 5.6000E-01, 3.6000E-01, 1.6000E-01, & 
          -4.0000E-02,-2.4000E-01,-4.4000E-01,-6.4000E-01,-8.4000E-01, & 
          -1.0400E+00,-1.2400E+00,-1.4400E+00,-1.6400E+00,-1.8400E+00, & 
          -2.0400E+00,-2.2400E+00,-2.4400E+00,-2.6400E+00,-2.8400E+00, & 
          -3.0400E+00,-3.2400E+00,-3.4400E+00,-3.6400E+00,-3.8400E+00, & 
          -4.0400E+00,-4.2400E+00,-4.4400E+00,-4.6400E+00/                       
!     These are the temperatures associated with the respective                  
!     pressures for the MLS standard atmosphere.                                 
      DATA TREF / &                                                                 
           2.9420E+02, 2.8799E+02, 2.7894E+02, 2.6925E+02, 2.5983E+02, & 
           2.5017E+02, 2.4077E+02, 2.3179E+02, 2.2306E+02, 2.1578E+02, & 
           2.1570E+02, 2.1570E+02, 2.1570E+02, 2.1706E+02, 2.1858E+02, & 
           2.2018E+02, 2.2174E+02, 2.2328E+02, 2.2479E+02, 2.2655E+02, & 
           2.2834E+02, 2.3113E+02, 2.3401E+02, 2.3703E+02, 2.4022E+02, & 
           2.4371E+02, 2.4726E+02, 2.5085E+02, 2.5457E+02, 2.5832E+02, & 
           2.6216E+02, 2.6606E+02, 2.6999E+02, 2.7340E+02, 2.7536E+02, & 
           2.7568E+02, 2.7372E+02, 2.7163E+02, 2.6955E+02, 2.6593E+02, & 
           2.6211E+02, 2.5828E+02, 2.5360E+02, 2.4854E+02, 2.4348E+02, & 
           2.3809E+02, 2.3206E+02, 2.2603E+02, 2.2000E+02, 2.1435E+02, & 
           2.0887E+02, 2.0340E+02, 1.9792E+02, 1.9290E+02, 1.8809E+02, & 
           1.8329E+02, 1.7849E+02, 1.7394E+02, 1.7212E+02/                       
                                                                                 
!
! end of data 6
!
!-----------------------------------------------------------------------

! start data 7

      DATA (TOTPLNK(IDATA, 1),IDATA=1,50)/ &                                                
      1.13735E-06,1.15150E-06,1.16569E-06,1.17992E-06,1.19419E-06, & 
      1.20850E-06,1.22285E-06,1.23723E-06,1.25164E-06,1.26610E-06, & 
      1.28059E-06,1.29511E-06,1.30967E-06,1.32426E-06,1.33889E-06, & 
      1.35355E-06,1.36824E-06,1.38296E-06,1.39772E-06,1.41250E-06, & 
      1.42732E-06,1.44217E-06,1.45704E-06,1.47195E-06,1.48689E-06, & 
      1.50185E-06,1.51684E-06,1.53186E-06,1.54691E-06,1.56198E-06, & 
      1.57709E-06,1.59222E-06,1.60737E-06,1.62255E-06,1.63776E-06, & 
      1.65299E-06,1.66825E-06,1.68352E-06,1.69883E-06,1.71416E-06, & 
      1.72951E-06,1.74488E-06,1.76028E-06,1.77570E-06,1.79114E-06, & 
      1.80661E-06,1.82210E-06,1.83760E-06,1.85313E-06,1.86868E-06/               
      DATA (TOTPLNK(IDATA, 1),IDATA=51,100)/ &                                              
      1.88425E-06,1.89985E-06,1.91546E-06,1.93109E-06,1.94674E-06, & 
      1.96241E-06,1.97811E-06,1.99381E-06,2.00954E-06,2.02529E-06, & 
      2.04105E-06,2.05684E-06,2.07264E-06,2.08846E-06,2.10429E-06, & 
      2.12015E-06,2.13602E-06,2.15190E-06,2.16781E-06,2.18373E-06, & 
      2.19966E-06,2.21562E-06,2.23159E-06,2.24758E-06,2.26358E-06, & 
      2.27959E-06,2.29562E-06,2.31167E-06,2.32773E-06,2.34381E-06, & 
      2.35990E-06,2.37601E-06,2.39212E-06,2.40825E-06,2.42440E-06, & 
      2.44056E-06,2.45673E-06,2.47292E-06,2.48912E-06,2.50533E-06, & 
      2.52157E-06,2.53781E-06,2.55406E-06,2.57032E-06,2.58660E-06, & 
      2.60289E-06,2.61919E-06,2.63550E-06,2.65183E-06,2.66817E-06/               
      DATA (TOTPLNK(IDATA, 1),IDATA=101,150)/ &                                             
      2.68452E-06,2.70088E-06,2.71726E-06,2.73364E-06,2.75003E-06, & 
      2.76644E-06,2.78286E-06,2.79929E-06,2.81572E-06,2.83218E-06, & 
      2.84864E-06,2.86510E-06,2.88159E-06,2.89807E-06,2.91458E-06, & 
      2.93109E-06,2.94762E-06,2.96415E-06,2.98068E-06,2.99724E-06, & 
      3.01379E-06,3.03036E-06,3.04693E-06,3.06353E-06,3.08013E-06, & 
      3.09674E-06,3.11335E-06,3.12998E-06,3.14661E-06,3.16324E-06, & 
      3.17989E-06,3.19656E-06,3.21323E-06,3.22991E-06,3.24658E-06, & 
      3.26328E-06,3.27998E-06,3.29669E-06,3.31341E-06,3.33013E-06, & 
      3.34686E-06,3.36360E-06,3.38034E-06,3.39709E-06,3.41387E-06, & 
      3.43063E-06,3.44742E-06,3.46420E-06,3.48099E-06,3.49779E-06/               
      DATA (TOTPLNK(IDATA, 1),IDATA=151,181)/ &                                             
      3.51461E-06,3.53141E-06,3.54824E-06,3.56506E-06,3.58191E-06, & 
      3.59875E-06,3.61559E-06,3.63244E-06,3.64931E-06,3.66617E-06, & 
      3.68305E-06,3.69992E-06,3.71682E-06,3.73372E-06,3.75061E-06, & 
      3.76753E-06,3.78443E-06,3.80136E-06,3.81829E-06,3.83522E-06, & 
      3.85215E-06,3.86910E-06,3.88605E-06,3.90301E-06,3.91997E-06, & 
      3.93694E-06,3.95390E-06,3.97087E-06,3.98788E-06,4.00485E-06, & 
      4.02187E-06/                                                               
      DATA (TOTPLNK(IDATA, 2),IDATA=1,50)/ &                                                
      2.13441E-06,2.18076E-06,2.22758E-06,2.27489E-06,2.32268E-06, & 
      2.37093E-06,2.41966E-06,2.46886E-06,2.51852E-06,2.56864E-06, & 
      2.61922E-06,2.67026E-06,2.72175E-06,2.77370E-06,2.82609E-06, & 
      2.87893E-06,2.93221E-06,2.98593E-06,3.04008E-06,3.09468E-06, & 
      3.14970E-06,3.20515E-06,3.26103E-06,3.31732E-06,3.37404E-06, & 
      3.43118E-06,3.48873E-06,3.54669E-06,3.60506E-06,3.66383E-06, & 
      3.72301E-06,3.78259E-06,3.84256E-06,3.90293E-06,3.96368E-06, & 
      4.02483E-06,4.08636E-06,4.14828E-06,4.21057E-06,4.27324E-06, & 
      4.33629E-06,4.39971E-06,4.46350E-06,4.52765E-06,4.59217E-06, & 
      4.65705E-06,4.72228E-06,4.78787E-06,4.85382E-06,4.92011E-06/               
      DATA (TOTPLNK(IDATA, 2),IDATA=51,100)/ &                                              
      4.98675E-06,5.05374E-06,5.12106E-06,5.18873E-06,5.25674E-06, & 
      5.32507E-06,5.39374E-06,5.46274E-06,5.53207E-06,5.60172E-06, & 
      5.67169E-06,5.74198E-06,5.81259E-06,5.88352E-06,5.95475E-06, & 
      6.02629E-06,6.09815E-06,6.17030E-06,6.24276E-06,6.31552E-06, & 
      6.38858E-06,6.46192E-06,6.53557E-06,6.60950E-06,6.68373E-06, & 
      6.75824E-06,6.83303E-06,6.90810E-06,6.98346E-06,7.05909E-06, & 
      7.13500E-06,7.21117E-06,7.28763E-06,7.36435E-06,7.44134E-06, & 
      7.51859E-06,7.59611E-06,7.67388E-06,7.75192E-06,7.83021E-06, & 
      7.90875E-06,7.98755E-06,8.06660E-06,8.14589E-06,8.22544E-06, & 
      8.30522E-06,8.38526E-06,8.46553E-06,8.54604E-06,8.62679E-06/               
      DATA (TOTPLNK(IDATA, 2),IDATA=101,150)/ &                                             
      8.70777E-06,8.78899E-06,8.87043E-06,8.95211E-06,9.03402E-06, & 
      9.11616E-06,9.19852E-06,9.28109E-06,9.36390E-06,9.44692E-06, & 
      9.53015E-06,9.61361E-06,9.69729E-06,9.78117E-06,9.86526E-06, & 
      9.94957E-06,1.00341E-05,1.01188E-05,1.02037E-05,1.02888E-05, & 
      1.03742E-05,1.04597E-05,1.05454E-05,1.06313E-05,1.07175E-05, & 
      1.08038E-05,1.08903E-05,1.09770E-05,1.10639E-05,1.11509E-05, & 
      1.12382E-05,1.13257E-05,1.14133E-05,1.15011E-05,1.15891E-05, & 
      1.16773E-05,1.17656E-05,1.18542E-05,1.19429E-05,1.20317E-05, & 
      1.21208E-05,1.22100E-05,1.22994E-05,1.23890E-05,1.24787E-05, & 
      1.25686E-05,1.26587E-05,1.27489E-05,1.28393E-05,1.29299E-05/               
      DATA (TOTPLNK(IDATA, 2),IDATA=151,181)/ &                                             
      1.30206E-05,1.31115E-05,1.32025E-05,1.32937E-05,1.33850E-05, & 
      1.34765E-05,1.35682E-05,1.36600E-05,1.37520E-05,1.38441E-05, & 
      1.39364E-05,1.40288E-05,1.41213E-05,1.42140E-05,1.43069E-05, & 
      1.43999E-05,1.44930E-05,1.45863E-05,1.46797E-05,1.47733E-05, & 
      1.48670E-05,1.49608E-05,1.50548E-05,1.51489E-05,1.52431E-05, & 
      1.53375E-05,1.54320E-05,1.55267E-05,1.56214E-05,1.57164E-05, & 
      1.58114E-05/                                                               
      DATA (TOTPLNK(IDATA, 3),IDATA=1,50)/ &                                                
      1.34822E-06,1.39134E-06,1.43530E-06,1.48010E-06,1.52574E-06, & 
      1.57222E-06,1.61956E-06,1.66774E-06,1.71678E-06,1.76666E-06, & 
      1.81741E-06,1.86901E-06,1.92147E-06,1.97479E-06,2.02898E-06, & 
      2.08402E-06,2.13993E-06,2.19671E-06,2.25435E-06,2.31285E-06, & 
      2.37222E-06,2.43246E-06,2.49356E-06,2.55553E-06,2.61837E-06, & 
      2.68207E-06,2.74664E-06,2.81207E-06,2.87837E-06,2.94554E-06, & 
      3.01356E-06,3.08245E-06,3.15221E-06,3.22282E-06,3.29429E-06, & 
      3.36662E-06,3.43982E-06,3.51386E-06,3.58876E-06,3.66451E-06, & 
      3.74112E-06,3.81857E-06,3.89688E-06,3.97602E-06,4.05601E-06, & 
      4.13685E-06,4.21852E-06,4.30104E-06,4.38438E-06,4.46857E-06/               
      DATA (TOTPLNK(IDATA, 3),IDATA=51,100)/ &                                              
      4.55358E-06,4.63943E-06,4.72610E-06,4.81359E-06,4.90191E-06, & 
      4.99105E-06,5.08100E-06,5.17176E-06,5.26335E-06,5.35573E-06, & 
      5.44892E-06,5.54292E-06,5.63772E-06,5.73331E-06,5.82970E-06, & 
      5.92688E-06,6.02485E-06,6.12360E-06,6.22314E-06,6.32346E-06, & 
      6.42455E-06,6.52641E-06,6.62906E-06,6.73247E-06,6.83664E-06, & 
      6.94156E-06,7.04725E-06,7.15370E-06,7.26089E-06,7.36883E-06, & 
      7.47752E-06,7.58695E-06,7.69712E-06,7.80801E-06,7.91965E-06, & 
      8.03201E-06,8.14510E-06,8.25891E-06,8.37343E-06,8.48867E-06, & 
      8.60463E-06,8.72128E-06,8.83865E-06,8.95672E-06,9.07548E-06, & 
      9.19495E-06,9.31510E-06,9.43594E-06,9.55745E-06,9.67966E-06/               
      DATA (TOTPLNK(IDATA, 3),IDATA=101,150)/ &                                             
      9.80254E-06,9.92609E-06,1.00503E-05,1.01752E-05,1.03008E-05, & 
      1.04270E-05,1.05539E-05,1.06814E-05,1.08096E-05,1.09384E-05, & 
      1.10679E-05,1.11980E-05,1.13288E-05,1.14601E-05,1.15922E-05, & 
      1.17248E-05,1.18581E-05,1.19920E-05,1.21265E-05,1.22616E-05, & 
      1.23973E-05,1.25337E-05,1.26706E-05,1.28081E-05,1.29463E-05, & 
      1.30850E-05,1.32243E-05,1.33642E-05,1.35047E-05,1.36458E-05, & 
      1.37875E-05,1.39297E-05,1.40725E-05,1.42159E-05,1.43598E-05, & 
      1.45044E-05,1.46494E-05,1.47950E-05,1.49412E-05,1.50879E-05, & 
      1.52352E-05,1.53830E-05,1.55314E-05,1.56803E-05,1.58297E-05, & 
      1.59797E-05,1.61302E-05,1.62812E-05,1.64327E-05,1.65848E-05/               
      DATA (TOTPLNK(IDATA, 3),IDATA=151,181)/ &                                             
      1.67374E-05,1.68904E-05,1.70441E-05,1.71982E-05,1.73528E-05, & 
      1.75079E-05,1.76635E-05,1.78197E-05,1.79763E-05,1.81334E-05, & 
      1.82910E-05,1.84491E-05,1.86076E-05,1.87667E-05,1.89262E-05, & 
      1.90862E-05,1.92467E-05,1.94076E-05,1.95690E-05,1.97309E-05, & 
      1.98932E-05,2.00560E-05,2.02193E-05,2.03830E-05,2.05472E-05, & 
      2.07118E-05,2.08768E-05,2.10423E-05,2.12083E-05,2.13747E-05, & 
      2.15414E-05/                                                               
      DATA (TOTPLNK(IDATA, 4),IDATA=1,50)/ &                                                
      8.90528E-07,9.24222E-07,9.58757E-07,9.94141E-07,1.03038E-06, & 
      1.06748E-06,1.10545E-06,1.14430E-06,1.18403E-06,1.22465E-06, & 
      1.26618E-06,1.30860E-06,1.35193E-06,1.39619E-06,1.44136E-06, & 
      1.48746E-06,1.53449E-06,1.58246E-06,1.63138E-06,1.68124E-06, & 
      1.73206E-06,1.78383E-06,1.83657E-06,1.89028E-06,1.94495E-06, & 
      2.00060E-06,2.05724E-06,2.11485E-06,2.17344E-06,2.23303E-06, & 
      2.29361E-06,2.35519E-06,2.41777E-06,2.48134E-06,2.54592E-06, & 
      2.61151E-06,2.67810E-06,2.74571E-06,2.81433E-06,2.88396E-06, & 
      2.95461E-06,3.02628E-06,3.09896E-06,3.17267E-06,3.24741E-06, & 
      3.32316E-06,3.39994E-06,3.47774E-06,3.55657E-06,3.63642E-06/               
      DATA (TOTPLNK(IDATA, 4),IDATA=51,100)/ &                                              
      3.71731E-06,3.79922E-06,3.88216E-06,3.96612E-06,4.05112E-06, & 
      4.13714E-06,4.22419E-06,4.31227E-06,4.40137E-06,4.49151E-06, & 
      4.58266E-06,4.67485E-06,4.76806E-06,4.86229E-06,4.95754E-06, & 
      5.05383E-06,5.15113E-06,5.24946E-06,5.34879E-06,5.44916E-06, & 
      5.55053E-06,5.65292E-06,5.75632E-06,5.86073E-06,5.96616E-06, & 
      6.07260E-06,6.18003E-06,6.28848E-06,6.39794E-06,6.50838E-06, & 
      6.61983E-06,6.73229E-06,6.84573E-06,6.96016E-06,7.07559E-06, & 
      7.19200E-06,7.30940E-06,7.42779E-06,7.54715E-06,7.66749E-06, & 
      7.78882E-06,7.91110E-06,8.03436E-06,8.15859E-06,8.28379E-06, & 
      8.40994E-06,8.53706E-06,8.66515E-06,8.79418E-06,8.92416E-06/               
      DATA (TOTPLNK(IDATA, 4),IDATA=101,150)/ &                                             
      9.05510E-06,9.18697E-06,9.31979E-06,9.45356E-06,9.58826E-06, & 
      9.72389E-06,9.86046E-06,9.99793E-06,1.01364E-05,1.02757E-05, & 
      1.04159E-05,1.05571E-05,1.06992E-05,1.08422E-05,1.09861E-05, & 
      1.11309E-05,1.12766E-05,1.14232E-05,1.15707E-05,1.17190E-05, & 
      1.18683E-05,1.20184E-05,1.21695E-05,1.23214E-05,1.24741E-05, & 
      1.26277E-05,1.27822E-05,1.29376E-05,1.30939E-05,1.32509E-05, & 
      1.34088E-05,1.35676E-05,1.37273E-05,1.38877E-05,1.40490E-05, & 
      1.42112E-05,1.43742E-05,1.45380E-05,1.47026E-05,1.48680E-05, & 
      1.50343E-05,1.52014E-05,1.53692E-05,1.55379E-05,1.57074E-05, & 
      1.58778E-05,1.60488E-05,1.62207E-05,1.63934E-05,1.65669E-05/               
      DATA (TOTPLNK(IDATA, 4),IDATA=151,181)/ &                                             
      1.67411E-05,1.69162E-05,1.70920E-05,1.72685E-05,1.74459E-05, & 
      1.76240E-05,1.78029E-05,1.79825E-05,1.81629E-05,1.83440E-05, & 
      1.85259E-05,1.87086E-05,1.88919E-05,1.90760E-05,1.92609E-05, & 
      1.94465E-05,1.96327E-05,1.98199E-05,2.00076E-05,2.01961E-05, & 
      2.03853E-05,2.05752E-05,2.07658E-05,2.09571E-05,2.11491E-05, & 
      2.13418E-05,2.15352E-05,2.17294E-05,2.19241E-05,2.21196E-05, & 
      2.23158E-05/                                                               
      DATA (TOTPLNK(IDATA, 5),IDATA=1,50)/ &                                                
      5.70230E-07,5.94788E-07,6.20085E-07,6.46130E-07,6.72936E-07, & 
      7.00512E-07,7.28869E-07,7.58019E-07,7.87971E-07,8.18734E-07, & 
      8.50320E-07,8.82738E-07,9.15999E-07,9.50110E-07,9.85084E-07, & 
      1.02093E-06,1.05765E-06,1.09527E-06,1.13378E-06,1.17320E-06, & 
      1.21353E-06,1.25479E-06,1.29698E-06,1.34011E-06,1.38419E-06, & 
      1.42923E-06,1.47523E-06,1.52221E-06,1.57016E-06,1.61910E-06, & 
      1.66904E-06,1.71997E-06,1.77192E-06,1.82488E-06,1.87886E-06, & 
      1.93387E-06,1.98991E-06,2.04699E-06,2.10512E-06,2.16430E-06, & 
      2.22454E-06,2.28584E-06,2.34821E-06,2.41166E-06,2.47618E-06, & 
      2.54178E-06,2.60847E-06,2.67626E-06,2.74514E-06,2.81512E-06/               
      DATA (TOTPLNK(IDATA, 5),IDATA=51,100)/ &                                              
      2.88621E-06,2.95841E-06,3.03172E-06,3.10615E-06,3.18170E-06, & 
      3.25838E-06,3.33618E-06,3.41511E-06,3.49518E-06,3.57639E-06, & 
      3.65873E-06,3.74221E-06,3.82684E-06,3.91262E-06,3.99955E-06, & 
      4.08763E-06,4.17686E-06,4.26725E-06,4.35880E-06,4.45150E-06, & 
      4.54537E-06,4.64039E-06,4.73659E-06,4.83394E-06,4.93246E-06, & 
      5.03215E-06,5.13301E-06,5.23504E-06,5.33823E-06,5.44260E-06, & 
      5.54814E-06,5.65484E-06,5.76272E-06,5.87177E-06,5.98199E-06, & 
      6.09339E-06,6.20596E-06,6.31969E-06,6.43460E-06,6.55068E-06, & 
      6.66793E-06,6.78636E-06,6.90595E-06,7.02670E-06,7.14863E-06, & 
      7.27173E-06,7.39599E-06,7.52142E-06,7.64802E-06,7.77577E-06/               
      DATA (TOTPLNK(IDATA, 5),IDATA=101,150)/ &                                             
      7.90469E-06,8.03477E-06,8.16601E-06,8.29841E-06,8.43198E-06, & 
      8.56669E-06,8.70256E-06,8.83957E-06,8.97775E-06,9.11706E-06, & 
      9.25753E-06,9.39915E-06,9.54190E-06,9.68580E-06,9.83085E-06, & 
      9.97704E-06,1.01243E-05,1.02728E-05,1.04224E-05,1.05731E-05, & 
      1.07249E-05,1.08779E-05,1.10320E-05,1.11872E-05,1.13435E-05, & 
      1.15009E-05,1.16595E-05,1.18191E-05,1.19799E-05,1.21418E-05, & 
      1.23048E-05,1.24688E-05,1.26340E-05,1.28003E-05,1.29676E-05, & 
      1.31361E-05,1.33056E-05,1.34762E-05,1.36479E-05,1.38207E-05, & 
      1.39945E-05,1.41694E-05,1.43454E-05,1.45225E-05,1.47006E-05, & 
      1.48797E-05,1.50600E-05,1.52413E-05,1.54236E-05,1.56070E-05/               
      DATA (TOTPLNK(IDATA, 5),IDATA=151,181)/ &                                             
      1.57914E-05,1.59768E-05,1.61633E-05,1.63509E-05,1.65394E-05, & 
      1.67290E-05,1.69197E-05,1.71113E-05,1.73040E-05,1.74976E-05, & 
      1.76923E-05,1.78880E-05,1.80847E-05,1.82824E-05,1.84811E-05, & 
      1.86808E-05,1.88814E-05,1.90831E-05,1.92857E-05,1.94894E-05, & 
      1.96940E-05,1.98996E-05,2.01061E-05,2.03136E-05,2.05221E-05, & 
      2.07316E-05,2.09420E-05,2.11533E-05,2.13657E-05,2.15789E-05, & 
      2.17931E-05/                                                               
      DATA (TOTPLNK(IDATA, 6),IDATA=1,50)/ &                                                
      2.73493E-07,2.87408E-07,3.01848E-07,3.16825E-07,3.32352E-07, & 
      3.48439E-07,3.65100E-07,3.82346E-07,4.00189E-07,4.18641E-07, & 
      4.37715E-07,4.57422E-07,4.77774E-07,4.98784E-07,5.20464E-07, & 
      5.42824E-07,5.65879E-07,5.89638E-07,6.14115E-07,6.39320E-07, & 
      6.65266E-07,6.91965E-07,7.19427E-07,7.47666E-07,7.76691E-07, & 
      8.06516E-07,8.37151E-07,8.68607E-07,9.00896E-07,9.34029E-07, & 
      9.68018E-07,1.00287E-06,1.03860E-06,1.07522E-06,1.11274E-06, & 
      1.15117E-06,1.19052E-06,1.23079E-06,1.27201E-06,1.31418E-06, & 
      1.35731E-06,1.40141E-06,1.44650E-06,1.49257E-06,1.53965E-06, & 
      1.58773E-06,1.63684E-06,1.68697E-06,1.73815E-06,1.79037E-06/               
      DATA (TOTPLNK(IDATA, 6),IDATA=51,100)/ &                                              
      1.84365E-06,1.89799E-06,1.95341E-06,2.00991E-06,2.06750E-06, & 
      2.12619E-06,2.18599E-06,2.24691E-06,2.30895E-06,2.37212E-06, & 
      2.43643E-06,2.50189E-06,2.56851E-06,2.63628E-06,2.70523E-06, & 
      2.77536E-06,2.84666E-06,2.91916E-06,2.99286E-06,3.06776E-06, & 
      3.14387E-06,3.22120E-06,3.29975E-06,3.37953E-06,3.46054E-06, & 
      3.54280E-06,3.62630E-06,3.71105E-06,3.79707E-06,3.88434E-06, & 
      3.97288E-06,4.06270E-06,4.15380E-06,4.24617E-06,4.33984E-06, & 
      4.43479E-06,4.53104E-06,4.62860E-06,4.72746E-06,4.82763E-06, & 
      4.92911E-06,5.03191E-06,5.13603E-06,5.24147E-06,5.34824E-06, & 
      5.45634E-06,5.56578E-06,5.67656E-06,5.78867E-06,5.90213E-06/               
      DATA (TOTPLNK(IDATA, 6),IDATA=101,150)/ &                                             
      6.01694E-06,6.13309E-06,6.25060E-06,6.36947E-06,6.48968E-06, & 
      6.61126E-06,6.73420E-06,6.85850E-06,6.98417E-06,7.11120E-06, & 
      7.23961E-06,7.36938E-06,7.50053E-06,7.63305E-06,7.76694E-06, & 
      7.90221E-06,8.03887E-06,8.17690E-06,8.31632E-06,8.45710E-06, & 
      8.59928E-06,8.74282E-06,8.88776E-06,9.03409E-06,9.18179E-06, & 
      9.33088E-06,9.48136E-06,9.63323E-06,9.78648E-06,9.94111E-06, & 
      1.00971E-05,1.02545E-05,1.04133E-05,1.05735E-05,1.07351E-05, & 
      1.08980E-05,1.10624E-05,1.12281E-05,1.13952E-05,1.15637E-05, & 
      1.17335E-05,1.19048E-05,1.20774E-05,1.22514E-05,1.24268E-05, & 
      1.26036E-05,1.27817E-05,1.29612E-05,1.31421E-05,1.33244E-05/               
      DATA (TOTPLNK(IDATA, 6),IDATA=151,181)/ &                                             
      1.35080E-05,1.36930E-05,1.38794E-05,1.40672E-05,1.42563E-05, & 
      1.44468E-05,1.46386E-05,1.48318E-05,1.50264E-05,1.52223E-05, & 
      1.54196E-05,1.56182E-05,1.58182E-05,1.60196E-05,1.62223E-05, & 
      1.64263E-05,1.66317E-05,1.68384E-05,1.70465E-05,1.72559E-05, & 
      1.74666E-05,1.76787E-05,1.78921E-05,1.81069E-05,1.83230E-05, & 
      1.85404E-05,1.87591E-05,1.89791E-05,1.92005E-05,1.94232E-05, & 
      1.96471E-05/                                                               
      DATA (TOTPLNK(IDATA, 7),IDATA=1,50)/ &                                                
      1.25349E-07,1.32735E-07,1.40458E-07,1.48527E-07,1.56954E-07, & 
      1.65748E-07,1.74920E-07,1.84481E-07,1.94443E-07,2.04814E-07, & 
      2.15608E-07,2.26835E-07,2.38507E-07,2.50634E-07,2.63229E-07, & 
      2.76301E-07,2.89864E-07,3.03930E-07,3.18508E-07,3.33612E-07, & 
      3.49253E-07,3.65443E-07,3.82195E-07,3.99519E-07,4.17428E-07, & 
      4.35934E-07,4.55050E-07,4.74785E-07,4.95155E-07,5.16170E-07, & 
      5.37844E-07,5.60186E-07,5.83211E-07,6.06929E-07,6.31355E-07, & 
      6.56498E-07,6.82373E-07,7.08990E-07,7.36362E-07,7.64501E-07, & 
      7.93420E-07,8.23130E-07,8.53643E-07,8.84971E-07,9.17128E-07, & 
      9.50123E-07,9.83969E-07,1.01868E-06,1.05426E-06,1.09073E-06/               
      DATA (TOTPLNK(IDATA, 7),IDATA=51,100)/ &                                              
      1.12810E-06,1.16638E-06,1.20558E-06,1.24572E-06,1.28680E-06, & 
      1.32883E-06,1.37183E-06,1.41581E-06,1.46078E-06,1.50675E-06, & 
      1.55374E-06,1.60174E-06,1.65078E-06,1.70087E-06,1.75200E-06, & 
      1.80421E-06,1.85749E-06,1.91186E-06,1.96732E-06,2.02389E-06, & 
      2.08159E-06,2.14040E-06,2.20035E-06,2.26146E-06,2.32372E-06, & 
      2.38714E-06,2.45174E-06,2.51753E-06,2.58451E-06,2.65270E-06, & 
      2.72210E-06,2.79272E-06,2.86457E-06,2.93767E-06,3.01201E-06, & 
      3.08761E-06,3.16448E-06,3.24261E-06,3.32204E-06,3.40275E-06, & 
      3.48476E-06,3.56808E-06,3.65271E-06,3.73866E-06,3.82595E-06, & 
      3.91456E-06,4.00453E-06,4.09584E-06,4.18851E-06,4.28254E-06/               
      DATA (TOTPLNK(IDATA, 7),IDATA=101,150)/ &                                             
      4.37796E-06,4.47475E-06,4.57293E-06,4.67249E-06,4.77346E-06, & 
      4.87583E-06,4.97961E-06,5.08481E-06,5.19143E-06,5.29948E-06, & 
      5.40896E-06,5.51989E-06,5.63226E-06,5.74608E-06,5.86136E-06, & 
      5.97810E-06,6.09631E-06,6.21597E-06,6.33713E-06,6.45976E-06, & 
      6.58388E-06,6.70950E-06,6.83661E-06,6.96521E-06,7.09531E-06, & 
      7.22692E-06,7.36005E-06,7.49468E-06,7.63084E-06,7.76851E-06, & 
      7.90773E-06,8.04846E-06,8.19072E-06,8.33452E-06,8.47985E-06, & 
      8.62674E-06,8.77517E-06,8.92514E-06,9.07666E-06,9.22975E-06, & 
      9.38437E-06,9.54057E-06,9.69832E-06,9.85762E-06,1.00185E-05, & 
      1.01810E-05,1.03450E-05,1.05106E-05,1.06777E-05,1.08465E-05/               
      DATA (TOTPLNK(IDATA, 7),IDATA=151,181)/ &                                             
      1.10168E-05,1.11887E-05,1.13621E-05,1.15372E-05,1.17138E-05, & 
      1.18920E-05,1.20718E-05,1.22532E-05,1.24362E-05,1.26207E-05, & 
      1.28069E-05,1.29946E-05,1.31839E-05,1.33749E-05,1.35674E-05, & 
      1.37615E-05,1.39572E-05,1.41544E-05,1.43533E-05,1.45538E-05, & 
      1.47558E-05,1.49595E-05,1.51647E-05,1.53716E-05,1.55800E-05, & 
      1.57900E-05,1.60017E-05,1.62149E-05,1.64296E-05,1.66460E-05, & 
      1.68640E-05/                                                               
      DATA (TOTPLNK(IDATA, 8),IDATA=1,50)/ &                                                
      6.74445E-08,7.18176E-08,7.64153E-08,8.12456E-08,8.63170E-08, & 
      9.16378E-08,9.72168E-08,1.03063E-07,1.09184E-07,1.15591E-07, & 
      1.22292E-07,1.29296E-07,1.36613E-07,1.44253E-07,1.52226E-07, & 
      1.60540E-07,1.69207E-07,1.78236E-07,1.87637E-07,1.97421E-07, & 
      2.07599E-07,2.18181E-07,2.29177E-07,2.40598E-07,2.52456E-07, & 
      2.64761E-07,2.77523E-07,2.90755E-07,3.04468E-07,3.18673E-07, & 
      3.33381E-07,3.48603E-07,3.64352E-07,3.80638E-07,3.97474E-07, & 
      4.14871E-07,4.32841E-07,4.51395E-07,4.70547E-07,4.90306E-07, & 
      5.10687E-07,5.31699E-07,5.53357E-07,5.75670E-07,5.98652E-07, & 
      6.22315E-07,6.46672E-07,6.71731E-07,6.97511E-07,7.24018E-07/               
      DATA (TOTPLNK(IDATA, 8),IDATA=51,100)/ &                                              
      7.51266E-07,7.79269E-07,8.08038E-07,8.37584E-07,8.67922E-07, & 
      8.99061E-07,9.31016E-07,9.63797E-07,9.97417E-07,1.03189E-06, & 
      1.06722E-06,1.10343E-06,1.14053E-06,1.17853E-06,1.21743E-06, & 
      1.25726E-06,1.29803E-06,1.33974E-06,1.38241E-06,1.42606E-06, & 
      1.47068E-06,1.51630E-06,1.56293E-06,1.61056E-06,1.65924E-06, & 
      1.70894E-06,1.75971E-06,1.81153E-06,1.86443E-06,1.91841E-06, & 
      1.97350E-06,2.02968E-06,2.08699E-06,2.14543E-06,2.20500E-06, & 
      2.26573E-06,2.32762E-06,2.39068E-06,2.45492E-06,2.52036E-06, & 
      2.58700E-06,2.65485E-06,2.72393E-06,2.79424E-06,2.86580E-06, & 
      2.93861E-06,3.01269E-06,3.08803E-06,3.16467E-06,3.24259E-06/               
      DATA (TOTPLNK(IDATA, 8),IDATA=101,150)/ &                                             
      3.32181E-06,3.40235E-06,3.48420E-06,3.56739E-06,3.65192E-06, & 
      3.73779E-06,3.82502E-06,3.91362E-06,4.00359E-06,4.09494E-06, & 
      4.18768E-06,4.28182E-06,4.37737E-06,4.47434E-06,4.57273E-06, & 
      4.67254E-06,4.77380E-06,4.87651E-06,4.98067E-06,5.08630E-06, & 
      5.19339E-06,5.30196E-06,5.41201E-06,5.52356E-06,5.63660E-06, & 
      5.75116E-06,5.86722E-06,5.98479E-06,6.10390E-06,6.22453E-06, & 
      6.34669E-06,6.47042E-06,6.59569E-06,6.72252E-06,6.85090E-06, & 
      6.98085E-06,7.11238E-06,7.24549E-06,7.38019E-06,7.51646E-06, & 
      7.65434E-06,7.79382E-06,7.93490E-06,8.07760E-06,8.22192E-06, & 
      8.36784E-06,8.51540E-06,8.66459E-06,8.81542E-06,8.96786E-06/               
      DATA (TOTPLNK(IDATA, 8),IDATA=151,181)/ &                                             
      9.12197E-06,9.27772E-06,9.43513E-06,9.59419E-06,9.75490E-06, & 
      9.91728E-06,1.00813E-05,1.02471E-05,1.04144E-05,1.05835E-05, & 
      1.07543E-05,1.09267E-05,1.11008E-05,1.12766E-05,1.14541E-05, & 
      1.16333E-05,1.18142E-05,1.19969E-05,1.21812E-05,1.23672E-05, & 
      1.25549E-05,1.27443E-05,1.29355E-05,1.31284E-05,1.33229E-05, & 
      1.35193E-05,1.37173E-05,1.39170E-05,1.41185E-05,1.43217E-05, & 
      1.45267E-05/                                                               
      DATA (TOTPLNK(IDATA, 9),IDATA=1,50)/ &                                                
      2.61522E-08,2.80613E-08,3.00838E-08,3.22250E-08,3.44899E-08, & 
      3.68841E-08,3.94129E-08,4.20820E-08,4.48973E-08,4.78646E-08, & 
      5.09901E-08,5.42799E-08,5.77405E-08,6.13784E-08,6.52001E-08, & 
      6.92126E-08,7.34227E-08,7.78375E-08,8.24643E-08,8.73103E-08, & 
      9.23832E-08,9.76905E-08,1.03240E-07,1.09039E-07,1.15097E-07, & 
      1.21421E-07,1.28020E-07,1.34902E-07,1.42075E-07,1.49548E-07, & 
      1.57331E-07,1.65432E-07,1.73860E-07,1.82624E-07,1.91734E-07, & 
      2.01198E-07,2.11028E-07,2.21231E-07,2.31818E-07,2.42799E-07, & 
      2.54184E-07,2.65983E-07,2.78205E-07,2.90862E-07,3.03963E-07, & 
      3.17519E-07,3.31541E-07,3.46039E-07,3.61024E-07,3.76507E-07/               
      DATA (TOTPLNK(IDATA, 9),IDATA=51,100)/ &                                              
      3.92498E-07,4.09008E-07,4.26050E-07,4.43633E-07,4.61769E-07, & 
      4.80469E-07,4.99744E-07,5.19606E-07,5.40067E-07,5.61136E-07, & 
      5.82828E-07,6.05152E-07,6.28120E-07,6.51745E-07,6.76038E-07, & 
      7.01010E-07,7.26674E-07,7.53041E-07,7.80124E-07,8.07933E-07, & 
      8.36482E-07,8.65781E-07,8.95845E-07,9.26683E-07,9.58308E-07, & 
      9.90732E-07,1.02397E-06,1.05803E-06,1.09292E-06,1.12866E-06, & 
      1.16526E-06,1.20274E-06,1.24109E-06,1.28034E-06,1.32050E-06, & 
      1.36158E-06,1.40359E-06,1.44655E-06,1.49046E-06,1.53534E-06, & 
      1.58120E-06,1.62805E-06,1.67591E-06,1.72478E-06,1.77468E-06, & 
      1.82561E-06,1.87760E-06,1.93066E-06,1.98479E-06,2.04000E-06/               
      DATA (TOTPLNK(IDATA, 9),IDATA=101,150)/ &                                             
      2.09631E-06,2.15373E-06,2.21228E-06,2.27196E-06,2.33278E-06, & 
      2.39475E-06,2.45790E-06,2.52222E-06,2.58773E-06,2.65445E-06, & 
      2.72238E-06,2.79152E-06,2.86191E-06,2.93354E-06,3.00643E-06, & 
      3.08058E-06,3.15601E-06,3.23273E-06,3.31075E-06,3.39009E-06, & 
      3.47074E-06,3.55272E-06,3.63605E-06,3.72072E-06,3.80676E-06, & 
      3.89417E-06,3.98297E-06,4.07315E-06,4.16474E-06,4.25774E-06, & 
      4.35217E-06,4.44802E-06,4.54532E-06,4.64406E-06,4.74428E-06, & 
      4.84595E-06,4.94911E-06,5.05376E-06,5.15990E-06,5.26755E-06, & 
      5.37671E-06,5.48741E-06,5.59963E-06,5.71340E-06,5.82871E-06, & 
      5.94559E-06,6.06403E-06,6.18404E-06,6.30565E-06,6.42885E-06/               
      DATA (TOTPLNK(IDATA, 9),IDATA=151,181)/ &                                             
      6.55364E-06,6.68004E-06,6.80806E-06,6.93771E-06,7.06898E-06, & 
      7.20190E-06,7.33646E-06,7.47267E-06,7.61056E-06,7.75010E-06, & 
      7.89133E-06,8.03423E-06,8.17884E-06,8.32514E-06,8.47314E-06, & 
      8.62284E-06,8.77427E-06,8.92743E-06,9.08231E-06,9.23893E-06, & 
      9.39729E-06,9.55741E-06,9.71927E-06,9.88291E-06,1.00483E-05, & 
      1.02155E-05,1.03844E-05,1.05552E-05,1.07277E-05,1.09020E-05, & 
      1.10781E-05/                                                               
      DATA (TOTPLNK(IDATA,10),IDATA=1,50)/ &                                                
      8.89300E-09,9.63263E-09,1.04235E-08,1.12685E-08,1.21703E-08, & 
      1.31321E-08,1.41570E-08,1.52482E-08,1.64090E-08,1.76428E-08, & 
      1.89533E-08,2.03441E-08,2.18190E-08,2.33820E-08,2.50370E-08, & 
      2.67884E-08,2.86402E-08,3.05969E-08,3.26632E-08,3.48436E-08, & 
      3.71429E-08,3.95660E-08,4.21179E-08,4.48040E-08,4.76294E-08, & 
      5.05996E-08,5.37201E-08,5.69966E-08,6.04349E-08,6.40411E-08, & 
      6.78211E-08,7.17812E-08,7.59276E-08,8.02670E-08,8.48059E-08, & 
      8.95508E-08,9.45090E-08,9.96873E-08,1.05093E-07,1.10733E-07, & 
      1.16614E-07,1.22745E-07,1.29133E-07,1.35786E-07,1.42711E-07, & 
      1.49916E-07,1.57410E-07,1.65202E-07,1.73298E-07,1.81709E-07/               
      DATA (TOTPLNK(IDATA,10),IDATA=51,100)/ &                                              
      1.90441E-07,1.99505E-07,2.08908E-07,2.18660E-07,2.28770E-07, & 
      2.39247E-07,2.50101E-07,2.61340E-07,2.72974E-07,2.85013E-07, & 
      2.97467E-07,3.10345E-07,3.23657E-07,3.37413E-07,3.51623E-07, & 
      3.66298E-07,3.81448E-07,3.97082E-07,4.13212E-07,4.29848E-07, & 
      4.47000E-07,4.64680E-07,4.82898E-07,5.01664E-07,5.20991E-07, & 
      5.40888E-07,5.61369E-07,5.82440E-07,6.04118E-07,6.26410E-07, & 
      6.49329E-07,6.72887E-07,6.97095E-07,7.21964E-07,7.47506E-07, & 
      7.73732E-07,8.00655E-07,8.28287E-07,8.56635E-07,8.85717E-07, & 
      9.15542E-07,9.46122E-07,9.77469E-07,1.00960E-06,1.04251E-06, & 
      1.07623E-06,1.11077E-06,1.14613E-06,1.18233E-06,1.21939E-06/               
      DATA (TOTPLNK(IDATA,10),IDATA=101,150)/ &                                             
      1.25730E-06,1.29610E-06,1.33578E-06,1.37636E-06,1.41785E-06, & 
      1.46027E-06,1.50362E-06,1.54792E-06,1.59319E-06,1.63942E-06, & 
      1.68665E-06,1.73487E-06,1.78410E-06,1.83435E-06,1.88564E-06, & 
      1.93797E-06,1.99136E-06,2.04582E-06,2.10137E-06,2.15801E-06, & 
      2.21576E-06,2.27463E-06,2.33462E-06,2.39577E-06,2.45806E-06, & 
      2.52153E-06,2.58617E-06,2.65201E-06,2.71905E-06,2.78730E-06, & 
      2.85678E-06,2.92749E-06,2.99946E-06,3.07269E-06,3.14720E-06, & 
      3.22299E-06,3.30007E-06,3.37847E-06,3.45818E-06,3.53923E-06, & 
      3.62161E-06,3.70535E-06,3.79046E-06,3.87695E-06,3.96481E-06, & 
      4.05409E-06,4.14477E-06,4.23687E-06,4.33040E-06,4.42538E-06/               
      DATA (TOTPLNK(IDATA,10),IDATA=151,181)/ &                                             
      4.52180E-06,4.61969E-06,4.71905E-06,4.81991E-06,4.92226E-06, & 
      5.02611E-06,5.13148E-06,5.23839E-06,5.34681E-06,5.45681E-06, & 
      5.56835E-06,5.68146E-06,5.79614E-06,5.91242E-06,6.03030E-06, & 
      6.14978E-06,6.27088E-06,6.39360E-06,6.51798E-06,6.64398E-06, & 
      6.77165E-06,6.90099E-06,7.03198E-06,7.16468E-06,7.29906E-06, & 
      7.43514E-06,7.57294E-06,7.71244E-06,7.85369E-06,7.99666E-06, & 
      8.14138E-06/                                                               
      DATA (TOTPLNK(IDATA,11),IDATA=1,50)/ &                                                
      2.53767E-09,2.77242E-09,3.02564E-09,3.29851E-09,3.59228E-09, & 
      3.90825E-09,4.24777E-09,4.61227E-09,5.00322E-09,5.42219E-09, & 
      5.87080E-09,6.35072E-09,6.86370E-09,7.41159E-09,7.99628E-09, & 
      8.61974E-09,9.28404E-09,9.99130E-09,1.07437E-08,1.15436E-08, & 
      1.23933E-08,1.32953E-08,1.42522E-08,1.52665E-08,1.63410E-08, & 
      1.74786E-08,1.86820E-08,1.99542E-08,2.12985E-08,2.27179E-08, & 
      2.42158E-08,2.57954E-08,2.74604E-08,2.92141E-08,3.10604E-08, & 
      3.30029E-08,3.50457E-08,3.71925E-08,3.94476E-08,4.18149E-08, & 
      4.42991E-08,4.69043E-08,4.96352E-08,5.24961E-08,5.54921E-08, & 
      5.86277E-08,6.19081E-08,6.53381E-08,6.89231E-08,7.26681E-08/               
      DATA (TOTPLNK(IDATA,11),IDATA=51,100)/ &                                              
      7.65788E-08,8.06604E-08,8.49187E-08,8.93591E-08,9.39879E-08, & 
      9.88106E-08,1.03834E-07,1.09063E-07,1.14504E-07,1.20165E-07, & 
      1.26051E-07,1.32169E-07,1.38525E-07,1.45128E-07,1.51982E-07, & 
      1.59096E-07,1.66477E-07,1.74132E-07,1.82068E-07,1.90292E-07, & 
      1.98813E-07,2.07638E-07,2.16775E-07,2.26231E-07,2.36015E-07, & 
      2.46135E-07,2.56599E-07,2.67415E-07,2.78592E-07,2.90137E-07, & 
      3.02061E-07,3.14371E-07,3.27077E-07,3.40186E-07,3.53710E-07, & 
      3.67655E-07,3.82031E-07,3.96848E-07,4.12116E-07,4.27842E-07, & 
      4.44039E-07,4.60713E-07,4.77876E-07,4.95537E-07,5.13706E-07, & 
      5.32392E-07,5.51608E-07,5.71360E-07,5.91662E-07,6.12521E-07/               
      DATA (TOTPLNK(IDATA,11),IDATA=101,150)/ &                                             
      6.33950E-07,6.55958E-07,6.78556E-07,7.01753E-07,7.25562E-07, & 
      7.49992E-07,7.75055E-07,8.00760E-07,8.27120E-07,8.54145E-07, & 
      8.81845E-07,9.10233E-07,9.39318E-07,9.69113E-07,9.99627E-07, & 
      1.03087E-06,1.06286E-06,1.09561E-06,1.12912E-06,1.16340E-06, & 
      1.19848E-06,1.23435E-06,1.27104E-06,1.30855E-06,1.34690E-06, & 
      1.38609E-06,1.42614E-06,1.46706E-06,1.50886E-06,1.55155E-06, & 
      1.59515E-06,1.63967E-06,1.68512E-06,1.73150E-06,1.77884E-06, & 
      1.82715E-06,1.87643E-06,1.92670E-06,1.97797E-06,2.03026E-06, & 
      2.08356E-06,2.13791E-06,2.19330E-06,2.24975E-06,2.30728E-06, & 
      2.36589E-06,2.42560E-06,2.48641E-06,2.54835E-06,2.61142E-06/               
      DATA (TOTPLNK(IDATA,11),IDATA=151,181)/ &                                             
      2.67563E-06,2.74100E-06,2.80754E-06,2.87526E-06,2.94417E-06, & 
      3.01429E-06,3.08562E-06,3.15819E-06,3.23199E-06,3.30704E-06, & 
      3.38336E-06,3.46096E-06,3.53984E-06,3.62002E-06,3.70151E-06, & 
      3.78433E-06,3.86848E-06,3.95399E-06,4.04084E-06,4.12907E-06, & 
      4.21868E-06,4.30968E-06,4.40209E-06,4.49592E-06,4.59117E-06, & 
      4.68786E-06,4.78600E-06,4.88561E-06,4.98669E-06,5.08926E-06, & 
      5.19332E-06/                                                               
      DATA (TOTPLNK(IDATA,12),IDATA=1,50)/ &                                                
      2.73921E-10,3.04500E-10,3.38056E-10,3.74835E-10,4.15099E-10, & 
      4.59126E-10,5.07214E-10,5.59679E-10,6.16857E-10,6.79103E-10, & 
      7.46796E-10,8.20335E-10,9.00144E-10,9.86671E-10,1.08039E-09, & 
      1.18180E-09,1.29142E-09,1.40982E-09,1.53757E-09,1.67529E-09, & 
      1.82363E-09,1.98327E-09,2.15492E-09,2.33932E-09,2.53726E-09, & 
      2.74957E-09,2.97710E-09,3.22075E-09,3.48145E-09,3.76020E-09, & 
      4.05801E-09,4.37595E-09,4.71513E-09,5.07672E-09,5.46193E-09, & 
      5.87201E-09,6.30827E-09,6.77205E-09,7.26480E-09,7.78794E-09, & 
      8.34304E-09,8.93163E-09,9.55537E-09,1.02159E-08,1.09151E-08, & 
      1.16547E-08,1.24365E-08,1.32625E-08,1.41348E-08,1.50554E-08/               
      DATA (TOTPLNK(IDATA,12),IDATA=51,100)/ &                                              
      1.60264E-08,1.70500E-08,1.81285E-08,1.92642E-08,2.04596E-08, & 
      2.17171E-08,2.30394E-08,2.44289E-08,2.58885E-08,2.74209E-08, & 
      2.90290E-08,3.07157E-08,3.24841E-08,3.43371E-08,3.62782E-08, & 
      3.83103E-08,4.04371E-08,4.26617E-08,4.49878E-08,4.74190E-08, & 
      4.99589E-08,5.26113E-08,5.53801E-08,5.82692E-08,6.12826E-08, & 
      6.44245E-08,6.76991E-08,7.11105E-08,7.46634E-08,7.83621E-08, & 
      8.22112E-08,8.62154E-08,9.03795E-08,9.47081E-08,9.92066E-08, & 
      1.03879E-07,1.08732E-07,1.13770E-07,1.18998E-07,1.24422E-07, & 
      1.30048E-07,1.35880E-07,1.41924E-07,1.48187E-07,1.54675E-07, & 
      1.61392E-07,1.68346E-07,1.75543E-07,1.82988E-07,1.90688E-07/               
      DATA (TOTPLNK(IDATA,12),IDATA=101,150)/ &                                             
      1.98650E-07,2.06880E-07,2.15385E-07,2.24172E-07,2.33247E-07, & 
      2.42617E-07,2.52289E-07,2.62272E-07,2.72571E-07,2.83193E-07, & 
      2.94147E-07,3.05440E-07,3.17080E-07,3.29074E-07,3.41430E-07, & 
      3.54155E-07,3.67259E-07,3.80747E-07,3.94631E-07,4.08916E-07, & 
      4.23611E-07,4.38725E-07,4.54267E-07,4.70245E-07,4.86666E-07, & 
      5.03541E-07,5.20879E-07,5.38687E-07,5.56975E-07,5.75751E-07, & 
      5.95026E-07,6.14808E-07,6.35107E-07,6.55932E-07,6.77293E-07, & 
      6.99197E-07,7.21656E-07,7.44681E-07,7.68278E-07,7.92460E-07, & 
      8.17235E-07,8.42614E-07,8.68606E-07,8.95223E-07,9.22473E-07, & 
      9.50366E-07,9.78915E-07,1.00813E-06,1.03802E-06,1.06859E-06/               
      DATA (TOTPLNK(IDATA,12),IDATA=151,181)/ &                                             
      1.09986E-06,1.13184E-06,1.16453E-06,1.19796E-06,1.23212E-06, & 
      1.26703E-06,1.30270E-06,1.33915E-06,1.37637E-06,1.41440E-06, & 
      1.45322E-06,1.49286E-06,1.53333E-06,1.57464E-06,1.61679E-06, & 
      1.65981E-06,1.70370E-06,1.74847E-06,1.79414E-06,1.84071E-06, & 
      1.88821E-06,1.93663E-06,1.98599E-06,2.03631E-06,2.08759E-06, & 
      2.13985E-06,2.19310E-06,2.24734E-06,2.30260E-06,2.35888E-06, & 
      2.41619E-06/                                                               
      DATA (TOTPLNK(IDATA,13),IDATA=1,50)/ &                                                
      4.53634E-11,5.11435E-11,5.75754E-11,6.47222E-11,7.26531E-11, & 
      8.14420E-11,9.11690E-11,1.01921E-10,1.13790E-10,1.26877E-10, & 
      1.41288E-10,1.57140E-10,1.74555E-10,1.93665E-10,2.14613E-10, & 
      2.37548E-10,2.62633E-10,2.90039E-10,3.19948E-10,3.52558E-10, & 
      3.88073E-10,4.26716E-10,4.68719E-10,5.14331E-10,5.63815E-10, & 
      6.17448E-10,6.75526E-10,7.38358E-10,8.06277E-10,8.79625E-10, & 
      9.58770E-10,1.04410E-09,1.13602E-09,1.23495E-09,1.34135E-09, & 
      1.45568E-09,1.57845E-09,1.71017E-09,1.85139E-09,2.00268E-09, & 
      2.16464E-09,2.33789E-09,2.52309E-09,2.72093E-09,2.93212E-09, & 
      3.15740E-09,3.39757E-09,3.65341E-09,3.92579E-09,4.21559E-09/               
      DATA (TOTPLNK(IDATA,13),IDATA=51,100)/ &                                              
      4.52372E-09,4.85115E-09,5.19886E-09,5.56788E-09,5.95928E-09, & 
      6.37419E-09,6.81375E-09,7.27917E-09,7.77168E-09,8.29256E-09, & 
      8.84317E-09,9.42487E-09,1.00391E-08,1.06873E-08,1.13710E-08, & 
      1.20919E-08,1.28515E-08,1.36514E-08,1.44935E-08,1.53796E-08, & 
      1.63114E-08,1.72909E-08,1.83201E-08,1.94008E-08,2.05354E-08, & 
      2.17258E-08,2.29742E-08,2.42830E-08,2.56545E-08,2.70910E-08, & 
      2.85950E-08,3.01689E-08,3.18155E-08,3.35373E-08,3.53372E-08, & 
      3.72177E-08,3.91818E-08,4.12325E-08,4.33727E-08,4.56056E-08, & 
      4.79342E-08,5.03617E-08,5.28915E-08,5.55270E-08,5.82715E-08, & 
      6.11286E-08,6.41019E-08,6.71951E-08,7.04119E-08,7.37560E-08/               
      DATA (TOTPLNK(IDATA,13),IDATA=101,150)/ &                                             
      7.72315E-08,8.08424E-08,8.45927E-08,8.84866E-08,9.25281E-08, & 
      9.67218E-08,1.01072E-07,1.05583E-07,1.10260E-07,1.15107E-07, & 
      1.20128E-07,1.25330E-07,1.30716E-07,1.36291E-07,1.42061E-07, & 
      1.48031E-07,1.54206E-07,1.60592E-07,1.67192E-07,1.74015E-07, & 
      1.81064E-07,1.88345E-07,1.95865E-07,2.03628E-07,2.11643E-07, & 
      2.19912E-07,2.28443E-07,2.37244E-07,2.46318E-07,2.55673E-07, & 
      2.65316E-07,2.75252E-07,2.85489E-07,2.96033E-07,3.06891E-07, & 
      3.18070E-07,3.29576E-07,3.41417E-07,3.53600E-07,3.66133E-07, & 
      3.79021E-07,3.92274E-07,4.05897E-07,4.19899E-07,4.34288E-07, & 
      4.49071E-07,4.64255E-07,4.79850E-07,4.95863E-07,5.12300E-07/               
      DATA (TOTPLNK(IDATA,13),IDATA=151,181)/ &                                             
      5.29172E-07,5.46486E-07,5.64250E-07,5.82473E-07,6.01164E-07, & 
      6.20329E-07,6.39979E-07,6.60122E-07,6.80767E-07,7.01922E-07, & 
      7.23596E-07,7.45800E-07,7.68539E-07,7.91826E-07,8.15669E-07, & 
      8.40076E-07,8.65058E-07,8.90623E-07,9.16783E-07,9.43544E-07, & 
      9.70917E-07,9.98912E-07,1.02754E-06,1.05681E-06,1.08673E-06, & 
      1.11731E-06,1.14856E-06,1.18050E-06,1.21312E-06,1.24645E-06, & 
      1.28049E-06/                                                               
      DATA (TOTPLNK(IDATA,14),IDATA=1,50)/ &                                                
      1.40113E-11,1.59358E-11,1.80960E-11,2.05171E-11,2.32266E-11, & 
      2.62546E-11,2.96335E-11,3.33990E-11,3.75896E-11,4.22469E-11, & 
      4.74164E-11,5.31466E-11,5.94905E-11,6.65054E-11,7.42522E-11, & 
      8.27975E-11,9.22122E-11,1.02573E-10,1.13961E-10,1.26466E-10, & 
      1.40181E-10,1.55206E-10,1.71651E-10,1.89630E-10,2.09265E-10, & 
      2.30689E-10,2.54040E-10,2.79467E-10,3.07128E-10,3.37190E-10, & 
      3.69833E-10,4.05243E-10,4.43623E-10,4.85183E-10,5.30149E-10, & 
      5.78755E-10,6.31255E-10,6.87910E-10,7.49002E-10,8.14824E-10, & 
      8.85687E-10,9.61914E-10,1.04385E-09,1.13186E-09,1.22631E-09, & 
      1.32761E-09,1.43617E-09,1.55243E-09,1.67686E-09,1.80992E-09/               
      DATA (TOTPLNK(IDATA,14),IDATA=51,100)/ &                                              
      1.95212E-09,2.10399E-09,2.26607E-09,2.43895E-09,2.62321E-09, & 
      2.81949E-09,3.02844E-09,3.25073E-09,3.48707E-09,3.73820E-09, & 
      4.00490E-09,4.28794E-09,4.58819E-09,4.90647E-09,5.24371E-09, & 
      5.60081E-09,5.97875E-09,6.37854E-09,6.80120E-09,7.24782E-09, & 
      7.71950E-09,8.21740E-09,8.74271E-09,9.29666E-09,9.88054E-09, & 
      1.04956E-08,1.11434E-08,1.18251E-08,1.25422E-08,1.32964E-08, & 
      1.40890E-08,1.49217E-08,1.57961E-08,1.67140E-08,1.76771E-08, & 
      1.86870E-08,1.97458E-08,2.08553E-08,2.20175E-08,2.32342E-08, & 
      2.45077E-08,2.58401E-08,2.72334E-08,2.86900E-08,3.02122E-08, & 
      3.18021E-08,3.34624E-08,3.51954E-08,3.70037E-08,3.88899E-08/               
      DATA (TOTPLNK(IDATA,14),IDATA=101,150)/ &                                             
      4.08568E-08,4.29068E-08,4.50429E-08,4.72678E-08,4.95847E-08, & 
      5.19963E-08,5.45058E-08,5.71161E-08,5.98309E-08,6.26529E-08, & 
      6.55857E-08,6.86327E-08,7.17971E-08,7.50829E-08,7.84933E-08, & 
      8.20323E-08,8.57035E-08,8.95105E-08,9.34579E-08,9.75488E-08, & 
      1.01788E-07,1.06179E-07,1.10727E-07,1.15434E-07,1.20307E-07, & 
      1.25350E-07,1.30566E-07,1.35961E-07,1.41539E-07,1.47304E-07, & 
      1.53263E-07,1.59419E-07,1.65778E-07,1.72345E-07,1.79124E-07, & 
      1.86122E-07,1.93343E-07,2.00792E-07,2.08476E-07,2.16400E-07, & 
      2.24568E-07,2.32988E-07,2.41666E-07,2.50605E-07,2.59813E-07, & 
      2.69297E-07,2.79060E-07,2.89111E-07,2.99455E-07,3.10099E-07/               
      DATA (TOTPLNK(IDATA,14),IDATA=151,181)/ &                                             
      3.21049E-07,3.32311E-07,3.43893E-07,3.55801E-07,3.68041E-07, & 
      3.80621E-07,3.93547E-07,4.06826E-07,4.20465E-07,4.34473E-07, & 
      4.48856E-07,4.63620E-07,4.78774E-07,4.94325E-07,5.10280E-07, & 
      5.26648E-07,5.43436E-07,5.60652E-07,5.78302E-07,5.96397E-07, & 
      6.14943E-07,6.33949E-07,6.53421E-07,6.73370E-07,6.93803E-07, & 
      7.14731E-07,7.36157E-07,7.58095E-07,7.80549E-07,8.03533E-07, & 
      8.27050E-07/                                                               
      DATA (TOTPLNK(IDATA,15),IDATA=1,50)/ &                                                
      3.90483E-12,4.47999E-12,5.13122E-12,5.86739E-12,6.69829E-12, & 
      7.63467E-12,8.68833E-12,9.87221E-12,1.12005E-11,1.26885E-11, & 
      1.43534E-11,1.62134E-11,1.82888E-11,2.06012E-11,2.31745E-11, & 
      2.60343E-11,2.92087E-11,3.27277E-11,3.66242E-11,4.09334E-11, & 
      4.56935E-11,5.09455E-11,5.67338E-11,6.31057E-11,7.01127E-11, & 
      7.78096E-11,8.62554E-11,9.55130E-11,1.05651E-10,1.16740E-10, & 
      1.28858E-10,1.42089E-10,1.56519E-10,1.72243E-10,1.89361E-10, & 
      2.07978E-10,2.28209E-10,2.50173E-10,2.73999E-10,2.99820E-10, & 
      3.27782E-10,3.58034E-10,3.90739E-10,4.26067E-10,4.64196E-10, & 
      5.05317E-10,5.49631E-10,5.97347E-10,6.48689E-10,7.03891E-10/               
      DATA (TOTPLNK(IDATA,15),IDATA=51,100)/ &                                              
      7.63201E-10,8.26876E-10,8.95192E-10,9.68430E-10,1.04690E-09, & 
      1.13091E-09,1.22079E-09,1.31689E-09,1.41957E-09,1.52922E-09, & 
      1.64623E-09,1.77101E-09,1.90401E-09,2.04567E-09,2.19647E-09, & 
      2.35690E-09,2.52749E-09,2.70875E-09,2.90127E-09,3.10560E-09, & 
      3.32238E-09,3.55222E-09,3.79578E-09,4.05375E-09,4.32682E-09, & 
      4.61574E-09,4.92128E-09,5.24420E-09,5.58536E-09,5.94558E-09, & 
      6.32575E-09,6.72678E-09,7.14964E-09,7.59526E-09,8.06470E-09, & 
      8.55897E-09,9.07916E-09,9.62638E-09,1.02018E-08,1.08066E-08, & 
      1.14420E-08,1.21092E-08,1.28097E-08,1.35446E-08,1.43155E-08, & 
      1.51237E-08,1.59708E-08,1.68581E-08,1.77873E-08,1.87599E-08/               
      DATA (TOTPLNK(IDATA,15),IDATA=101,150)/ &                                             
      1.97777E-08,2.08423E-08,2.19555E-08,2.31190E-08,2.43348E-08, & 
      2.56045E-08,2.69302E-08,2.83140E-08,2.97578E-08,3.12636E-08, & 
      3.28337E-08,3.44702E-08,3.61755E-08,3.79516E-08,3.98012E-08, & 
      4.17265E-08,4.37300E-08,4.58143E-08,4.79819E-08,5.02355E-08, & 
      5.25777E-08,5.50114E-08,5.75393E-08,6.01644E-08,6.28896E-08, & 
      6.57177E-08,6.86521E-08,7.16959E-08,7.48520E-08,7.81239E-08, & 
      8.15148E-08,8.50282E-08,8.86675E-08,9.24362E-08,9.63380E-08, & 
      1.00376E-07,1.04555E-07,1.08878E-07,1.13349E-07,1.17972E-07, & 
      1.22751E-07,1.27690E-07,1.32793E-07,1.38064E-07,1.43508E-07, & 
      1.49129E-07,1.54931E-07,1.60920E-07,1.67099E-07,1.73473E-07/               
      DATA (TOTPLNK(IDATA,15),IDATA=151,181)/ &                                             
      1.80046E-07,1.86825E-07,1.93812E-07,2.01014E-07,2.08436E-07, & 
      2.16082E-07,2.23957E-07,2.32067E-07,2.40418E-07,2.49013E-07, & 
      2.57860E-07,2.66963E-07,2.76328E-07,2.85961E-07,2.95868E-07, & 
      3.06053E-07,3.16524E-07,3.27286E-07,3.38345E-07,3.49707E-07, & 
      3.61379E-07,3.73367E-07,3.85676E-07,3.98315E-07,4.11287E-07, & 
      4.24602E-07,4.38265E-07,4.52283E-07,4.66662E-07,4.81410E-07, & 
      4.96535E-07/                                                               
      DATA (TOTPLNK(IDATA,16),IDATA=1,50)/ &                                                
      4.65378E-13,5.41927E-13,6.29913E-13,7.30869E-13,8.46510E-13, & 
      9.78750E-13,1.12972E-12,1.30181E-12,1.49764E-12,1.72016E-12, & 
      1.97260E-12,2.25858E-12,2.58206E-12,2.94744E-12,3.35955E-12, & 
      3.82372E-12,4.34581E-12,4.93225E-12,5.59010E-12,6.32711E-12, & 
      7.15171E-12,8.07317E-12,9.10159E-12,1.02480E-11,1.15244E-11, & 
      1.29438E-11,1.45204E-11,1.62697E-11,1.82084E-11,2.03545E-11, & 
      2.27278E-11,2.53494E-11,2.82424E-11,3.14313E-11,3.49431E-11, & 
      3.88064E-11,4.30522E-11,4.77139E-11,5.28273E-11,5.84308E-11, & 
      6.45658E-11,7.12764E-11,7.86103E-11,8.66176E-11,9.53534E-11, & 
      1.04875E-10,1.15245E-10,1.26528E-10,1.38796E-10,1.52123E-10/               
      DATA (TOTPLNK(IDATA,16),IDATA=51,100)/ &                                              
      1.66590E-10,1.82281E-10,1.99287E-10,2.17704E-10,2.37632E-10, & 
      2.59182E-10,2.82468E-10,3.07610E-10,3.34738E-10,3.63988E-10, & 
      3.95504E-10,4.29438E-10,4.65951E-10,5.05212E-10,5.47402E-10, & 
      5.92707E-10,6.41329E-10,6.93477E-10,7.49371E-10,8.09242E-10, & 
      8.73338E-10,9.41911E-10,1.01524E-09,1.09359E-09,1.17728E-09, & 
      1.26660E-09,1.36190E-09,1.46350E-09,1.57177E-09,1.68709E-09, & 
      1.80984E-09,1.94044E-09,2.07932E-09,2.22693E-09,2.38373E-09, & 
      2.55021E-09,2.72689E-09,2.91429E-09,3.11298E-09,3.32353E-09, & 
      3.54655E-09,3.78265E-09,4.03251E-09,4.29679E-09,4.57620E-09, & 
      4.87148E-09,5.18341E-09,5.51276E-09,5.86037E-09,6.22708E-09/               
      DATA (TOTPLNK(IDATA,16),IDATA=101,150)/ &                                             
      6.61381E-09,7.02145E-09,7.45097E-09,7.90336E-09,8.37967E-09, & 
      8.88092E-09,9.40827E-09,9.96280E-09,1.05457E-08,1.11583E-08, & 
      1.18017E-08,1.24773E-08,1.31865E-08,1.39306E-08,1.47111E-08, & 
      1.55295E-08,1.63872E-08,1.72860E-08,1.82274E-08,1.92132E-08, & 
      2.02450E-08,2.13247E-08,2.24541E-08,2.36352E-08,2.48699E-08, & 
      2.61602E-08,2.75082E-08,2.89161E-08,3.03860E-08,3.19203E-08, & 
      3.35213E-08,3.51913E-08,3.69330E-08,3.87486E-08,4.06411E-08, & 
      4.26129E-08,4.46668E-08,4.68058E-08,4.90325E-08,5.13502E-08, & 
      5.37617E-08,5.62703E-08,5.88791E-08,6.15915E-08,6.44107E-08, & 
      6.73404E-08,7.03841E-08,7.35453E-08,7.68278E-08,8.02355E-08/               
      DATA (TOTPLNK(IDATA,16),IDATA=151,181)/ &                                             
      8.37721E-08,8.74419E-08,9.12486E-08,9.51968E-08,9.92905E-08, & 
      1.03534E-07,1.07932E-07,1.12490E-07,1.17211E-07,1.22100E-07, & 
      1.27163E-07,1.32404E-07,1.37829E-07,1.43443E-07,1.49250E-07, & 
      1.55257E-07,1.61470E-07,1.67893E-07,1.74532E-07,1.81394E-07, & 
      1.88485E-07,1.95810E-07,2.03375E-07,2.11189E-07,2.19256E-07, & 
      2.27583E-07,2.36177E-07,2.45046E-07,2.54196E-07,2.63634E-07, & 
      2.73367E-07/                                                               
                                                                                 
      DATA (TOTPLK16(IDATA),IDATA=1,50)/ &                                                  
      4.46128E-13,5.19008E-13,6.02681E-13,6.98580E-13,8.08302E-13, & 
      9.33629E-13,1.07654E-12,1.23925E-12,1.42419E-12,1.63407E-12, & 
      1.87190E-12,2.14099E-12,2.44498E-12,2.78793E-12,3.17424E-12, & 
      3.60881E-12,4.09698E-12,4.64461E-12,5.25813E-12,5.94456E-12, & 
      6.71156E-12,7.56752E-12,8.52154E-12,9.58357E-12,1.07644E-11, & 
      1.20758E-11,1.35304E-11,1.51420E-11,1.69256E-11,1.88973E-11, & 
      2.10746E-11,2.34762E-11,2.61227E-11,2.90356E-11,3.22388E-11, & 
      3.57574E-11,3.96187E-11,4.38519E-11,4.84883E-11,5.35616E-11, & 
      5.91075E-11,6.51647E-11,7.17743E-11,7.89797E-11,8.68284E-11, & 
      9.53697E-11,1.04658E-10,1.14748E-10,1.25701E-10,1.37582E-10/               
      DATA (TOTPLK16(IDATA),IDATA=51,100)/ &                                                
      1.50457E-10,1.64400E-10,1.79487E-10,1.95799E-10,2.13422E-10, & 
      2.32446E-10,2.52970E-10,2.75094E-10,2.98925E-10,3.24578E-10, & 
      3.52172E-10,3.81833E-10,4.13695E-10,4.47897E-10,4.84588E-10, & 
      5.23922E-10,5.66063E-10,6.11182E-10,6.59459E-10,7.11081E-10, & 
      7.66251E-10,8.25172E-10,8.88065E-10,9.55155E-10,1.02668E-09, & 
      1.10290E-09,1.18406E-09,1.27044E-09,1.36233E-09,1.46002E-09, & 
      1.56382E-09,1.67406E-09,1.79108E-09,1.91522E-09,2.04686E-09, & 
      2.18637E-09,2.33416E-09,2.49063E-09,2.65622E-09,2.83136E-09, & 
      3.01653E-09,3.21221E-09,3.41890E-09,3.63712E-09,3.86740E-09, & 
      4.11030E-09,4.36641E-09,4.63631E-09,4.92064E-09,5.22003E-09/               
      DATA (TOTPLK16(IDATA),IDATA=101,150)/ &                                               
      5.53516E-09,5.86670E-09,6.21538E-09,6.58191E-09,6.96708E-09, & 
      7.37165E-09,7.79645E-09,8.24229E-09,8.71007E-09,9.20066E-09, & 
      9.71498E-09,1.02540E-08,1.08186E-08,1.14100E-08,1.20290E-08, & 
      1.26767E-08,1.33544E-08,1.40630E-08,1.48038E-08,1.55780E-08, & 
      1.63867E-08,1.72313E-08,1.81130E-08,1.90332E-08,1.99932E-08, & 
      2.09945E-08,2.20385E-08,2.31267E-08,2.42605E-08,2.54416E-08, & 
      2.66716E-08,2.79520E-08,2.92846E-08,3.06711E-08,3.21133E-08, & 
      3.36128E-08,3.51717E-08,3.67918E-08,3.84749E-08,4.02232E-08, & 
      4.20386E-08,4.39231E-08,4.58790E-08,4.79083E-08,5.00132E-08, & 
      5.21961E-08,5.44592E-08,5.68049E-08,5.92356E-08,6.17537E-08/               
      DATA (TOTPLK16(IDATA),IDATA=151,181)/ &                                               
      6.43617E-08,6.70622E-08,6.98578E-08,7.27511E-08,7.57449E-08, & 
      7.88419E-08,8.20449E-08,8.53568E-08,8.87805E-08,9.23190E-08, & 
      9.59753E-08,9.97526E-08,1.03654E-07,1.07682E-07,1.11841E-07, & 
      1.16134E-07,1.20564E-07,1.25135E-07,1.29850E-07,1.34712E-07, & 
      1.39726E-07,1.44894E-07,1.50221E-07,1.55711E-07,1.61367E-07, & 
      1.67193E-07,1.73193E-07,1.79371E-07,1.85732E-07,1.92279E-07, & 
      1.99016E-07/                                                               

                                                            
                

CONTAINS

!------------------------------------------------------------------
   SUBROUTINE RRTMLWRAD(rthraten,glw,emiss                        &
                       ,p8w,p3d,pi3d                              &
                       ,dz8w,t3d,t8w,rho3d,r,g                    &
                       ,icloud, warm_rain                         &
                       ,ids,ide, jds,jde, kds,kde                 & 
                       ,ims,ime, jms,jme, kms,kme                 &
                       ,its,ite, jts,jte, kts,kte                 &
                       ,qv3d,qc3d,qr3d                            &
                       ,qi3d,qs3d,qg3d,cldfra3d                   &
                       ,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg             &
                                                                  )
!------------------------------------------------------------------
   IMPLICIT NONE
!------------------------------------------------------------------
   LOGICAL, INTENT(IN )      ::        warm_rain
!
   INTEGER, INTENT(IN )      ::        ids,ide, jds,jde, kds,kde, &
                                       ims,ime, jms,jme, kms,kme, &
                                       its,ite, jts,jte, kts,kte

   INTEGER, INTENT(IN )      ::        ICLOUD
!
   REAL, DIMENSION( ims:ime, kms:kme, jms:jme )                 , &
         INTENT(IN   ) ::                                   dz8w, &
                                                             T3D, &
                                                             t8w, &
                                                             p8w, &
                                                             P3D, &
                                                            pi3D, &
                                                           rho3D
!
   REAL, DIMENSION( ims:ime, kms:kme, jms:jme )                 , &
         INTENT(INOUT)  ::                              RTHRATEN
!
   REAL, DIMENSION( ims:ime, jms:jme )                          , &
         INTENT(IN   )  ::                                 EMISS
!
   REAL, DIMENSION( ims:ime, jms:jme )                          , &
         INTENT(INOUT)  ::                                   GLW
!
   REAL, INTENT(IN  )   ::                                   R,G
!
! Optional
!
   REAL, DIMENSION( ims:ime, kms:kme, jms:jme )                 , &
         OPTIONAL                                               , &
         INTENT(IN   ) ::                                         &
                                                        CLDFRA3D, &
                                                            QV3D, &
                                                            QC3D, &
                                                            QR3D, &
                                                            QI3D, &
                                                            QS3D, &
                                                            QG3D

   LOGICAL, OPTIONAL, INTENT(IN )      ::        F_QV,F_QC,F_QR,F_QI,F_QS,F_QG

!  LOCAL VARS
 
   REAL, DIMENSION( kts:kte+1 ) ::                          Pw1D, &
                                                            Tw1D, &
                                                            PHYD

   REAL, DIMENSION( kts:kte ) ::                          TTEN1D, &
                                                        CLDFRA1D, &
                                                            DZ1D, &
                                                             P1D, &
                                                         PHYDMID, &
                                                             T1D, &
                                                            QV1D, &
                                                            QC1D, &
                                                            QR1D, &
                                                            QI1D, &
                                                            QS1D, &
                                                            QG1D
!
    REAL   ::                                   TSFC,GLW0,EMISS0,FP
!
    INTEGER:: i,j,K,NK
    LOGICAL :: predicate

!------------------------------------------------------------------

!-----CALCULATE LONG WAVE RADIATION
!                                                              
   j_loop: DO J=jts,jte
   i_loop: DO I=its,ite

! reverse vars 
! p1D pw1D are in mb

! NEED HYDROSTATIC PRESSURE HERE (MONOTONIC CHANGE WITH HEIGHT)
! PHYD REPLACES P8W, PHYDMID REPLACES P3D
         PHYD(kts) = p8w(I,kts,J)
! first guess
         DO K = KTS,KTE
            PHYD(K+1) = PHYD(K) - G*RHO3D(I,K,J)*DZ8W(I,K,J)
         ENDDO
! correction factor FP to match p8w(I,kts,J)-p8w(I,kte,J)
         FP = (p8w(I,kts,J)-p8w(I,kte,J))/(PHYD(KTS)-PHYD(KTE))
! final pass
         DO K = KTS,KTE
            PHYD(K+1) = PHYD(K) - G*RHO3D(I,K,J)*DZ8W(I,K,J)*FP
            PHYDMID(K)= 0.5*(PHYD(K)+PHYD(K+1))
         ENDDO

         do k=kts,kte+1
            NK=kme-k+kms
!           Pw1D(K) = p8w(I,NK,J)/100.
            Pw1D(K) = PHYD(NK)/100.
            Tw1D(K) = t8w(I,NK,J)
         enddo

         DO K=kts,kte
            QV1D(K)=0.
            QC1D(K)=0.
            QR1D(K)=0.
            QI1D(K)=0.
            QS1D(K)=0.
            CLDFRA1D(k)=0.
         ENDDO

         DO K=kts,kte
            NK=kme-1-K+kms
            QV1D(K)=QV3D(I,NK,J)
            QV1D(K)=max(0.,QV1D(K))
         ENDDO

         DO K=kts,kte
            NK=kme-1-K+kms
            TTEN1D(K)=0.
            T1D(K)=T3D(I,NK,J)
!           P1D(K)=P3D(I,NK,J)/100.
            P1D(K)=PHYDMID(NK)/100.
            DZ1D(K)=dz8w(I,NK,J)
         ENDDO

         IF (ICLOUD .ne. 0) THEN
            IF ( PRESENT( CLDFRA3D ) ) THEN
              DO K=kts,kte
                 NK=kme-1-K+kms
                 CLDFRA1D(k)=CLDFRA3D(I,NK,J)
              ENDDO
            ENDIF

            IF (PRESENT(F_QC) .AND. PRESENT(QC3D)) THEN
              IF ( F_QC) THEN
                 DO K=kts,kte
                    NK=kme-1-K+kms
                    QC1D(K)=QC3D(I,NK,J)
                    QC1D(K)=max(0.,QC1D(K))
                 ENDDO
              ENDIF
            ENDIF

            IF (PRESENT(F_QR) .AND. PRESENT(QR3D)) THEN
              IF ( F_QR) THEN
                 DO K=kts,kte
                    NK=kme-1-K+kms
                    QR1D(K)=QR3D(I,NK,J)
                    QR1D(K)=max(0.,QR1D(K))
                 ENDDO
              ENDIF
            ENDIF

! This logic is tortured because cannot test F_QI unless
! it is present, and order of evaluation of expressions
! is not specified in Fortran

            IF ( PRESENT ( F_QI ) ) THEN
              predicate = F_QI
            ELSE
              predicate = .FALSE.
            ENDIF

            IF (.NOT. predicate .and. .not. warm_rain) THEN
               DO K=kts,kte
                  IF (T1D(K) .lt. 273.15) THEN
                  QI1D(K)=QC1D(K)
                  QS1D(K)=QR1D(K)
                  QC1D(K)=0.
                  QR1D(K)=0.
                  ENDIF
               ENDDO
            ENDIF

            IF (PRESENT(F_QI) .AND. PRESENT(QI3D)) THEN
               DO K=kts,kte
                  NK=kme-1-K+kms
                  QI1D(K)=QI3D(I,NK,J)
                  QI1D(K)=max(0.,QI1D(K))
               ENDDO
            ENDIF

            IF (PRESENT(F_QS) .AND. PRESENT(QS3D)) THEN
               IF (F_QS) THEN
                  DO K=kts,kte
                     NK=kme-1-K+kms
                     QS1D(K)=QS3D(I,NK,J)
                     QS1D(K)=max(0.,QS1D(K))
                  ENDDO
               ENDIF
            ENDIF

            IF (PRESENT(F_QG) .AND. PRESENT(QG3D)) THEN
               IF (F_QG) THEN
                  DO K=kts,kte
                     NK=kme-1-K+kms
                     QG1D(K)=QG3D(I,NK,J)
                     QG1D(K)=max(0.,QG1D(K))
                  ENDDO
               ENDIF
            ENDIF

         ENDIF

         EMISS0=EMISS(I,J)
         GLW0=0. 
         TSFC=Tw1D(kme)

         CALL RRTM(tten1d,glw0,tsfc,cldfra1d,t1d,tw1d,qv1d,qc1d,   &
                   qr1d,qi1d,qs1d,qg1d,p1d,pW1d,dz1d,              &
                   emiss0,r,g,                                     &
                   kts,kte                                         )
 
         GLW(I,J)=GLW0

         DO K=kts,kte
            nk=kme-1-k+kms
            rthraten(i,k,j)=rthraten(i,k,j)+tten1d(nk)/pi3d(i,k,j)
         ENDDO

      END DO i_loop
   END DO j_loop                                           

!-------------------------------------------------------------------

   END SUBROUTINE RRTMLWRAD


!****************************************************************************    
!*                                                                          *    
!*                               RRTM                                       *    
!*                                                                          *    
!*                                                                          *    
!*                                                                          *    
!*                   RAPID RADIATIVE TRANSFER MODEL                         *    
!*                                                                          *    
!*                                                                          *    
!*            ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC.                  *    
!*                        840 MEMORIAL DRIVE                                *    
!*                        CAMBRIDGE, MA 02139                               *    
!*                                                                          *    
!*                                                                          *    
!*                           ELI J. MLAWER                                  *    
!*                         STEVEN J. TAUBMAN~                               *    
!*                         SHEPARD A. CLOUGH                                *    
!*                                                                          *    
!*                                                                          *    
!*                         ~currently at GFDL                               *    
!*                                                                          *    
!*                                                                          *    
!*                                                                          *    
!*                       email:  mlawer@aer.com                             *    
!*                                                                          *    
!*        The authors wish to acknowledge the contributions of the          *    
!*        following people:  Patrick D. Brown, Michael J. Iacono,           *    
!*        Ronald E. Farren, Luke Chen, Robert Bergstrom.                    *    
!*                                                                          *    
!****************************************************************************    
                                                                                 
! *** This version of RRTM has been altered to interface with the                
! *** NCAR MM5 mesoscale model for the calculation of longwave radiative         
! *** transfer (based on a code for interface with CCM model by M. J. Iacono)    
! *** J. Dudhia ; March, 1999                                                    
!---------------------------------------------------------------------
   SUBROUTINE RRTM(TTEN,GLW,TSFC,CLDFRA,T,Tw,QV,QC,                  &
                   QR,QI,QS,QG,P,Pw,DZ,                              &
                   EMISS,R,G,                                        &
                   kts,kte                                           )
!---------------------------------------------------------------------
! *** This program is the driver for RRTM, the AER LW radiation model.           
!     This routine:                                                              
!     Calls MM5ATM to provide atmosphere in column and boundary values           
!     a) calls GASABS to calculate gaseous optical depths                        
!     b) calls SETCOEF to calculate various quantities needed for                
!        the radiative transfer algorithm                                        
!     c) calls RTRN (for both clear and cloudy columns) to do the                
!        radiative transfer calculation                                          
!     d) passes the necessary flux and cooling rate back to MM5                  
!---------------------------------------------------------------------
      IMPLICIT NONE
!---------------------------------------------------------------------

      INTEGER, INTENT(IN ) ::      kts, kte
!
      REAL, DIMENSION( kts:kte+1 ), INTENT(IN   ) ::             Pw, &
                                                                 Tw

      REAL, DIMENSION( kts:kte ), INTENT(IN   ) ::           CLDFRA, &
                                                                  T, &
                                                                  P, &
                                                                 DZ
!
      REAL, DIMENSION( kts:kte ), INTENT(INOUT) ::                   &
                                                                 QV
      REAL, DIMENSION( kts:kte ), INTENT(IN   ) ::                   &
                                                                 QC, &
                                                                 QR, &
                                                                 QI, &
                                                                 QS, &
                                                                 QG
!
      REAL, DIMENSION( kts:kte ), INTENT(INOUT)::              TTEN
!   
      REAL, INTENT(IN  )   ::                           R, G, EMISS
!
      REAL, INTENT(INOUT)  ::                              TSFC,GLW

! LOCAL VAR

      INTEGER, DIMENSION( NGPT,kts:kte+1 ) ::                   ITR

      REAL,    DIMENSION( NGPT,kts:kte+1 ) ::                  PFRAC, &
                                                               TAUG

      REAL,    DIMENSION( 35,kts:kte+1 )       ::               WKL

      REAL,    DIMENSION( MAXXSEC,kts:kte+1 )  ::                WX

      REAL, DIMENSION( kts:kte )  ::                         O3PROF

      REAL, DIMENSION( kts:kte+1 )  ::                        PAVEL, &
                                                              TAVEL, &
                                                            CLDFRAC, &
                                                           TAUCLOUD, &   
                                                             COLDRY, & 
                                                             COLH2O, &
                                                             COLCO2, &
                                                              COLO3, &
                                                             COLN2O, &
                                                             COLCH4, &
                                                              COLO2, &
                                                            CO2MULT, &
                                                              FAC00, &
                                                              FAC01, &
                                                              FAC10, &
                                                              FAC11, &
                                                             FORFAC, &
                                                            SELFFAC, &
                                                           SELFFRAC
                                                
!                       
      INTEGER, DIMENSION( kts:kte+1 ) ::                    ICLDLYR, &
                                                                 JP, &
                                                                 JT, &
                                                                JT1, &
                                                            INDSELF

      REAL, DIMENSION(   0:kte+1 )  ::                           PZ, &
                                                                 TZ, &
                                                           TOTDFLUX, &
                                                                HTR
!     
      INTEGER ::  I,K,ktep1
      INTEGER ::  LAYTROP,LAYSWTCH,LAYLOW
      REAL    ::  TBOUND
      REAL, DIMENSION(NBANDS) ::  SEMISS


!---------------------------------------------------------------------------
! RRTM Definitions                                                               
!    NGPT                         ! Total number of g-point subintervals         
!    MXLAY                        ! Maximum number of model layers               
!    NBANDS                       ! Number of longwave spectral bands            
!    PI                           ! Geometric constant                           
!    FLUXFAC                      ! Radiance to flux conversion factor           
!    HEATFAC                      ! Heating rate conversion factor               
!    NG(NBANDS)                   ! Number of g-points per band for input        
!                                   absorption coefficient data                  
!    NSPA(NBANDS),NSPB(NBANDS)    ! Number of reference atmospheres per band     
!    WAVENUM1(NBANDS)             ! Longwave band lower limit (wavenumbers)      
!    WAVENUM2(NBANDS)             ! Longwave band upper limit (wavenumbers)      
!    DELWAVE                      ! Longwave band width (wavenumbers)            
!    NLAYERS                      ! Number of model layers (mkx+1)               
!    PAVEL(MXLAY)                 ! Layer pressures (mb)                         
!    PZ(0:MXLAY)                  ! Level (interface) pressures (mb)             
!    TAVEL(MXLAY)                 ! Layer temperatures (K)                       
!    TZ(0:MXLAY)                  ! Level (interface) temperatures(mb)           
!    TBOUND                       ! Surface temperature (K)                      
!    CLDFRAC(MXLAY)               ! Layer cloud fraction                         
!    TAUCLOUD(MXLAY)              ! Layer cloud optical depth                    
!    ITR(NGPT,MXLAY)              ! Integer look-up table index                  
!    PFRAC(NGPT,MXLAY)            ! Planck fractions                             
!    ICLDLYR(MXLAY)               ! Flag for cloudy layers                       
!    TOTUFLUX(0:MXLAY)            ! Upward longwave flux (W/m2)                  
!    TOTDFLUX(0:MXLAY)            ! Downward longwave flux (W/m2)                
!    FNET(0:MXLAY)                ! Net longwave flux (W/m2)                     
!    HTR(0:MXLAY)                 ! Longwave heating rate (K/day)                
!    CLRNTTOA                     ! Clear-sky TOA outgoing flux (W/m2)           
!    CLRNTSRF                     ! Clear-sky net surface flux (W/m2)            
!    TOTUCLFL(0:MXLAY)            ! Clear-sky upward longwave flux (W/m2)        
!    TOTDCLFL(0:MXLAY)            ! Clear-sky downward longwave flux (W/m2)      
!    FNETC(0:MXLAY)               ! Clear-sky net longwave flux (W/m2)           
!    HTRC(0:MXLAY)                ! Clear-sky longwave heating rate (K/day)      
!                                                                                
! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
!---------------------------------------------------------------------------

     ktep1=kte+1
!
!    CLOUD EMISSIVITIES (M^2/G)                                                  
!    THESE ARE CONSISTENT WITH LWRAD (ABCW=0.5*(ABUP+ABDOWN))                    
!     
!     ONEMINUS = 1. - 1.E-6                                                      
!     PI   = 2.*ASIN(1.)                                                           
!     FLUXFAC = PI   * 2.D4                     
!
      CALL INIRAD (O3PROF,Pw,kts,kte)
                                                                              
!  Prepare atmospheric profile from CCM for use in RRTM, and define              
!  other RRTM input parameters.  Arrays are passed back through the              
!  existing RRTM commons and arrays.                                             
         
         CALL MM5ATM(CLDFRA,O3PROF,T,Tw,TSFC,QV,QC,QR,QI,QS,QG,    &
                     P,Pw,DZ,EMISS,R,G,                            &
                     PAVEL,TAVEL,PZ,TZ,CLDFRAC,TAUCLOUD,COLDRY,    &
                     WKL,WX,TBOUND,SEMISS,                         &
                     kts,kte                                       )

!  Calculate information needed by the radiative transfer routine                
!  that is specific to this atmosphere, especially some of the                   
!  coefficients and indices needed to compute the optical depths                 
!  by interpolating data from stored reference atmospheres.                      
                                                                                 
         CALL SETCOEF(kts,ktep1,                                   &
                      PAVEL,TAVEL,COLDRY,COLH2O,COLCO2,COLO3,      &
                      COLN2O,COLCH4,COLO2,CO2MULT,                 &
                      FAC00,FAC01,FAC10,FAC11,                     &
                      FORFAC,SELFFAC,SELFFRAC,                     &
                      JP,JT,JT1,INDSELF,WKL,LAYTROP,LAYSWTCH,LAYLOW)

         CALL GASABS(kts,ktep1,                                 &
                     COLDRY,COLH2O,COLCO2,COLO3,COLN2O,COLCH4,  &
                     COLO2,CO2MULT,                             &
                     FAC00,FAC01,FAC10,FAC11,                   &
                     FORFAC,SELFFAC,SELFFRAC,                   &
                     JP,JT,JT1,INDSELF,ITR,WX,PFRAC,TAUG,       &
                     LAYTROP,LAYSWTCH,LAYLOW                    )

!  Check for cloud in column.  Use original CCM LW threshold: if total           
!  clear sky fraction < 0.999, then column is cloudy, otherwise consider         
!  it clear.  Also, set up flag array, icldlyr, for use in radiative             
!  transfer.  Set icldlyr to one for each layer with cloud.  If tclrsf           
!  is not available, icldlyr can be set from cldfrac alone.                      
                                                                                 
        do 1500 k = 1, nlayers                                                   
           if (cldfrac(k).gt.0.) then                                            
              icldlyr(k) = 1                                                     
           else                                                                  
              icldlyr(k) = 0                                                     
           endif                                                                 
 1500   continue                                                                 
                                                                                 
!  Call the radiative transfer routine.                                          
                                                                                 
           CALL RTRN(kts,ktep1,                                  &
                     TAVEL, PZ, TZ, CLDFRAC, TAUCLOUD, TOTDFLUX, &
                     HTR, ICLDLYR, ITR, PFRAC, TBOUND,SEMISS     )
                                                                                 
!  Pass total sky up and down flux profiles to CCM output arrays and             
!  convert from mks to cgs units for CCM.  Pass clear sky TOA and surface        
!  net fluxes to CCM fields for diagnostics.  Pass total sky heating rate        
!  profile to CCM output arrays and convert units to K/sec.  The vertical        
!  array index (bottom to top in RRTM) is reversed for CCM fields.               
                                                                                 
!          flntc(iiplon) = CLRNTTOA*1.e3                                         
!          flnsc(iiplon) = CLRNTSRF*1.e3                                         
!           do 2400 k = 0, NLAYERS-1                                             
!              fulc(k+1) = TOTUCLFL(NLAYERS-1-k)*1.e3                            
!              fdlc(k+1) = TOTDCLFL(NLAYERS-1-k)*1.e3                            
!              ful(k+1) = TOTUFLUX(NLAYERS-1-k)*1.e3                             
!              fdl(k+1) = TOTDFLUX(NLAYERS-1-k)*1.e3                             
! 2400      continue                                                             
           do 2450 k = 1, NLAYERS-1                                              
!              qrlc(k) = HTRC(NLAYERS-1-k)/86400.                                
!              qrl(k) = HTR(NLAYERS-1-k)/86400.                                  
              TTEN(K)=HTR(NLAYERS-1-k)/86400. 
 2450      continue                                                              
           GLW = TOTDFLUX(0)

   END SUBROUTINE RRTM


!***************************************************************************     
   SUBROUTINE CMBGB1(abscoefL, abscoefH, SELFREF,                       &
                     FRACREFA, FRACREFB, FORREF,                        &
                     SELFREFC, FORREFC, FRACREFAC, FRACREFBC            )
!***************************************************************************     
!                                                                                
!  Original version:       Michael J. Iacono; July, 1998                         
!  Revision for NCAR CCM:  Michael J. Iacono; September, 1998                    
!                                                                                
!  The subroutines CMBGB1->CMBGB16 input the absorption coefficient              
!  data for each band, which are defined for 16 g-points and 16 spectral         
!  bands. The data are combined with appropriate weighting following the         
!  g-point mapping arrays specified in RRTMINIT.  Plank fraction data            
!  in arrays FRACREFA and FRACREFB are combined without weighting.  All          
!  g-point reduced data are put into new arrays for use in RRTM.                 
!                                                                                
!  BAND 1:  10-250 cm-1 (low - H2O; high - H2O)                                  
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)
      REAL SELFREF(10,MG)              
      REAL FRACREFA(MG), FRACREFB(MG), FORREF(MG)
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG1), FORREFC(NG1)
      REAL FRACREFAC(NG1), FRACREFBC(NG1)
                                                                                 
      DO 2000 JTJT = 1,5                                                           
         DO 2200 JPJP = 1,13                                                       
            IPRSM = 0                                                            
            DO 2400 IGC = 1,NGC(1)                                               
               SUMK = 0.                                                         
               DO 2600 IPR = 1, NGN(IGC)                                         
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM)               
 2600          CONTINUE                                                          
               ABSA1(JTJT+(JPJP-1)*5,IGC) = SUMK
 2400       CONTINUE                                                             
 2200    CONTINUE                                                                
         DO 3200 JPJP = 13,59                                                      
            IPRSM = 0                                                            
            DO 3400 IGC = 1,NGC(1)                                               
               SUMK = 0.                                                         
               DO 3600 IPR = 1, NGN(IGC)                                         
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM)
 3600          CONTINUE                                                          
               ABSB1(JTJT+(JPJP-13)*5,IGC) = SUMK                                             
 3400       CONTINUE                                                             
 3200    CONTINUE                                                                
 2000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(1)                                                  
            SUMK = 0.                                                            
            DO 4600 IPR = 1, NGN(IGC)                                            
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM)
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      IPRSM = 0                                                                  
      DO 5400 IGC = 1,NGC(1)                                                     
         SUMK = 0.                                                               
         SUMF1 = 0.                                                              
         SUMF2 = 0.                                                              
         DO 5600 IPR = 1, NGN(IGC)                                               
            IPRSM = IPRSM + 1                                                    
            SUMK = SUMK + FORREF(IPRSM)*RWGT(IPRSM)                              
            SUMF1= SUMF1+ FRACREFA(IPRSM)                                        
            SUMF2= SUMF2+ FRACREFB(IPRSM)                                        
 5600    CONTINUE                                                                
         FORREFC(IGC) = SUMK                                                     
         FRACREFAC(IGC) = SUMF1                                                  
         FRACREFBC(IGC) = SUMF2                                                  
 5400 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB1

!***************************************************************************
  SUBROUTINE CMBGB2(abscoefL, abscoefH, SELFREF,                       &
                    FRACREFA, FRACREFB, FORREF,                        &
                    SELFREFC, FORREFC, FRACREFAC, FRACREFBC            )
!***************************************************************************     
!                                                                                
!     BAND 2:  250-500 cm-1 (low - H2O; high - H2O)                              
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)
      REAL SELFREF(10,MG)            
      REAL FRACREFA(MG,13), FRACREFB(MG), FORREF(MG)
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG2), FORREFC(NG2)
      REAL FRACREFAC(NG2,13), FRACREFBC(NG2)
                                                                                 
      DO 2000 JTJT = 1,5                                                           
         DO 2200 JPJP = 1,13                                                       
            IPRSM = 0                                                            
            DO 2400 IGC = 1,NGC(2)                                               
               SUMK = 0.                                                         
               DO 2600 IPR = 1, NGN(NGS(1)+IGC)                                  
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+16)
 2600          CONTINUE                                                          
               ABSA2(JTJT+(JPJP-1)*5,IGC) = SUMK  
 2400       CONTINUE                                                             
 2200    CONTINUE                                                                
         DO 3200 JPJP = 13,59                                                      
            IPRSM = 0                                                            
            DO 3400 IGC = 1,NGC(2)                                               
               SUMK = 0.                                                         
               DO 3600 IPR = 1, NGN(NGS(1)+IGC)                                  
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+16)
 3600          CONTINUE                                                          
               ABSB2(JTJT+(JPJP-13)*5,IGC) = SUMK
 3400       CONTINUE                                                             
 3200    CONTINUE                                                                
 2000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(2)                                                  
            SUMK = 0.                                                            
            DO 4600 IPR = 1, NGN(NGS(1)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+16)
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      DO 5000 JPJP = 1,13                                                          
         IPRSM = 0                                                               
         DO 5400 IGC = 1,NGC(2)                                                  
            SUMF = 0.                                                            
            DO 5600 IPR = 1, NGN(NGS(1)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
 5600       CONTINUE                                                             
            FRACREFAC(IGC,JPJP) = SUMF                                             
 5400    CONTINUE                                                                
 5000 CONTINUE                                                                   
                                                                                 
      IPRSM = 0                                                                  
      DO 6400 IGC = 1,NGC(2)                                                     
         SUMK = 0.                                                               
         SUMF = 0.                                                               
         DO 6600 IPR = 1, NGN(NGS(1)+IGC)                                        
            IPRSM = IPRSM + 1                                                    
            SUMK = SUMK + FORREF(IPRSM)*RWGT(IPRSM+16)                           
            SUMF = SUMF + FRACREFB(IPRSM)                                        
 6600    CONTINUE                                                                
         FORREFC(IGC) = SUMK                                                     
         FRACREFBC(IGC) = SUMF                                                   
 6400 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB2

!***************************************************************************
   SUBROUTINE CMBGB3(abscoefL, abscoefH, SELFREF,                       &
                     FRACREFA, FRACREFB, FORREF, ABSN2OA, ABSN2OB,      &
                     SELFREFC, FORREFC,                                 &
                     ABSN2OAC, ABSN2OBC, FRACREFAC, FRACREFBC           )
!***************************************************************************     
!                                                                                
!     BAND 3:  500-630 cm-1 (low - H2O,CO2; high - H2O,CO2)                      
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(10,5,13,MG),abscoefH(5,5,13:59,MG)
      REAL SELFREF(10,MG)   
      REAL FRACREFA(MG,10), FRACREFB(MG,5)
      REAL FORREF(MG), ABSN2OA(MG), ABSN2OB(MG)     
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG3), FORREFC(NG3),  &
           ABSN2OAC(NG3), ABSN2OBC(NG3) 
      REAL FRACREFAC(NG3,10), FRACREFBC(NG3,5) 
                                                                                 
      DO 2000 JN = 1,10                                                          
         DO 2000 JTJT = 1,5                                                        
            DO 2200 JPJP = 1,13                                                    
               IPRSM = 0                                                         
               DO 2400 IGC = 1,NGC(3)                                            
                 SUMK = 0.                                                       
                  DO 2600 IPR = 1, NGN(NGS(2)+IGC)                               
                     IPRSM = IPRSM + 1                                           
                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)* RWGT(IPRSM+32)
 2600             CONTINUE                                                       
                  ABSA3(JN+(JTJT-1)*10+(JPJP-1)*50,IGC) = SUMK  
 2400          CONTINUE                                                          
 2200       CONTINUE                                                             
 2000 CONTINUE                                                                   
      DO 3000 JN = 1,5                                                           
         DO 3000 JTJT = 1,5                                                        
            DO 3200 JPJP = 13,59                                                   
               IPRSM = 0                                                         
               DO 3400 IGC = 1,NGC(3)                                            
                  SUMK = 0.                                                      
                  DO 3600 IPR = 1, NGN(NGS(2)+IGC)                               
                     IPRSM = IPRSM + 1                                           
                     SUMK = SUMK + abscoefH(JN,JTJT,JPJP,IPRSM)* RWGT(IPRSM+32)
 3600             CONTINUE                                                       
                  ABSB3(JN+(JTJT-1)*5+(JPJP-13)*25,IGC) = SUMK
 3400          CONTINUE                                                          
 3200       CONTINUE                                                             
 3000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(3)                                                  
            SUMK = 0.                                                            
            SUMF = 0.                                                            
            DO 4600 IPR = 1, NGN(NGS(2)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)* RWGT(IPRSM+32)
               SUMF = SUMF + FRACREFA(IPRSM,JTJT)                                  
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
            FRACREFAC(IGC,JTJT) = SUMF                                             
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      DO 5000 JPJP = 1,5                                                           
         IPRSM = 0                                                               
         DO 5400 IGC = 1,NGC(3)                                                  
            SUMF = 0.                                                            
            DO 5600 IPR = 1, NGN(NGS(2)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMF = SUMF + FRACREFB(IPRSM,JPJP)                                  
 5600       CONTINUE                                                             
            FRACREFBC(IGC,JPJP) = SUMF                                             
 5400    CONTINUE                                                                
 5000 CONTINUE                                                                   
                                                                                 
      IPRSM = 0                                                                  
      DO 6400 IGC = 1,NGC(3)                                                     
         SUMK1= 0.                                                               
         SUMK2= 0.                                                               
         SUMK3= 0.                                                               
         DO 6600 IPR = 1, NGN(NGS(2)+IGC)                                        
            IPRSM = IPRSM + 1                                                    
            SUMK1= SUMK1+ FORREF(IPRSM)*RWGT(IPRSM+32)                           
            SUMK2= SUMK2+ ABSN2OA(IPRSM)*RWGT(IPRSM+32)                          
            SUMK3= SUMK3+ ABSN2OB(IPRSM)*RWGT(IPRSM+32)                          
 6600    CONTINUE                                                                
         FORREFC(IGC) = SUMK1                                                    
         ABSN2OAC(IGC) = SUMK2                                                   
         ABSN2OBC(IGC) = SUMK3                                                   
 6400 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB3

!***************************************************************************
   SUBROUTINE CMBGB4(abscoefL, abscoefH, SELFREF,                       &
                     FRACREFA, FRACREFB,                                &
                     SELFREFC, FRACREFAC, FRACREFBC                     )
!***************************************************************************     
!                                                                                
!     BAND 4:  630-700 cm-1 (low - H2O,CO2; high - O3,CO2)                       
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(9,5,13,MG),abscoefH(6,5,13:59,MG)
      REAL SELFREF(10,MG)            
      REAL FRACREFA(MG,9), FRACREFB(MG,6)
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG4)
      REAL FRACREFAC(NG4,9), FRACREFBC(NG4,6)
                                                                                 
      DO 2000 JN = 1,9                                                           
         DO 2000 JTJT = 1,5                                                        
            DO 2200 JPJP = 1,13                                                    
               IPRSM = 0                                                         
               DO 2400 IGC = 1,NGC(4)                                            
                 SUMK = 0.                                                       
                  DO 2600 IPR = 1, NGN(NGS(3)+IGC)                               
                     IPRSM = IPRSM + 1                                           
                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+48)
 2600             CONTINUE                                                       
                  ABSA4(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK                                       
 2400          CONTINUE                                                          
 2200       CONTINUE                                                             
 2000 CONTINUE                                                                   
      DO 3000 JN = 1,6                                                           
         DO 3000 JTJT = 1,5                                                        
            DO 3200 JPJP = 13,59                                                   
               IPRSM = 0                                                         
               DO 3400 IGC = 1,NGC(4)                                            
                  SUMK = 0.                                                      
                  DO 3600 IPR = 1, NGN(NGS(3)+IGC)                               
                     IPRSM = IPRSM + 1                                           
                     SUMK = SUMK + abscoefH(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+48)
 3600             CONTINUE                                                       
                  ABSB4(JN+(JTJT-1)*6+(JPJP-13)*30,IGC) = SUMK
 3400          CONTINUE                                                          
 3200       CONTINUE                                                             
 3000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(4)                                                  
            SUMK = 0.                                                            
            DO 4600 IPR = 1, NGN(NGS(3)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+48)
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      DO 5000 JPJP = 1,9                                                           
         IPRSM = 0                                                               
         DO 5400 IGC = 1,NGC(4)                                                  
            SUMF = 0.                                                            
            DO 5600 IPR = 1, NGN(NGS(3)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
 5600       CONTINUE                                                             
            FRACREFAC(IGC,JPJP) = SUMF                                             
 5400    CONTINUE                                                                
 5000 CONTINUE                                                                   
                                                                                 
      DO 6000 JPJP = 1,6                                                           
         IPRSM = 0                                                               
         DO 6400 IGC = 1,NGC(4)                                                  
            SUMF = 0.                                                            
            DO 6600 IPR = 1, NGN(NGS(3)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMF = SUMF + FRACREFB(IPRSM,JPJP)                                  
 6600       CONTINUE                                                             
            FRACREFBC(IGC,JPJP) = SUMF                                             
 6400    CONTINUE                                                                
 6000 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB4

!***************************************************************************
   SUBROUTINE CMBGB5(abscoefL, abscoefH, SELFREF,                      &
                     FRACREFA, FRACREFB, CCL4,                         &
                     SELFREFC, CCL4C, FRACREFAC, FRACREFBC             )
!***************************************************************************     
!                                                                                
!     BAND 5:  700-820 cm-1 (low - H2O,CO2; high - O3,CO2)                       
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(9,5,13,MG),abscoefH(5,5,13:59,MG)
      REAL SELFREF(10,MG)            
      REAL FRACREFA(MG,9), FRACREFB(MG,5), CCL4(MG)
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG5), CCL4C(NG5) 
      REAL FRACREFAC(NG5,9), FRACREFBC(NG5,5)               
                                                         
      DO 2000 JN = 1,9                                                           
         DO 2000 JTJT = 1,5                                                        
            DO 2200 JPJP = 1,13                                                    
               IPRSM = 0                                                         
               DO 2400 IGC = 1,NGC(5)                                            
                 SUMK = 0.                                                       
                  DO 2600 IPR = 1, NGN(NGS(4)+IGC)                               
                     IPRSM = IPRSM + 1                                           
                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+64)
 2600             CONTINUE                                                       
                  ABSA5(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK                                       
 2400          CONTINUE                                                          
 2200       CONTINUE                                                             
 2000 CONTINUE                                                                   
      DO 3000 JN = 1,5                                                           
         DO 3000 JTJT = 1,5                                                        
            DO 3200 JPJP = 13,59                                                   
               IPRSM = 0                                                         
               DO 3400 IGC = 1,NGC(5)                                            
                  SUMK = 0.                                                      
                  DO 3600 IPR = 1, NGN(NGS(4)+IGC)                               
                     IPRSM = IPRSM + 1                                           
                     SUMK = SUMK + abscoefH(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+64)
 3600             CONTINUE                                                       
                  ABSB5(JN+(JTJT-1)*5+(JPJP-13)*25,IGC) = SUMK
 3400          CONTINUE                                                          
 3200       CONTINUE                                                             
 3000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(5)                                                  
            SUMK = 0.                                                            
            DO 4600 IPR = 1, NGN(NGS(4)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+64)
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      DO 5000 JPJP = 1,9                                                           
         IPRSM = 0                                                               
         DO 5400 IGC = 1,NGC(5)                                                  
            SUMF = 0.                                                            
            DO 5600 IPR = 1, NGN(NGS(4)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
 5600       CONTINUE                                                             
            FRACREFAC(IGC,JPJP) = SUMF                                             
 5400    CONTINUE                                                                
 5000 CONTINUE                                                                   
                                                                                 
      DO 6000 JPJP = 1,5                                                           
         IPRSM = 0                                                               
         DO 6400 IGC = 1,NGC(5)                                                  
            SUMF = 0.                                                            
            DO 6600 IPR = 1, NGN(NGS(4)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMF = SUMF + FRACREFB(IPRSM,JPJP)                                  
 6600       CONTINUE                                                             
            FRACREFBC(IGC,JPJP) = SUMF                                             
 6400    CONTINUE                                                                
 6000 CONTINUE                                                                   
                                                                                 
      IPRSM = 0                                                                  
      DO 7400 IGC = 1,NGC(5)                                                     
         SUMK = 0.                                                               
         DO 7600 IPR = 1, NGN(NGS(4)+IGC)                                        
            IPRSM = IPRSM + 1                                                    
            SUMK = SUMK + CCL4(IPRSM)*RWGT(IPRSM+64)                             
 7600    CONTINUE                                                                
         CCL4C(IGC) = SUMK                                                       
 7400 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB5

!***************************************************************************
   SUBROUTINE CMBGB6(abscoefL, SELFREF,                                &
                     FRACREFA, ABSCO2, CFC11ADJ, CFC12,                &
                     SELFREFC, ABSCO2C, CFC11ADJC, CFC12C,             &
                     FRACREFAC                                         )
!***************************************************************************     
!                                                                                
!     BAND 6:  820-980 cm-1 (low - H2O; high - nothing)                          
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(5,13,MG)                                                           
      REAL SELFREF(10,MG)  
      REAL FRACREFA(MG), ABSCO2(MG), CFC11ADJ(MG), CFC12(MG)
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG6),  &
           ABSCO2C(NG6), CFC11ADJC(NG6), CFC12C(NG6) 
      REAL FRACREFAC(NG6)
                                                                                 
      DO 2000 JTJT = 1,5                                                           
         DO 2200 JPJP = 1,13                                                       
            IPRSM = 0                                                            
            DO 2400 IGC = 1,NGC(6)                                               
               SUMK = 0.                                                         
               DO 2600 IPR = 1, NGN(NGS(5)+IGC)                                  
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+80)
 2600          CONTINUE                                                          
               ABSA6(JTJT+(JPJP-1)*5,IGC) = SUMK                                             
 2400       CONTINUE                                                             
 2200    CONTINUE                                                                
 2000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(6)                                                  
            SUMK = 0.                                                            
            DO 4600 IPR = 1, NGN(NGS(5)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+80) 
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      IPRSM = 0                                                                  
      DO 7400 IGC = 1,NGC(6)                                                     
         SUMF = 0.                                                               
         SUMK1= 0.                                                               
         SUMK2= 0.                                                               
         SUMK3= 0.                                                               
         DO 7600 IPR = 1, NGN(NGS(5)+IGC)                                        
            IPRSM = IPRSM + 1                                                    
            SUMF = SUMF + FRACREFA(IPRSM)                                        
            SUMK1= SUMK1+ ABSCO2(IPRSM)*RWGT(IPRSM+80)                           
            SUMK2= SUMK2+ CFC11ADJ(IPRSM)*RWGT(IPRSM+80)                         
            SUMK3= SUMK3+ CFC12(IPRSM)*RWGT(IPRSM+80)                            
 7600    CONTINUE                                                                
         FRACREFAC(IGC) = SUMF                                                   
         ABSCO2C(IGC) = SUMK1                                                    
         CFC11ADJC(IGC) = SUMK2                                                  
         CFC12C(IGC) = SUMK3                                                     
 7400 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB6

!***************************************************************************
   SUBROUTINE CMBGB7(abscoefL, abscoefH, SELFREF,                      &
                     FRACREFA, FRACREFB, ABSCO2,                       &
                     SELFREFC, ABSCO2C, FRACREFAC, FRACREFBC           )
!***************************************************************************     
!                                                                                
!     BAND 7:  980-1080 cm-1 (low - H2O,O3; high - O3)                           
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(9,5,13,MG),abscoefH(5,13:59,MG)
      REAL SELFREF(10,MG)          
      REAL FRACREFA(MG,9), FRACREFB(MG), ABSCO2(MG)
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG7), ABSCO2C(NG7)
      REAL FRACREFAC(NG7,9), FRACREFBC(NG7)  
                                                                                 
      DO 2000 JN = 1,9                                                           
         DO 2000 JTJT = 1,5                                                        
            DO 2200 JPJP = 1,13                                                    
               IPRSM = 0                                                         
               DO 2400 IGC = 1,NGC(7)                                            
                 SUMK = 0.                                                       
                  DO 2600 IPR = 1, NGN(NGS(6)+IGC)                               
                     IPRSM = IPRSM + 1                                           
                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+96)
 2600             CONTINUE                                                       
                  ABSA7(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK                                       
 2400          CONTINUE                                                          
 2200       CONTINUE                                                             
 2000 CONTINUE                                                                   
      DO 3000 JTJT = 1,5                                                           
         DO 3200 JPJP = 13,59                                                      
            IPRSM = 0                                                            
            DO 3400 IGC = 1,NGC(7)                                               
               SUMK = 0.                                                         
               DO 3600 IPR = 1, NGN(NGS(6)+IGC)                                  
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+96)
 3600          CONTINUE                                                          
               ABSB7(JTJT+(JPJP-13)*5,IGC) = SUMK 
 3400       CONTINUE                                                             
 3200    CONTINUE                                                                
 3000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(7)                                                  
            SUMK = 0.                                                            
            DO 4600 IPR = 1, NGN(NGS(6)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+96)
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      DO 5000 JPJP = 1,9                                                           
         IPRSM = 0                                                               
         DO 5400 IGC = 1,NGC(7)                                                  
            SUMF = 0.                                                            
            DO 5600 IPR = 1, NGN(NGS(6)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
 5600       CONTINUE                                                             
            FRACREFAC(IGC,JPJP) = SUMF                                             
 5400    CONTINUE                                                                
 5000 CONTINUE                                                                   
                                                                                 
      IPRSM = 0                                                                  
      DO 7400 IGC = 1,NGC(7)                                                     
         SUMF = 0.                                                               
         SUMK = 0.                                                               
         DO 7600 IPR = 1, NGN(NGS(6)+IGC)                                        
            IPRSM = IPRSM + 1                                                    
            SUMF = SUMF + FRACREFB(IPRSM)                                        
            SUMK = SUMK + ABSCO2(IPRSM)*RWGT(IPRSM+96)                           
 7600    CONTINUE                                                                
         FRACREFBC(IGC) = SUMF                                                   
         ABSCO2C(IGC) = SUMK                                                     
 7400 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB7

!***************************************************************************
   SUBROUTINE CMBGB8(abscoefL, abscoefH, SELFREF,                     &
                     FRACREFA, FRACREFB, ABSCO2A, ABSCO2B,            &
                     ABSN2OA,  ABSN2OB,  CFC12,   CFC22ADJ,           &
                     SELFREFC, ABSCO2AC, ABSCO2BC,                    &
                     ABSN2OAC, ABSN2OBC, CFC12C, CFC22ADJC,           &
                     FRACREFAC, FRACREFBC                             )
!***************************************************************************     
!                                                                                
!     BAND 8:  1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)               
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(5,7,MG),abscoefH(5,7:59,MG), SELFREF(10,MG)
      REAL FRACREFA(MG), FRACREFB(MG), ABSCO2A(MG), ABSCO2B(MG)
      REAL ABSN2OA(MG), ABSN2OB(MG), CFC12(MG), CFC22ADJ(MG) 
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG8),               &
           ABSCO2AC(NG8), ABSCO2BC(NG8),   &
           ABSN2OAC(NG8), ABSN2OBC(NG8),   &
           CFC12C(NG8), CFC22ADJC(NG8)
      REAL FRACREFAC(NG8), FRACREFBC(NG8)
                                                                                 
      DO 2000 JTJT = 1,5                                                           
         DO 2200 JPJP = 1,7                                                        
            IPRSM = 0                                                            
            DO 2400 IGC = 1,NGC(8)                                               
              SUMK = 0.                                                          
               DO 2600 IPR = 1, NGN(NGS(7)+IGC)                                  
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+112)
 2600          CONTINUE                                                          
               ABSA8(JTJT+(JPJP-1)*5,IGC) = SUMK                                             
 2400       CONTINUE                                                             
 2200    CONTINUE                                                                
 2000 CONTINUE                                                                   
      DO 3000 JTJT = 1,5                                                           
         DO 3200 JPJP = 7,59                                                       
            IPRSM = 0                                                            
            DO 3400 IGC = 1,NGC(8)                                               
               SUMK = 0.                                                         
               DO 3600 IPR = 1, NGN(NGS(7)+IGC)                                  
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+112)
 3600          CONTINUE                                                          
               ABSB8(JTJT+(JPJP-7)*5,IGC) = SUMK 
 3400       CONTINUE                                                             
 3200    CONTINUE                                                                
 3000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(8)                                                  
            SUMK = 0.                                                            
            DO 4600 IPR = 1, NGN(NGS(7)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+112) 
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      IPRSM = 0                                                                  
      DO 7400 IGC = 1,NGC(8)                                                     
         SUMF1= 0.                                                               
         SUMF2= 0.                                                               
         SUMK1= 0.                                                               
         SUMK2= 0.                                                               
         SUMK3= 0.                                                               
         SUMK4= 0.                                                               
         SUMK5= 0.                                                               
         SUMK6= 0.                                                               
         DO 7600 IPR = 1, NGN(NGS(7)+IGC)                                        
            IPRSM = IPRSM + 1                                                    
            SUMF1= SUMF1+ FRACREFA(IPRSM)                                        
            SUMF2= SUMF2+ FRACREFB(IPRSM)                                        
            SUMK1= SUMK1+ ABSCO2A(IPRSM)*RWGT(IPRSM+112)                         
            SUMK2= SUMK2+ ABSCO2B(IPRSM)*RWGT(IPRSM+112)                         
            SUMK3= SUMK3+ ABSN2OA(IPRSM)*RWGT(IPRSM+112)                         
            SUMK4= SUMK4+ ABSN2OB(IPRSM)*RWGT(IPRSM+112)                         
            SUMK5= SUMK5+ CFC12(IPRSM)*RWGT(IPRSM+112)                           
            SUMK6= SUMK6+ CFC22ADJ(IPRSM)*RWGT(IPRSM+112)                        
 7600    CONTINUE                                                                
         FRACREFAC(IGC) = SUMF1                                                  
         FRACREFBC(IGC) = SUMF2                                                  
         ABSCO2AC(IGC) = SUMK1                                                   
         ABSCO2BC(IGC) = SUMK2                                                   
         ABSN2OAC(IGC) = SUMK3                                                   
         ABSN2OBC(IGC) = SUMK4                                                   
         CFC12C(IGC) = SUMK5                                                     
         CFC22ADJC(IGC) = SUMK6                                                  
 7400 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB8

!***************************************************************************
   SUBROUTINE CMBGB9(abscoefL, abscoefH, SELFREF,                      &
                     FRACREFA, FRACREFB, ABSN2O,                       &
                     SELFREFC, ABSN2OC, FRACREFAC, FRACREFBC           )
!***************************************************************************     
!                                                                                
!     BAND 9:  1180-1390 cm-1 (low - H2O,CH4; high - CH4)                        
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(11,5,13,MG), abscoefH(5,13:59,MG)
      REAL SELFREF(10,MG)   
      REAL FRACREFA(MG,9), FRACREFB(MG), ABSN2O(3*MG)
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG9), ABSN2OC(3*NG9)
      REAL FRACREFAC(NG9,9), FRACREFBC(NG9)
                                                                                 
      DO 2000 JN = 1,11                                                          
         DO 2000 JTJT = 1,5                                                        
            DO 2200 JPJP = 1,13                                                    
               IPRSM = 0                                                         
               DO 2400 IGC = 1,NGC(9)                                            
                  SUMK = 0.                                                      
                  DO 2600 IPR = 1, NGN(NGS(8)+IGC)                               
                     IPRSM = IPRSM + 1                                           
                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+128)
 2600             CONTINUE                                                       
                  ABSA9(JN+(JTJT-1)*11+(JPJP-1)*55,IGC) = SUMK                                       
 2400          CONTINUE                                                          
 2200       CONTINUE                                                             
 2000 CONTINUE                                                                   
                                                                                 
      DO 3000 JTJT = 1,5                                                           
         DO 3200 JPJP = 13,59                                                      
            IPRSM = 0                                                            
            DO 3400 IGC = 1,NGC(9)                                               
               SUMK = 0.                                                         
               DO 3600 IPR = 1, NGN(NGS(8)+IGC)                                  
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+128)
 3600          CONTINUE                                                          
               ABSB9(JTJT+(JPJP-13)*5,IGC) = SUMK
 3400       CONTINUE                                                             
 3200    CONTINUE                                                                
 3000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(9)                                                  
            SUMK = 0.                                                            
            DO 4600 IPR = 1, NGN(NGS(8)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+128)
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      DO 5000 JN = 1,3                                                           
         IPRSM = 0                                                               
         DO 5400 IGC = 1,NGC(9)                                                  
            SUMK = 0.                                                            
            DO 5600 IPR = 1, NGN(NGS(8)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               JND = (JN-1)*16                                                   
               SUMK = SUMK + ABSN2O(JND+IPRSM)*RWGT(IPRSM+128)                   
 5600       CONTINUE                                                             
            JNDC = (JN-1)*NGC(9)                                                 
            ABSN2OC(JNDC+IGC) = SUMK                                             
 5400    CONTINUE                                                                
 5000 CONTINUE                                                                   
                                                                                 
      DO 6000 JPJP = 1,9                                                           
         IPRSM = 0                                                               
         DO 6400 IGC = 1,NGC(9)                                                  
            SUMF = 0.                                                            
            DO 6600 IPR = 1, NGN(NGS(8)+IGC)                                     
               IPRSM = IPRSM + 1                                                 
               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
 6600       CONTINUE                                                             
            FRACREFAC(IGC,JPJP) = SUMF                                             
 6400    CONTINUE                                                                
 6000 CONTINUE                                                                   
                                                                                 
      IPRSM = 0                                                                  
      DO 7400 IGC = 1,NGC(9)                                                     
         SUMF = 0.                                                               
         DO 7600 IPR = 1, NGN(NGS(8)+IGC)                                        
            IPRSM = IPRSM + 1                                                    
            SUMF = SUMF + FRACREFB(IPRSM)                                        
 7600    CONTINUE                                                                
         FRACREFBC(IGC) = SUMF                                                   
 7400 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB9

!***************************************************************************
   SUBROUTINE CMBGB10(abscoefL, abscoefH,                               &
                      FRACREFA, FRACREFB,                               &
                      FRACREFAC, FRACREFBC                              )
!***************************************************************************     
!                                                                                
!     BAND 10:  1390-1480 cm-1 (low - H2O; high - H2O)                           
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)            
      REAL FRACREFA(MG), FRACREFB(MG)
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL FRACREFAC(NG10), FRACREFBC(NG10)
                                                                                 
      DO 2000 JTJT = 1,5                                                           
         DO 2200 JPJP = 1,13                                                       
            IPRSM = 0                                                            
            DO 2400 IGC = 1,NGC(10)                                              
               SUMK = 0.                                                         
               DO 2600 IPR = 1, NGN(NGS(9)+IGC)                                  
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+144)
 2600          CONTINUE                                                          
               ABSA10(JTJT+(JPJP-1)*5,IGC) = SUMK                                             
 2400       CONTINUE                                                             
 2200    CONTINUE                                                                
 2000 CONTINUE                                                                   
      DO 3000 JTJT = 1,5                                                           
         DO 3200 JPJP = 13,59                                                      
            IPRSM = 0                                                            
            DO 3400 IGC = 1,NGC(10)                                              
               SUMK = 0.                                                         
               DO 3600 IPR = 1, NGN(NGS(9)+IGC)                                  
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+144)
 3600          CONTINUE                                                          
               ABSB10(JTJT+(JPJP-13)*5,IGC) = SUMK
 3400       CONTINUE                                                             
 3200    CONTINUE                                                                
 3000 CONTINUE                                                                   
                                                                                 
      IPRSM = 0                                                                  
      DO 7400 IGC = 1,NGC(10)                                                    
         SUMF1= 0.                                                               
         SUMF2= 0.                                                               
         DO 7600 IPR = 1, NGN(NGS(9)+IGC)                                        
            IPRSM = IPRSM + 1                                                    
            SUMF1= SUMF1+ FRACREFA(IPRSM)                                        
            SUMF2= SUMF2+ FRACREFB(IPRSM)                                        
 7600    CONTINUE                                                                
         FRACREFAC(IGC) = SUMF1                                                  
         FRACREFBC(IGC) = SUMF2                                                  
 7400 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB10

!***************************************************************************
   SUBROUTINE CMBGB11(abscoefL, abscoefH, SELFREF,                   &
                      FRACREFA, FRACREFB,                            &
                      SELFREFC,                                      &
                      FRACREFAC, FRACREFBC                           )
!***************************************************************************     
!                                                                                
!     BAND 11:  1480-1800 cm-1 (low - H2O; high - H2O)                           
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)
      REAL SELFREF(10,MG)      
      REAL FRACREFA(MG), FRACREFB(MG)
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG11)
      REAL FRACREFAC(NG11), FRACREFBC(NG11)
                                                                                 
      DO 2000 JTJT = 1,5                                                           
         DO 2200 JPJP = 1,13                                                       
            IPRSM = 0                                                            
            DO 2400 IGC = 1,NGC(11)                                              
               SUMK = 0.                                                         
               DO 2600 IPR = 1, NGN(NGS(10)+IGC)                                 
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+160)
 2600          CONTINUE                                                          
               ABSA11(JTJT+(JPJP-1)*5,IGC) = SUMK                                             
 2400       CONTINUE                                                             
 2200    CONTINUE                                                                
 2000 CONTINUE                                                                   
      DO 3000 JTJT = 1,5                                                           
         DO 3200 JPJP = 13,59                                                      
            IPRSM = 0                                                            
            DO 3400 IGC = 1,NGC(11)                                              
               SUMK = 0.                                                         
               DO 3600 IPR = 1, NGN(NGS(10)+IGC)                                 
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+160) 
 3600          CONTINUE                                                          
               ABSB11(JTJT+(JPJP-13)*5,IGC) = SUMK
 3400       CONTINUE                                                             
 3200    CONTINUE                                                                
 3000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(11)                                                 
            SUMK = 0.                                                            
            DO 4600 IPR = 1, NGN(NGS(10)+IGC)                                    
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+160) 
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      IPRSM = 0                                                                  
      DO 7400 IGC = 1,NGC(11)                                                    
         SUMF1= 0.                                                               
         SUMF2= 0.                                                               
         DO 7600 IPR = 1, NGN(NGS(10)+IGC)                                       
            IPRSM = IPRSM + 1                                                    
            SUMF1= SUMF1+ FRACREFA(IPRSM)                                        
            SUMF2= SUMF2+ FRACREFB(IPRSM)                                        
 7600    CONTINUE                                                                
         FRACREFAC(IGC) = SUMF1                                                  
         FRACREFBC(IGC) = SUMF2                                                  
 7400 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB11


!***************************************************************************
   SUBROUTINE CMBGB12(abscoefL, SELFREF,                          &
                      FRACREFA,                                   &
                      SELFREFC, FRACREFAC                         )
!***************************************************************************     
!                                                                                
!     BAND 12:  1800-2080 cm-1 (low - H2O,CO2; high - nothing)                   
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(9,5,13,MG)  
      REAL SELFREF(10,MG)              
      REAL FRACREFA(MG,9)
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG12) 
      REAL FRACREFAC(NG12,9)
                                                                                 
      DO 2000 JN = 1,9                                                           
         DO 2000 JTJT = 1,5                                                        
            DO 2200 JPJP = 1,13                                                    
               IPRSM = 0                                                         
               DO 2400 IGC = 1,NGC(12)                                           
                  SUMK = 0.                                                      
                  DO 2600 IPR = 1, NGN(NGS(11)+IGC)                              
                     IPRSM = IPRSM + 1                                           
                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+176)
 2600             CONTINUE                                                       
                  ABSA12(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK                                       
 2400          CONTINUE                                                          
 2200       CONTINUE                                                             
 2000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(12)                                                 
            SUMK = 0.                                                            
            DO 4600 IPR = 1, NGN(NGS(11)+IGC)                                    
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+176)
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      DO 7000 JPJP = 1,9                                                           
         IPRSM = 0                                                               
         DO 7400 IGC = 1,NGC(12)                                                 
            SUMF = 0.                                                            
            DO 7600 IPR = 1, NGN(NGS(11)+IGC)                                    
               IPRSM = IPRSM + 1                                                 
               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
 7600       CONTINUE                                                             
            FRACREFAC(IGC,JPJP) = SUMF                                             
 7400    CONTINUE                                                                
 7000 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB12

!***************************************************************************
   SUBROUTINE CMBGB13(abscoefL, SELFREF, FRACREFA,               &
                      SELFREFC, FRACREFAC                        )
!***************************************************************************     
!                                                                                
!     BAND 13:  2080-2250 cm-1 (low - H2O,N2O; high - nothing)                   
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(9,5,13,MG) 
      REAL SELFREF(10,MG)   
      REAL FRACREFA(MG,9)
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG13) 
      REAL FRACREFAC(NG13,9)
                                                                                 
      DO 2000 JN = 1,9                                                           
         DO 2000 JTJT = 1,5                                                        
            DO 2200 JPJP = 1,13                                                    
               IPRSM = 0                                                         
               DO 2400 IGC = 1,NGC(13)                                           
                  SUMK = 0.                                                      
                  DO 2600 IPR = 1, NGN(NGS(12)+IGC)                              
                     IPRSM = IPRSM + 1                                           
                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+192)
 2600             CONTINUE                                                       
                  ABSA13(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK 
 2400          CONTINUE                                                          
 2200       CONTINUE                                                             
 2000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(13)                                                 
            SUMK = 0.                                                            
            DO 4600 IPR = 1, NGN(NGS(12)+IGC)                                    
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+192)
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      DO 7000 JPJP = 1,9                                                           
         IPRSM = 0                                                               
         DO 7400 IGC = 1,NGC(13)                                                 
            SUMF = 0.                                                            
            DO 7600 IPR = 1, NGN(NGS(12)+IGC)                                    
               IPRSM = IPRSM + 1                                                 
               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
 7600       CONTINUE                                                             
            FRACREFAC(IGC,JPJP) = SUMF                                             
 7400    CONTINUE                                                                
 7000 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB13

!***************************************************************************
   SUBROUTINE CMBGB14(abscoefL, abscoefH, SELFREF,                     &
                      FRACREFA, FRACREFB,                              &
                      SELFREFC, FRACREFAC, FRACREFBC                   )
!***************************************************************************     
!                                                                                
!     BAND 14:  2250-2380 cm-1 (low - CO2; high - CO2)                           
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)
      REAL SELFREF(10,MG)  
      REAL FRACREFA(MG), FRACREFB(MG)
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG14)                              
      REAL FRACREFAC(NG14), FRACREFBC(NG14) 
                                                                                 
      DO 2000 JTJT = 1,5                                                           
         DO 2200 JPJP = 1,13                                                       
            IPRSM = 0                                                            
            DO 2400 IGC = 1,NGC(14)                                              
               SUMK = 0.                                                         
               DO 2600 IPR = 1, NGN(NGS(13)+IGC)                                 
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+208)
 2600          CONTINUE                                                          
               ABSA14(JTJT+(JPJP-1)*5,IGC) = SUMK
 2400       CONTINUE                                                             
 2200    CONTINUE                                                                
 2000 CONTINUE                                                                   
                                                                                 
      DO 3000 JTJT = 1,5                                                           
         DO 3200 JPJP = 13,59                                                      
            IPRSM = 0                                                            
            DO 3400 IGC = 1,NGC(14)                                              
               SUMK = 0.                                                         
               DO 3600 IPR = 1, NGN(NGS(13)+IGC)                                 
                  IPRSM = IPRSM + 1                                              
                  SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+208)
 3600          CONTINUE                                                          
               ABSB14(JTJT+(JPJP-13)*5,IGC) = SUMK
 3400       CONTINUE                                                             
 3200    CONTINUE                                                                
 3000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(14)                                                 
            SUMK = 0.                                                            
            DO 4600 IPR = 1, NGN(NGS(13)+IGC)                                    
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+208)
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      IPRSM = 0                                                                  
      DO 7400 IGC = 1,NGC(14)                                                    
         SUMF1= 0.                                                               
         SUMF2= 0.                                                               
         DO 7600 IPR = 1, NGN(NGS(13)+IGC)                                       
            IPRSM = IPRSM + 1                                                    
            SUMF1= SUMF1+ FRACREFA(IPRSM)                                        
            SUMF2= SUMF2+ FRACREFB(IPRSM)                                        
 7600    CONTINUE                                                                
         FRACREFAC(IGC) = SUMF1                                                  
         FRACREFBC(IGC) = SUMF2                                                  
 7400 CONTINUE                                                                   
                                                                                 
            
   END SUBROUTINE CMBGB14

!***************************************************************************
   SUBROUTINE CMBGB15(abscoefL, SELFREF, FRACREFA,                &
                      SELFREFC, FRACREFAC                         )
!***************************************************************************
!                                                                                
!     BAND 15:  2380-2600 cm-1 (low - N2O,CO2; high - nothing)                   
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(9,5,13,MG)                                                         
      REAL SELFREF(10,MG)  
      REAL FRACREFA(MG,9)
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG15)
      REAL FRACREFAC(NG15,9) 
                                                                                 
      DO 2000 JN = 1,9                                                           
         DO 2000 JTJT = 1,5                                                        
            DO 2200 JPJP = 1,13                                                    
               IPRSM = 0                                                         
               DO 2400 IGC = 1,NGC(15)                                           
                  SUMK = 0.                                                      
                  DO 2600 IPR = 1, NGN(NGS(14)+IGC)                              
                     IPRSM = IPRSM + 1                                           
                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+224)
 2600             CONTINUE                                                       
                  ABSA15(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK 
 2400          CONTINUE                                                          
 2200       CONTINUE                                                             
 2000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(15)                                                 
            SUMK = 0.                                                            
            DO 4600 IPR = 1, NGN(NGS(14)+IGC)                                    
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+224)
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      DO 7000 JPJP = 1,9                                                           
         IPRSM = 0                                                               
         DO 7400 IGC = 1,NGC(15)                                                 
            SUMF = 0.                                                            
            DO 7600 IPR = 1, NGN(NGS(14)+IGC)                                    
               IPRSM = IPRSM + 1                                                 
               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
 7600       CONTINUE                                                             
            FRACREFAC(IGC,JPJP) = SUMF                                             
 7400    CONTINUE                                                                
 7000 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB15

!***************************************************************************
   SUBROUTINE CMBGB16(abscoefL, SELFREF, FRACREFA,               &
                      SELFREFC, FRACREFAC                        )
!***************************************************************************     
!                                                                                
!     BAND 16:  2600-3000 cm-1 (low - H2O,CH4; high - nothing)                   
!***************************************************************************     
                                                                                 
! Input                                                                          
      REAL abscoefL(9,5,13,MG)                                                         
      REAL SELFREF(10,MG)     
      REAL FRACREFA(MG,9)
!     REAL RWGT(MG*NBANDS) 
! Output                                                                         
      REAL SELFREFC(10,NG16)
      REAL FRACREFAC(NG16,9)
                                                                                 
      DO 2000 JN = 1,9                                                           
         DO 2000 JTJT = 1,5                                                        
            DO 2200 JPJP = 1,13                                                    
               IPRSM = 0                                                         
               DO 2400 IGC = 1,NGC(16)                                           
                  SUMK = 0.                                                      
                  DO 2600 IPR = 1, NGN(NGS(15)+IGC)                              
                     IPRSM = IPRSM + 1                                           
                     SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+240)
 2600             CONTINUE                                                       
                  ABSA16(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK
 2400          CONTINUE                                                          
 2200       CONTINUE                                                             
 2000 CONTINUE                                                                   
                                                                                 
      DO 4000 JTJT = 1,10                                                          
         IPRSM = 0                                                               
         DO 4400 IGC = 1,NGC(16)                                                 
            SUMK = 0.                                                            
            DO 4600 IPR = 1, NGN(NGS(15)+IGC)                                    
               IPRSM = IPRSM + 1                                                 
               SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+240)
 4600       CONTINUE                                                             
            SELFREFC(JTJT,IGC) = SUMK                                              
 4400    CONTINUE                                                                
 4000 CONTINUE                                                                   
                                                                                 
      DO 7000 JPJP = 1,9                                                           
         IPRSM = 0                                                               
         DO 7400 IGC = 1,NGC(16)                                                 
            SUMF = 0.                                                            
            DO 7600 IPR = 1, NGN(NGS(15)+IGC)                                    
               IPRSM = IPRSM + 1                                                 
               SUMF = SUMF + FRACREFA(IPRSM,JPJP)                                  
 7600       CONTINUE                                                             
            FRACREFAC(IGC,JPJP) = SUMF                                             
 7400    CONTINUE                                                                
 7000 CONTINUE                                                                   
                                                                                 
   END SUBROUTINE CMBGB16
 
!-------------------------------------------------------------------------
   SUBROUTINE INIRAD (O3PROF,Pw, kts, kte)
!-------------------------------------------------------------------------
      IMPLICIT NONE
!-------------------------------------------------------------------------
   INTEGER, INTENT(IN   )                        ::    kts,kte

   REAL, DIMENSION( kts:kte ),INTENT(INOUT)      ::    O3PROF

   REAL, DIMENSION( kts:kte+1 ),INTENT(IN   )    ::        Pw

! LOCAL VAR
  
   REAL, DIMENSION( kts:kte+1 ) :: PAVEL, TAVEL 
   REAL, DIMENSION(   0:kte+1 ) :: PZ, TZ

   INTEGER :: k


!                                                                                
!  COMPUTE OZONE MIXING RATIO DISTRIBUTION                                       
!                                                                                
   DO K=kts,kte
      O3PROF(K)=0.                                                       
   ENDDO
                                                                                 
   CALL O3DATA(O3PROF, Pw, kts, kte)
!                                                                                
   END SUBROUTINE INIRAD
                                                                                 
!-------------------------------------------------------------------------
   SUBROUTINE O3DATA (O3PROF, Pw, kts, kte)
!-------------------------------------------------------------------------
   IMPLICIT NONE
!-------------------------------------------------------------------------
!
   INTEGER, INTENT(IN   )   ::       kts, kte
!
   REAL, DIMENSION( kts:kte ),INTENT(INOUT)      ::    O3PROF

   REAL, DIMENSION( kts:kte+1 ),INTENT(IN   )    ::        Pw

! LOCAL VAR
   INTEGER :: K, JJ, NK

   REAL    ::  PRLEVH(kts:kte+1),PPWRKH(32),                       &
               O3WRK(31),PPWRK(31),O3SUM(31),PPSUM(31),          &
               O3WIN(31),PPWIN(31),O3ANN(31),PPANN(31)                                                       

   REAL    ::  PB1, PB2, PT1, PT2

   DATA O3SUM  /5.297E-8,5.852E-8,6.579E-8,7.505E-8,             &                    
        8.577E-8,9.895E-8,1.175E-7,1.399E-7,1.677E-7,2.003E-7,   &                 
        2.571E-7,3.325E-7,4.438E-7,6.255E-7,8.168E-7,1.036E-6,   &                 
        1.366E-6,1.855E-6,2.514E-6,3.240E-6,4.033E-6,4.854E-6,   &                 
        5.517E-6,6.089E-6,6.689E-6,1.106E-5,1.462E-5,1.321E-5,   &                 
        9.856E-6,5.960E-6,5.960E-6/                                              

   DATA PPSUM  /955.890,850.532,754.599,667.742,589.841,         &  
        519.421,455.480,398.085,347.171,301.735,261.310,225.360, &               
        193.419,165.490,141.032,120.125,102.689, 87.829, 75.123, &            
         64.306, 55.086, 47.209, 40.535, 34.795, 29.865, 19.122, &               
          9.277,  4.660,  2.421,  1.294,  0.647/                                 
!                                                                                
   DATA O3WIN  /4.629E-8,4.686E-8,5.017E-8,5.613E-8,             &
        6.871E-8,8.751E-8,1.138E-7,1.516E-7,2.161E-7,3.264E-7,   &               
        4.968E-7,7.338E-7,1.017E-6,1.308E-6,1.625E-6,2.011E-6,   &               
        2.516E-6,3.130E-6,3.840E-6,4.703E-6,5.486E-6,6.289E-6,   &               
        6.993E-6,7.494E-6,8.197E-6,9.632E-6,1.113E-5,1.146E-5,   &               
        9.389E-6,6.135E-6,6.135E-6/                                              

   DATA PPWIN  /955.747,841.783,740.199,649.538,568.404,         &
        495.815,431.069,373.464,322.354,277.190,237.635,203.433, &               
        174.070,148.949,127.408,108.915, 93.114, 79.551, 67.940, &               
         58.072, 49.593, 42.318, 36.138, 30.907, 26.362, 16.423, &               
          7.583,  3.620,  1.807,  0.938,  0.469/                                 
!                                                                                

   DO K=1,31                                                              
     PPANN(K)=PPSUM(K)                                                        
   ENDDO
!
   O3ANN(1)=0.5*(O3SUM(1)+O3WIN(1))                                           
!                                                                                
   DO K=2,31                                                              
      O3ANN(K)=O3WIN(K-1)+(O3WIN(K)-O3WIN(K-1))/(PPWIN(K)-PPWIN(K-1))* & 
               (PPSUM(K)-PPWIN(K-1))                                           
   ENDDO
!
   DO K=2,31                                                              
      O3ANN(K)=0.5*(O3ANN(K)+O3SUM(K))                                         
   ENDDO
!
   DO K=1,31                                                                
      O3WRK(K)=O3ANN(K)                                                        
      PPWRK(K)=PPANN(K)                                                        
   ENDDO
!                                                                                
!  CALCULATE HALF PRESSURE LEVELS FOR MODEL AND DATA LEVELS                     
!                                                                                

! Pw is total P at w level
! Pw is in mb

   DO K=kts,kte+1
      NK=kte+1-K+1
      PRLEVH(K)=Pw(NK)
   ENDDO
!                                                                                
   PPWRKH(1)=1100.                                                        
   DO K=2,31                                                           
      PPWRKH(K)=(PPWRK(K)+PPWRK(K-1))/2.                                   
   ENDDO
   PPWRKH(32)=0.                                                          
   DO K=kts,kte
      DO 25 JJ=1,31                                                        
         IF((-(PRLEVH(K)-PPWRKH(JJ))).GE.0.)THEN                            
           PB1=0.                                                           
         ELSE                                                               
           PB1=PRLEVH(K)-PPWRKH(JJ)                                         
         ENDIF                                                              
         IF((-(PRLEVH(K)-PPWRKH(JJ+1))).GE.0.)THEN                          
           PB2=0.                                                           
         ELSE                                                               
           PB2=PRLEVH(K)-PPWRKH(JJ+1)                                       
         ENDIF                                                              
         IF((-(PRLEVH(K+1)-PPWRKH(JJ))).GE.0.)THEN                          
           PT1=0.                                                           
         ELSE                                                               
           PT1=PRLEVH(K+1)-PPWRKH(JJ)                                       
         ENDIF                                                              
         IF((-(PRLEVH(K+1)-PPWRKH(JJ+1))).GE.0.)THEN                        
           PT2=0.                                                           
         ELSE                                                               
           PT2=PRLEVH(K+1)-PPWRKH(JJ+1)                                     
         ENDIF                                                              
         O3PROF(K)=O3PROF(K)+(PB2-PB1-PT2+PT1)*O3WRK(JJ)                
  25  CONTINUE                                                             
      O3PROF(K)=O3PROF(K)/(PRLEVH(K)-PRLEVH(K+1))                      

   ENDDO
!                                                                                
   END SUBROUTINE O3DATA

!---------------------------------------------------------------------------
   SUBROUTINE MM5ATM(CLDFRA,O3PROF,T,Tw,TSFC,QV,QC,QR,QI,QS,QG,    &
                     P,Pw,DELZ,EMISS,R,G,                          &
                     PAVEL,TAVEL,PZ,TZ,CLDFRAC,TAUCLOUD,COLDRY,    &
                     WKL,WX,TBOUND,SEMISS,                         &
                     kts,kte                                       )
!---------------------------------------------------------------------------
!  RRTM Longwave Radiative Transfer Model                                        
!  Atmospheric and Environmental Research, Inc., Cambridge, MA                   
!                                                                                
!  Revision for NCAR MM5:  J. Dudhia (converted from CCM code)                   
!                                                                                
!  Input atmospheric profile from NCAR MM5, and prepare it for use in RRTM.      
!  Set other RRTM input parameters.  Values are passed back through existing     
!  RRTM arrays and commons.                                                      
!---------------------------------------------------------------------------
! RRTM Definitions                                                               
!    MXLAY = kte+1                ! Maximum number of model layers               
!    MAXXSEC                      ! Maximum number of cross sections             
!    NLAYERS                      ! Number of model layers (kte+1)               
!    PAVEL(MXLAY)                 ! Layer pressures (mb)                         
!    PZ(0:MXLAY)                  ! Level (interface) pressures (mb)             
!    TAVEL(MXLAY)                 ! Layer temperatures (K)                       
!    TZ(0:MXLAY)                  ! Level (interface) temperatures(mb)           
!    TBOUND                       ! Surface temperature (K)                      
!    COLDRY(MXLAY)                ! Dry air column (molecules/cm2)               
!    WKL(35,MXLAY)                ! Molecular amounts (molecules/cm2)            
!    WBRODL(MXLAY)                ! Inactive in this version                     
!    WX(MAXXSEC)                  ! Cross-section amounts (molecules/cm2)        
!    CLDFRAC(MXLAY)               ! Layer cloud fraction                         
!    TAUCLOUD(MXLAY)              ! Layer cloud optical depth                    
!    AMD                          ! Atomic weight of dry air                     
!    AMW                          ! Atomic weight of water                       
!    AMO                          ! Atomic weight of ozone                       
!    AMCH4                        ! Atomic weight of methane                     
!    AMN2O                        ! Atomic weight of nitrous oxide               
!    AMC11                        ! Atomic weight of CFC-11                      
!    AMC12                        ! Atomic weight of CFC-12                      
!    NXMOL                        ! Number of cross-section molecules            
!    IXINDX                       ! Cross-section molecule index (see below)     
!    IXSECT                       ! On/off flag for cross-sections (inactive)    
!    IXMAX                        ! Maximum number of cross-sections (inactive)  
!                                                                                
!-----------------------------------------------------------------------------
! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
!----------------------------------------------------------------------------
!     Activate cross section molecules:                                             
!     NXMOL     - number of cross-sections input by user                         
!     IXINDX(I) - index of cross-section molecule corresponding to Ith           
!                 cross-section specified by user                                
!                 = 0 -- not allowed in RRTM                                     
!                 = 1 -- CCL4                                                    
!                 = 2 -- CFC11                                                   
!                 = 3 -- CFC12                                                   
!                 = 4 -- CFC22                                                   
!     DATA NXMOL  /2/                                                            
!     DATA IXINDX /0,2,3,0,31*0/                                                 
!                                                                                 
!    CLOUD EMISSIVITIES (M^2/G)                                                  
!    THESE ARE CONSISTENT WITH LWRAD (ABCW=0.5*(ABUP+ABDOWN))                    
!----------------------------------------------------------------------------

                                                                                 
      INTEGER, INTENT(IN ) ::  kts, kte
!
      REAL, DIMENSION( 35,kts:kte+1 ),                    &
            INTENT(INOUT)        ::                  WKL

      REAL, DIMENSION( MAXXSEC,kts:kte+1 ),               &
            INTENT(INOUT)        ::                   WX

      REAL, INTENT(INOUT)        ::               TBOUND
      REAL, DIMENSION(NBANDS), INTENT(INOUT) ::   SEMISS

      REAL, DIMENSION( kts:kte+1 ), INTENT(IN   ) ::      &
                                                      Tw, &
                                                      Pw
      REAL, DIMENSION( kts:kte ), INTENT(IN   ) ::        &
                                                  CLDFRA, &
                                                  O3PROF, &
                                                    DELZ, &
                                                       T, &
                                                       P

      REAL, DIMENSION( kts:kte ), INTENT(INOUT) ::        &
                                                      QV

      REAL, DIMENSION( kts:kte ), INTENT(IN   ) ::        &
                                                      QC, &
                                                      QR, &
                                                      QI, &
                                                      QS, &
                                                      QG

      REAL, DIMENSION( kts:kte+1 ), INTENT(INOUT) ::      &
                                                   PAVEL, &
                                                   TAVEL, &
                                                 CLDFRAC, &    
                                                TAUCLOUD, &
                                                  COLDRY 

      REAL, DIMENSION(   0:kte+1 ), INTENT(INOUT) ::      &
                                                      PZ, &
                                                      TZ

      REAL, INTENT(IN   ) ::   R,G,EMISS,TSFC

      REAL    :: GRAVIT
 
!
! LOCAL

      REAL, DIMENSION( kts:kte ) ::                 CLDFRC, &
                                                      PINT, &
                                                      TINT, &
                                                        O3, &
                                                       N2O, &
                                                       CH4, &
                                                      CLWP, &
                                                      CIWP, &
                                                      PLWP, &
                                                      PIWP
                           
      real :: amd       ! Effective molecular weight of dry air (g/mol)  
      real :: amw       ! Molecular weight of water vapor (g/mol)        
      real :: amo       ! Molecular weight of ozone (g/mol)              
      real :: amch4     ! Molecular weight of methane (g/mol)            
      real :: amn2o     ! Molecular weight of nitrous oxide (g/mol)      
      real :: amc11     ! Molecular weight of CFC11 (g/mol) - CFCL3      
      real :: amc12     ! Molecular weight of CFC12 (g/mol) - CF2CL2     
      real :: avgdro    ! Avogadro's number (molecules/mole)             
                                                                                 
! Atomic weights for conversion from mass to volume mixing ratios                

      data amd   /  28.9644   /                                                  
      data amw   /  18.0154   /                                                  
      data amo   /  47.9998   /                                                  
      data amch4 /  16.0430   /                                                  
      data amn2o /  44.0128   /                                                  
      data amc11 / 137.3684   /                                                  
      data amc12 / 120.9138   /                                                  
      data avgdro/ 6.022E23   /                                                  
                                                                                 
!     Set molecular weight ratios                                                    

      real :: amdw,  &  ! Molecular weight of dry air / water vapor      
              amdc,  &  ! Molecular weight of dry air / methane          
              amdn,  &  ! Molecular weight of dry air / nitrous oxide    
              amdc1, &  ! Molecular weight of dry air / CFC11            
              amdc2     ! Molecular weight of dry air / CFC12            

      data amdw /  1.607758 /                                                    
      data amdc /  1.805423 /                                                    
      data amdn /  0.658090 /                                                    
      data amdc1/  0.210852 /                                                    
      data amdc2/  0.239546 /                                                    

!     Put in CO2 volume mixing ratio here (330 ppmv)                                

      real :: co2vmr
      data co2vmr / 330.e-6 /                                                    
                                                                                 
      REAL :: ABCW,ABICE,ABRN,ABSN

      DATA ABCW /0.144/                                                          
      DATA ABICE /0.0735/                                                        
      DATA ABRN /0.330E-3/                                                       
      DATA ABSN /2.34E-3/                                                        

      GRAVIT = G*100.

!                                                                                
!  MID-LAYER VALUES                                                              
      DO K=kts,kte
          RO=P(K)/(R*T(K))*100.                                                  
          DZ=DELZ(K)
          QV(K)=AMAX1(QV(K),1.E-12) 
  
          CLDFRC(K)=CLDFRA(K)                                                   
                                                                                 
!  PATHS IN G/M^2                                                                

! QI=0 if no ice phase
! QS=0 if no ice phase

            CLWP(K)=RO*QC(K)*DZ*1000.                                            
            CIWP(K)=RO*QI(K)*DZ*1000.                                            
            PLWP(K)=(RO*QR(K))**0.75*DZ*1000.                                    
            PIWP(K)=(RO*QS(K))**0.75*DZ*1000.                                   
                                                                                 
          O3(K)=O3PROF(K)                                                      
          N2O(K)=0.                                                              
          CH4(K)=0.                                                              
                                                                                 
      ENDDO                                                                      
                                                                                 
!  Initialize all molecular amounts to zero here, then pass MM5 amounts          
!  into RRTM arrays WKL and WX below.                                            
                                                                                 
      DO 1000 ILAY = kts,kte+1
         DO 1100 ISP = 1,35                                                      
 1100       WKL(ISP,ILAY) = 0.0                                                  
         DO 1200 ISP = 1,MAXXSEC                                                 
 1200       WX(ISP,ILAY) = 0.0                                                   
 1000 CONTINUE                                                                   
                                                                                 
!  Set parameters needed for RRTM execution:                                     

      IXSECT = 1                                                                 
      IXMAX = 4                                                                  
                                                                                 
!  Set surface temperature.  The longwave upward surface flux is                 
!  computed in the Land Surface Model based on the surface                       
!  temperature and the emissivity of the surface type for each                   
!  grid point.  The bottom interface temperature, tint(kte+1), is                 
!  ground temperature consistent with this LW upward flux, and                   
!  TBOUND is set to this temperature here.                                       
                                                                                 
!     TBOUND = TINT(kte+1)                                                        
      TBOUND = Tw(kte+1)                                                        
!     TBOUND = TSFC
                                                                                 
!  Install MM5 profiles into RRTM arrays for pressure, temperature,              
!  and molecular amounts.  Pressures are converted from cb                       
!  (CCM) to mb (RRTM).  H2O and trace gas amounts are converted from             
!  mass mixing ratio to volume mixing ratio.  CO2 vmr is constant at all         
!  levels.  The dry air column COLDRY (in molec/cm2) is calculated               
!  from the level pressures PZ (in mb) based on the hydrostatic equation         
!  and includes a correction to account for H2O in the layer.  The               
!  molecular weight of moist air (amm) is calculated for each layer.             
                                                                                 
!  RRTM is executed for an additional layer (L=kte+1), which extends              
!  from the model top (ptop) to 0 mb, to calculate the downward                  
!  flux at the model top interface.  H2O, CO2, and O3 vmrs for this              
!  extra layer are set to the values in the model's top layer, though            
!  the O3 value is reduced by a fraction (0.6) based on the US Std Atm.          
!  For GCMs with a model top near 0 mb, this extra layer is not needed, and      
!  NLAYERS should be set to the number of model layers (kte in this case).       
!  Note: RRTM levels count from bottom to top, while MM5 levels count            
!  from the top down and must be reversed here.                                  
                                                                                 
!     NMOL = 6                                                                   
!     PZ(0) = pint(kte+1)                                                         
!     TZ(0) = tint(kte+1)                                                         

      PZ(0) = Pw(kte+1)                                                         
      TZ(0) = Tw(kte+1)                                                         
      DO 2000 L = 1, NLAYERS-1                                                   
         PAVEL(L) = p(kte+1-L)                                                   
         TAVEL(L) = t(kte+1-L)                                                   
!        PZ(L) = pint(kte+1-L)                                                    
!        TZ(L) = tint(kte+1-L)                                                    
         PZ(L) = Pw(kte+1-L)                                                    
         TZ(L) = Tw(kte+1-L)                                                    
         WKL(1,L) = qv(kte+1-L)*amdw                                             
         WKL(2,L) = co2vmr                                                       
         WKL(3,L) = o3(kte+1-L)                                                  
         WKL(4,L) = n2o(kte+1-L)*amdn                                            
         WKL(6,L) = ch4(kte+1-L)*amdc                                            
         amm = (1-WKL(1,L))*amd + WKL(1,L)*amw                                   
         COLDRY(L) = (PZ(L-1)-PZ(L))*1.E3*avgdro/    & 
                               (gravit*amm*(1+WKL(1,L)))                         
 2000    CONTINUE                                                                
                                                                                 
!  Set cross section molecule amounts from CCM; convert to vmr                   
      DO 2100 L=1, NLAYERS-1                                                     
!        WX(2,L) = c11mmr(kte+1-L)*amdc1                                         
!        WX(3,L) = c12mmr(kte+1-L)*amdc2                                         
         WX(2,L) = 0.                                                            
         WX(3,L) = 0.                                                            
 2100 CONTINUE                                                                   
                                                                                 
!  *****                                                                         
!  Set up values for extra layer at top of the atmosphere.                       
!  The top layer temperature for all gridpoints is set to the top layer-1        
!  temperature plus a constant (0 K) that represents an isothermal layer         
!  above ptop.  Top layer interface temperatures are                             
!  linearly interpolated from the layer temperatures.                            
!  Note: The top layer temperature and ozone amount are based on a 0-3mb         
!  top layer and must be modified if the layering is changed.                    
!  This section should be commented if the extra layer is not needed.            
                                                                                 
      PAVEL(NLAYERS) = 0.5*PZ(NLAYERS-1)                                         
      TAVEL(NLAYERS) = TAVEL(NLAYERS-1) + 0.0                                    
      PZ(NLAYERS) = 0.00                                                         
      TZ(NLAYERS-1) = 0.5*(TAVEL(NLAYERS)+TAVEL(NLAYERS-1))                      
      TZ(NLAYERS) = TZ(NLAYERS-1)+0.0                                            
      WKL(1,NLAYERS) = WKL(1,NLAYERS-1)                                          
      WKL(2,NLAYERS) = co2vmr                                                    
      WKL(3,NLAYERS) = 0.6*WKL(3,NLAYERS-1)                                      
      WKL(4,NLAYERS) = WKL(4,NLAYERS-1)                                          
      WKL(6,NLAYERS) = WKL(6,NLAYERS-1)                                          
      amm = (1-WKL(1,NLAYERS-1))*amd + WKL(1,NLAYERS-1)*amw                      
!     COLDRY(NLAYERS) = (PZ(NLAYERS-1))*1.E3*avgdro/       & 
      COLDRY(NLAYERS) = ((PZ(NLAYERS-1)-PZ(NLAYERS)))*1.E3*avgdro/       & 
                               (gravit*amm*(1+WKL(1,NLAYERS-1)))                 
      WX(2,NLAYERS) = WX(2,NLAYERS-1)                                            
      WX(3,NLAYERS) = WX(3,NLAYERS-1)                                            
!  *****                                                                         
                                                                                 
!  Here, all molecules in WKL and WX are in volume mixing ratio; convert to      
!  molec/cm2 based on COLDRY for use in RRTM                                     
                                                                                 
      DO 5000 L = 1, NLAYERS                                                     
         DO 4200 IMOL = 1, NMOL                                                  
            WKL(IMOL,L) = COLDRY(L) * WKL(IMOL,L)                                
 4200    CONTINUE                                                                
         DO 4400 IX = 1,MAXXSEC                                                  
            IF (IXINDX(IX) .NE. 0) THEN                                          
               WX(IXINDX(IX),L) = COLDRY(L) * WX(IX,L) * 1.E-20                  
            ENDIF                                                                
 4400    CONTINUE                                                                
 5000 CONTINUE                                                                   
                                                                                 
!  Set spectral surface emissivity for each longwave band.  The default value    
!  is set here to emiss(i,j) based on land-use (taken to be constant across band 
!  Comment: if land-surface uses skin temperature, emissivity must match that    
!   used in its calculation (e.g. 1.0)                                           
      DO 5500 N=1,NBANDS                                                         
         SEMISS(N) = EMISS
 5500 CONTINUE                                                                   
                                                                                 
!  Transfer cloud fraction to RRTM array; compute cloud optical depth, TAUCLOUD, 
!  as the product of clwp and cloud mass absorption coefficient in MM5, which is 
!  a  combination of liquid and ice absorption coefficients.                     
!  Note: RRTM levels count from bottom to top, while CCM levels count from the   
!  top down and must be reversed here.  Values for the extra RRTM level (above   
!  the model top) are set to zero.                                               
                                                                                 
      DO 7000 L = 1, NLAYERS-1                                                   
         TAUCLOUD(L) = ABCW*CLWP(kte+1-L)+ABICE*CIWP(kte+1-L) & 
                      +ABRN*PLWP(kte+1-L)+ABSN*PIWP(kte+1-L)                       
         IF(TAUCLOUD(L).GT.0.01)CLDFRC(kte+1-L)=1.                                
         CLDFRAC(L) = cldfrc(kte+1-L)                                             
 7000 CONTINUE                                                                   
      CLDFRAC(NLAYERS) = 0.0                                                     
      TAUCLOUD(NLAYERS) = 0.0                                                    

   END SUBROUTINE MM5ATM

!---------------------------------------------------------------------------
      SUBROUTINE SETCOEF(kts,ktep1,                                        &
                         PAVEL,TAVEL,COLDRY,COLH2O,COLCO2,COLO3,           &
                         COLN2O,COLCH4,COLO2,CO2MULT,                      &
                         FAC00,FAC01,FAC10,FAC11,                          &
                         FORFAC,SELFFAC,SELFFRAC,                          &
                         JP,JT,JT1,INDSELF,WKL,LAYTROP,LAYSWTCH,LAYLOW     )
!---------------------------------------------------------------------------
      IMPLICIT NONE
!---------------------------------------------------------------------------
!  RRTM Longwave Radiative Transfer Model                                        
!  Atmospheric and Environmental Research, Inc., Cambridge, MA                   
!                                                                                
!  Original version:       E. J. Mlawer, et al.                                  
!  Revision for NCAR CCM:  Michael J. Iacono; September, 1998                    
!                                                                                
!  For a given atmosphere, calculate the indices and fractions related to the    
!  pressure and temperature interpolations.  Also calculate the values of the    
!  integrated Planck functions for each band at the level and layer              
!  temperatures.                                                                 
!---------------------------------------------------------------------------

      INTEGER, INTENT(IN   ) ::          kts, ktep1

      REAL, DIMENSION( 35,kts:ktep1),                    &
            INTENT(IN   )        ::                  WKL

      INTEGER, INTENT(INOUT) ::  LAYTROP,LAYSWTCH,LAYLOW

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::      &
                                                   PAVEL, &
                                                   TAVEL, &
                                                  COLDRY

      REAL, DIMENSION( kts:ktep1 ), INTENT(INOUT) ::      &
                                                  COLH2O, &
                                                  COLCO2, &
                                                   COLO3, &
                                                  COLN2O, &
                                                  COLCH4, &
                                                   COLO2, &
                                                 CO2MULT, &
                                                   FAC00, &
                                                   FAC01, &
                                                   FAC10, &
                                                   FAC11, &
                                                  FORFAC, &
                                                 SELFFAC, &
                                                SELFFRAC

      INTEGER, DIMENSION( kts:ktep1 ), INTENT(INOUT) ::   &
                                                      JP, &
                                                      JT, &
                                                     JT1, &
                                                 INDSELF
! LOCAL 
     
      INTEGER ::   LAY, JP1 
      REAL    ::   STPFAC, PLOG, FP, FT, FT1, WATERS, WATER, &
                   CALEFAC, FACTOR, CO2REG, COMPFP, SCALEFAC 

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
      STPFAC = 296./1013.                                                        
      
      LAYTROP = 0                                                                
      LAYSWTCH = 0                                                               
      LAYLOW = 0                                                                 
      DO 7000 LAY = 1, NLAYERS                                                   
!        Find the two reference pressures on either side of the                  
!        layer pressure.  Store them in JP and JP1.  Store in FP the             
!        fraction of the difference (in ln(pressure)) between these              
!        two values that the layer pressure lies.                                
         PLOG = LOG(PAVEL(LAY))                                                  
         JP(LAY) = INT(36. - 5*(PLOG+0.04))                                      
         IF (JP(LAY) .LT. 1) THEN                                                
            JP(LAY) = 1                                                          
         ELSEIF (JP(LAY) .GT. 58) THEN                                           
            JP(LAY) = 58                                                         
         ENDIF                                                                   
         JP1 = JP(LAY) + 1                                                       
         FP = 5. * (PREFLOG(JP(LAY)) - PLOG)                                     
                                                                                 
!        Determine, for each reference pressure (JP and JP1), which              
!        reference temperature (these are different for each                     
!        reference pressure) is nearest the layer temperature but does           
!        not exceed it.  Store these indices in JT and JT1, resp.                
!        Store in FT (resp. FT1) the fraction of the way between JT              
!        (JT1) and the next highest reference temperature that the               
!        layer temperature falls.                                                
         JT(LAY) = INT(3. + (TAVEL(LAY)-TREF(JP(LAY)))/15.)                      
         IF (JT(LAY) .LT. 1) THEN                                                
            JT(LAY) = 1                                                          
         ELSEIF (JT(LAY) .GT. 4) THEN                                            
            JT(LAY) = 4                                                          
         ENDIF                                                                   
         FT = ((TAVEL(LAY)-TREF(JP(LAY)))/15.) - FLOAT(JT(LAY)-3)                
         JT1(LAY) = INT(3. + (TAVEL(LAY)-TREF(JP1))/15.)                         
         IF (JT1(LAY) .LT. 1) THEN                                               
            JT1(LAY) = 1                                                         
         ELSEIF (JT1(LAY) .GT. 4) THEN                                           
            JT1(LAY) = 4                                                         
         ENDIF                                                                   
         FT1 = ((TAVEL(LAY)-TREF(JP1))/15.) - FLOAT(JT1(LAY)-3)                  
                                                                                 
         WATER = WKL(1,LAY)/COLDRY(LAY)                                          
         SCALEFAC = PAVEL(LAY) * STPFAC / TAVEL(LAY)                             
                                                                                 
!        If the pressure is less than ~100mb, perform a different                
!        set of species interpolations.                                          
         IF (PLOG .LE. 4.56) GO TO 5300                                          
         LAYTROP =  LAYTROP + 1                                                  
!        For one band, the "switch" occurs at ~300 mb.                           
! JD: changed from (PLOG .GE. 5.76) to avoid out-of-range                        
         IF (PLOG .Gt. 5.76) LAYSWTCH = LAYSWTCH + 1                             
         IF (PLOG .GE. 6.62) LAYLOW = LAYLOW + 1                                 
!                                                                                
         FORFAC(LAY) = SCALEFAC / (1.+WATER)                                     
!        Set up factors needed to separately include the water vapor             
!        self-continuum in the calculation of absorption coefficient.            
         SELFFAC(LAY) = WATER * FORFAC(LAY)                                      
         FACTOR = (TAVEL(LAY)-188.0)/7.2                                         
         INDSELF(LAY) = MIN(9, MAX(1, INT(FACTOR)-7))                            
         SELFFRAC(LAY) = FACTOR - FLOAT(INDSELF(LAY) + 7)                        
                                                                                 
!        Calculate needed column amounts.                                        
         COLH2O(LAY) = 1.E-20 * WKL(1,LAY)                                       
         COLCO2(LAY) = 1.E-20 * WKL(2,LAY)                                       
         COLO3(LAY) = 1.E-20 * WKL(3,LAY)                                        
         COLN2O(LAY) = 1.E-20 * WKL(4,LAY)                                       
         COLCH4(LAY) = 1.E-20 * WKL(6,LAY)                                       
         COLO2(LAY) = 1.E-20 * WKL(7,LAY)                                        
         IF (COLCO2(LAY) .EQ. 0.) COLCO2(LAY) = 1.E-32 * COLDRY(LAY)             
         IF (COLN2O(LAY) .EQ. 0.) COLN2O(LAY) = 1.E-32 * COLDRY(LAY)             
         IF (COLCH4(LAY) .EQ. 0.) COLCH4(LAY) = 1.E-32 * COLDRY(LAY)             
!        Using E = 1334.2 cm-1.                                                  
         CO2REG = 3.55E-24 * COLDRY(LAY)                                         
         CO2MULT(LAY)= (COLCO2(LAY) - CO2REG) *    & 
              272.63*EXP(-1919.4/TAVEL(LAY))/(8.7604E-4*TAVEL(LAY))              
         GO TO 5400                                                              
                                                                                 
!        Above LAYTROP.                                                          
 5300    CONTINUE                                                                
                                                                                 
         FORFAC(LAY) = SCALEFAC / (1.+WATER)                                     
!        Calculate needed column amounts.                                        
         COLH2O(LAY) = 1.E-20 * WKL(1,LAY)                                       
         COLCO2(LAY) = 1.E-20 * WKL(2,LAY)                                       
         COLO3(LAY) = 1.E-20 * WKL(3,LAY)                                        
         COLN2O(LAY) = 1.E-20 * WKL(4,LAY)                                       
         COLCH4(LAY) = 1.E-20 * WKL(6,LAY)                                       
         COLO2(LAY) = 1.E-20 * WKL(7,LAY)                                        
         IF (COLCO2(LAY) .EQ. 0.) COLCO2(LAY) = 1.E-32 * COLDRY(LAY)             
         IF (COLN2O(LAY) .EQ. 0.) COLN2O(LAY) = 1.E-32 * COLDRY(LAY)             
         IF (COLCH4(LAY) .EQ. 0.) COLCH4(LAY) = 1.E-32 * COLDRY(LAY)             
         CO2REG = 3.55E-24 * COLDRY(LAY)                                         
         CO2MULT(LAY)= (COLCO2(LAY) - CO2REG) *   & 
              272.63*EXP(-1919.4/TAVEL(LAY))/(8.7604E-4*TAVEL(LAY))              
 5400    CONTINUE                                                                
                                                                                 
!        We have now isolated the layer ln pressure and temperature,             
!        between two reference pressures and two reference temperatures          
!        (for each reference pressure).  We multiply the pressure                
!        fraction FP with the appropriate temperature fractions to get           
!        the factors that will be needed for the interpolation that yields       
!        the optical depths (performed in routines TAUGBn for band n).           
                                                                                 
         COMPFP = 1. - FP                                                        
         FAC10(LAY) = COMPFP * FT                                                
         FAC00(LAY) = COMPFP * (1. - FT)                                         
         FAC11(LAY) = FP * FT1                                                   
         FAC01(LAY) = FP * (1. - FT1)                                            
                                                                                 
 7000 CONTINUE                                                                   
                                                                                 
!        Set LAYLOW for profiles with surface pressure less than 750mb.          
         IF (LAYLOW.EQ.0) LAYLOW=1                                               
!        Sometimes round-off gives wrong LAYSWTCH therefore check here (JD)
         IF (JP(LAYSWTCH+1).LE.6) THEN
           LAYSWTCH=LAYSWTCH+1
         ENDIF

   END SUBROUTINE SETCOEF

!-------------------------------------------------------------------------------
!*                                                                             * 
!*                  Optical depths developed for the                           * 
!*                                                                             * 
!*                RAPID RADIATIVE TRANSFER MODEL (RRTM)                        * 
!*                                                                             * 
!*                                                                             * 
!*            ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC.                     * 
!*                        840 MEMORIAL DRIVE                                   * 
!*                        CAMBRIDGE, MA 02139                                  * 
!*                                                                             * 
!*                                                                             * 
!*                           ELI J. MLAWER                                     * 
!*                         STEVEN J. TAUBMAN                                   * 
!*                         SHEPARD A. CLOUGH                                   * 
!*                                                                             * 
!*                                                                             * 
!*                                                                             * 
!*                                                                             * 
!*                       email:  mlawer@aer.com                                * 
!*                                                                             * 
!*        The authors wish to acknowledge the contributions of the             * 
!*        following people:  Patrick D. Brown, Michael J. Iacono,              * 
!*        Ronald E. Farren, Luke Chen, Robert Bergstrom.                       * 
!*                                                                             * 
!-------------------------------------------------------------------------------
!*                                                                             * 
!*  Revision for NCAR CCM:  Michael J. Iacono; September, 1998                 * 
!*                                                                             * 
!*     TAUMOL                                                                  * 
!*                                                                             * 
!*     This file contains the subroutines TAUGBn (where n goes from            * 
!*     1 to 16).  TAUGBn calculates the optical depths and Planck fractions    * 
!*     per g-value and layer for band n.                                       * 
!*                                                                             * 
!*  Output:  optical depths (unitless)                                         * 
!*           fractions needed to compute Planck functions at every layer       * 
!*               and g-value                                                   * 
!*                                                                             * 
!*     COMMON /TAUGCOM/  TAUG(MXLAY,MG)                                        * 
!*     COMMON /PLANKG/   FRACS(MXLAY,MG)                                       * 
!*                                                                             * 
!*  Input                                                                      * 
!*                                                                             * 
!*     COMMON /FEATURES/ NG(NBANDS),NSPA(NBANDS),NSPB(NBANDS)                  * 
!*     COMMON /PRECISE/  ONEMINUS                                              * 
!*     COMMON /PROFILE/  NLAYERS,PAVEL(MXLAY),TAVEL(MXLAY),                    * 
!*    &                  PZ(0:MXLAY),TZ(0:MXLAY)                               * 
!*     COMMON /PROFDATA/ LAYTROP,LAYSWTCH,LAYLOW,                              * 
!*    &                  COLH2O(MXLAY),COLCO2(MXLAY),                          * 
!*    &                  COLO3(MXLAY),COLN2O(MXLAY),COLCH4(MXLAY),             * 
!*    &                  COLO2(MXLAY),CO2MULT(MXLAY)                           * 
!*     COMMON /INTFAC/   FAC00(MXLAY),FAC01(MXLAY),                            * 
!*    &                  FAC10(MXLAY),FAC11(MXLAY)                             * 
!*     COMMON /INTIND/   JP(MXLAY),JT(MXLAY),JT1(MXLAY)                        * 
!*     COMMON /SELF/     SELFFAC(MXLAY), SELFFRAC(MXLAY), INDSELF(MXLAY)       * 
!*                                                                             * 
!*     Description:                                                            * 
!*     NG(IBAND) - number of g-values in band IBAND                            * 
!*     NSPA(IBAND) - for the lower atmosphere, the number of reference         * 
!*                   atmospheres that are stored for band IBAND per            * 
!*                   pressure level and temperature.  Each of these            * 
!*                   atmospheres has different relative amounts of the         * 
!*                   key species for the band (i.e. different binary           * 
!*                   species parameters).                                      * 
!*     NSPB(IBAND) - same for upper atmosphere                                 * 
!*     ONEMINUS - since problems are caused in some cases by interpolation     * 
!*                parameters equal to or greater than 1, for these cases       * 
!*                these parameters are set to this value, slightly < 1.        * 
!*     PAVEL - layer pressures (mb)                                            * 
!*     TAVEL - layer temperatures (degrees K)                                  * 
!*     PZ - level pressures (mb)                                               * 
!*     TZ - level temperatures (degrees K)                                     * 
!*     LAYTROP - layer at which switch is made from one combination of         * 
!*               key species to another                                        * 
!*     COLH2O, COLCO2, COLO3, COLN2O, COLCH4 - column amounts of water         * 
!*               vapor,carbon dioxide, ozone, nitrous ozide, methane,          * 
!*               respectively (molecules/cm**2)                                * 
!*     CO2MULT - for bands in which carbon dioxide is implemented as a         * 
!*               trace species, this is the factor used to multiply the        * 
!*               band's average CO2 absorption coefficient to get the added    * 
!*               contribution to the optical depth relative to 355 ppm.        * 
!*     FACij(LAY) - for layer LAY, these are factors that are needed to        * 
!*                  compute the interpolation factors that multiply the        * 
!*                  appropriate reference k-values.  A value of 0 (1) for      * 
!*                  i,j indicates that the corresponding factor multiplies     * 
!*                  reference k-value for the lower (higher) of the two        * 
!*                  appropriate temperatures, and altitudes, respectively.     * 
!*     JP - the index of the lower (in altitude) of the two appropriate        * 
!*          reference pressure levels needed for interpolation                 * 
!*     JT, JT1 - the indices of the lower of the two appropriate reference     * 
!*               temperatures needed for interpolation (for pressure           * 
!*               levels JP and JP+1, respectively)                             * 
!*     SELFFAC - scale factor needed to water vapor self-continuum, equals     * 
!*               (water vapor density)/(atmospheric density at 296K and        * 
!*               1013 mb)                                                      * 
!*     SELFFRAC - factor needed for temperature interpolation of reference     * 
!*                water vapor self-continuum data                              * 
!*     INDSELF - index of the lower of the two appropriate reference           * 
!*               temperatures needed for the self-continuum interpolation      * 
!*                                                                             * 
!*  Data input                                                                 * 
!*     COMMON /Kn/ KA(NSPA(n),5,13,MG), KB(NSPB(n),5,13:59,MG), SELFREF(10,MG) * 
!*        (note:  n is the band number)                                        * 
!*                                                                             * 
!*     Description:                                                            * 
!*     KA - k-values for low reference atmospheres (no water vapor             * 
!*          self-continuum) (units: cm**2/molecule)                            * 
!*     KB - k-values for high reference atmospheres (all sources)              * 
!*          (units: cm**2/molecule)                                            * 
!*     SELFREF - k-values for water vapor self-continuum for reference         * 
!*               atmospheres (used below LAYTROP)                              * 
!*               (units: cm**2/molecule)                                       * 
!*                                                                             * 
!*     DIMENSION ABSA(65*NSPA(n),MG), ABSB(235*NSPB(n),MG)                     * 
!*     EQUIVALENCE (KA,ABSA),(KB,ABSB)                                         * 
!*                                                                             * 
!******************************************************************************* 
                                                                                 
!---------------------------------------------------------------------------    
      SUBROUTINE TAUGB1(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11,          &
                        FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,         &
                        PFRAC,TAUG,LAYTROP                                 )
!---------------------------------------------------------------------------    
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )                      ::  LAYTROP

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLH2O, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                    FORFAC, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.            
!     Revised by Michael J. Iacono, Atmospheric & Environmental Research.        
                                                                                 
!     BAND 1:  10-250 cm-1 (low - H2O; high - H2O)                               
                                                                                 
! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure) and             
!     temperature.  Below LAYTROP, the water vapor self-continuum                
!     is interpolated (in temperature) separately.                               
      DO 2500 LAY = 1, LAYTROP                                                   
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(1) + 1                          
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(1) + 1                             
         INDS = INDSELF(LAY)                                                     
         DO 2000 IG = 1, NG1                                                     
            TAUG(IG,LAY) = COLH2O(LAY) *                       & 
                (FAC00(LAY) * ABSA1(IND0,IG) +                  &                 
                 FAC10(LAY) * ABSA1(IND0+1,IG) +                &                 
                 FAC01(LAY) * ABSA1(IND1,IG) +                  &                 
                 FAC11(LAY) * ABSA1(IND1+1,IG) +                &                 
                 SELFFAC(LAY) * (SELFREFC1(INDS,IG) +            &                 
                 SELFFRAC(LAY) *                               &                 
                 (SELFREFC1(INDS+1,IG) - SELFREFC1(INDS,IG))) +    &                 
                 FORFAC(LAY) * FORREFC1(IG))                                       
            PFRAC(IG,LAY) = FRACREFAC1(IG)                                         
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(1) + 1                         
         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(1) + 1                        
         DO 3000 IG = 1, NG1                                                     
            TAUG(IG,LAY) = COLH2O(LAY) *                      &
                (FAC00(LAY) * ABSB1(IND0,IG) +                 &                  
                 FAC10(LAY) * ABSB1(IND0+1,IG) +               &                  
                 FAC01(LAY) * ABSB1(IND1,IG) +                 &                  
                 FAC11(LAY) * ABSB1(IND1+1,IG) +               &                  
                 FORFAC(LAY) * FORREFC1(IG))                                       
            PFRAC(IG,LAY) = FRACREFBC1(IG)                                         
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
     
      END SUBROUTINE TAUGB1                        
                                                                                 
!----------------------------------------------------------------------------    
      SUBROUTINE TAUGB2(kts,ktep1,COLDRY,COLH2O,FAC00,FAC01,FAC10,FAC11,    &
                        FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,          &
                        PFRAC,TAUG,LAYTROP                                  )
!----------------------------------------------------------------------------    
                                                                                 
!     BAND 2:  250-500 cm-1 (low - H2O; high - H2O)                              
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, PARAMETER :: NGS1=8                                       

      INTEGER, INTENT(IN )                      ::  LAYTROP

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLDRY, &   
                                                    COLH2O, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                    FORFAC, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
      DIMENSION FC00(kts:ktep1),FC01(kts:ktep1),FC10(kts:ktep1),FC11(kts:ktep1)                  
      DIMENSION REFPARAM(13)                                                     
                                                                                 
!     These are the mixing ratios for H2O for a MLS atmosphere at the            
!     13 RRTM reference pressure levels:  1.8759999E-02, 1.2223309E-02,          
!     5.8908667E-03, 2.7675382E-03, 1.4065107E-03, 7.5969833E-04,                
!     3.8875898E-04, 1.6542293E-04, 3.7189537E-05, 7.4764857E-06,                
!     4.3081886E-06, 3.3319423E-06, 3.2039343E-06/                               
                                                                                 
!     The following are parameters related to the reference water vapor          
!     mixing ratios by REFPARAM(I) = REFH2O(I) / (.002+REFH2O(I)).               
!     These parameters are used for the Planck function interpolation.           
      DATA REFPARAM/  &                                                          
        0.903661, 0.859386, 0.746542, 0.580496, 0.412889, 0.275283, & 
        0.162745, 7.63929E-02, 1.82553E-02, 3.72432E-03,            &            
        2.14946E-03, 1.66320E-03, 1.59940E-03/                                   
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure) and             
!     temperature.  Below LAYTROP, the water vapor self-continuum is             
!     interpolated (in temperature) separately.                                  
      DO 2500 LAY = 1, LAYTROP                                                   
         WATER = 1.E20 * COLH2O(LAY) / COLDRY(LAY)                               
         H2OPARAM = WATER/(WATER +.002)                                          
         DO 1800 IFRAC = 2, 12                                                   
            IF (H2OPARAM .GE. REFPARAM(IFRAC)) GO TO 1900                        
 1800    CONTINUE                                                                
 1900    CONTINUE                                                                
         FRACINT = (H2OPARAM-REFPARAM(IFRAC))/    & 
              (REFPARAM(IFRAC-1)-REFPARAM(IFRAC))                                
                                                                                 
         FP = FAC11(LAY) + FAC01(LAY)                                            
         IFP = 2.E2*FP+0.5                                                       
         IF (IFP.LE.0) IFP = 0                                                   
         FC00(LAY) = FAC00(LAY) * CORR2(IFP)                                     
         FC10(LAY) = FAC10(LAY) * CORR2(IFP)                                     
         FC01(LAY) = FAC01(LAY) * CORR1(IFP)                                     
         FC11(LAY) = FAC11(LAY) * CORR1(IFP)                                     
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(2) + 1                          
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(2) + 1                             
         INDS = INDSELF(LAY)                                                     
         DO 2000 IG = 1, NG2                                                     
            TAUG(NGS1+IG,LAY) = COLH2O(LAY) *                   &                
                (FC00(LAY) * ABSA2(IND0,IG) +                    &                
                 FC10(LAY) * ABSA2(IND0+1,IG) +                  &                
                 FC01(LAY) * ABSA2(IND1,IG) +                    &                
                 FC11(LAY) * ABSA2(IND1+1,IG) +                  &                
                 SELFFAC(LAY) * (SELFREFC2(INDS,IG) +             &                
                 SELFFRAC(LAY) *                                &                
                 (SELFREFC2(INDS+1,IG) - SELFREFC2(INDS,IG))) +     &                
                 FORFAC(LAY) * FORREFC2(IG))                                       
            PFRAC(NGS1+IG,LAY) = FRACREFAC2(IG,IFRAC) + FRACINT * &
                 (FRACREFAC2(IG,IFRAC-1)-FRACREFAC2(IG,IFRAC))                       
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         FP = FAC11(LAY) + FAC01(LAY)                                            
         IFP = 2.E2*FP+0.5                                                       
         IF (IFP.LE.0) IFP = 0                                                   
         FC00(LAY) = FAC00(LAY) * CORR2(IFP)                                     
         FC10(LAY) = FAC10(LAY) * CORR2(IFP)                                     
         FC01(LAY) = FAC01(LAY) * CORR1(IFP)                                     
         FC11(LAY) = FAC11(LAY) * CORR1(IFP)                                     
         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(2) + 1                         
         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(2) + 1                        
         DO 3000 IG = 1, NG2                                                     
            TAUG(NGS1+IG,LAY) = COLH2O(LAY) *                  & 
                (FC00(LAY) * ABSB2(IND0,IG) +                   &                  
                 FC10(LAY) * ABSB2(IND0+1,IG) +                 &                  
                 FC01(LAY) * ABSB2(IND1,IG) +                   &                  
                 FC11(LAY) * ABSB2(IND1+1,IG) +                 &                  
                 FORFAC(LAY) * FORREFC2(IG))                                       
            PFRAC(NGS1+IG,LAY) = FRACREFBC2(IG)                                    
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 
      END SUBROUTINE TAUGB2
                                                                                 
!-----------------------------------------------------------------------------    
      SUBROUTINE TAUGB3(kts,ktep1,COLH2O,COLCO2,COLN2O,FAC00,FAC01,FAC10,    &
                        FAC11,FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,     &
                        PFRAC,TAUG,LAYTROP                                   )
!-----------------------------------------------------------------------------    
                                                                                 
!     BAND 3:  500-630 cm-1 (low - H2O,CO2; high - H2O,CO2)                      
                                                                                 
      INTEGER, PARAMETER :: NGS2=22                                      
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )                      ::  LAYTROP

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLH2O, &
                                                    COLCO2, &
                                                    COLN2O, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                    FORFAC, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
      DIMENSION H2OREF(59),CO2REF(59), ETAREF(10)                                
      REAL N2OMULT,N2OREF(59)                                              
                                                                                 
      DATA ETAREF/  &                                                             
           0.,0.125,0.25,0.375,0.5,0.625,0.75,0.875,0.9875,1.0/                  
      DATA H2OREF/  &                                                             
           1.87599E-02,1.22233E-02,5.89086E-03,2.76753E-03,1.40651E-03, &
           7.59698E-04,3.88758E-04,1.65422E-04,3.71895E-05,7.47648E-06, &        
           4.30818E-06,3.33194E-06,3.20393E-06,3.16186E-06,3.25235E-06, &        
           3.42258E-06,3.62884E-06,3.91482E-06,4.14875E-06,4.30810E-06, &        
           4.44204E-06,4.57783E-06,4.70865E-06,4.79432E-06,4.86971E-06, &        
           4.92603E-06,4.96688E-06,4.99628E-06,5.05266E-06,5.12658E-06, &        
           5.25028E-06,5.35708E-06,5.45085E-06,5.48304E-06,5.50000E-06, &        
           5.50000E-06,5.45359E-06,5.40468E-06,5.35576E-06,5.25327E-06, &        
           5.14362E-06,5.03396E-06,4.87662E-06,4.69787E-06,4.51911E-06, &        
           4.33600E-06,4.14416E-06,3.95232E-06,3.76048E-06,3.57217E-06, &        
           3.38549E-06,3.19881E-06,3.01212E-06,2.82621E-06,2.64068E-06, &        
           2.45515E-06,2.26962E-06,2.08659E-06,1.93029E-06/                      
      DATA N2OREF/  & 
           3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07, &
           3.19652E-07,3.15324E-07,3.03830E-07,2.94221E-07,2.84953E-07, &        
           2.76714E-07,2.64709E-07,2.42847E-07,2.09547E-07,1.71945E-07, &        
           1.37491E-07,1.13319E-07,1.00354E-07,9.12812E-08,8.54633E-08, &        
           8.03631E-08,7.33718E-08,6.59754E-08,5.60386E-08,4.70901E-08, &        
           3.99774E-08,3.29786E-08,2.60642E-08,2.10663E-08,1.65918E-08, &        
           1.30167E-08,1.00900E-08,7.62490E-09,6.11592E-09,4.66725E-09, &        
           3.28574E-09,2.84838E-09,2.46198E-09,2.07557E-09,1.85507E-09, &        
           1.65675E-09,1.45843E-09,1.31948E-09,1.20716E-09,1.09485E-09, &        
           9.97803E-10,9.31260E-10,8.64721E-10,7.98181E-10,7.51380E-10, &        
           7.13670E-10,6.75960E-10,6.38250E-10,6.09811E-10,5.85998E-10, &        
           5.62185E-10,5.38371E-10,5.15183E-10,4.98660E-10/                      
      DATA CO2REF/ &                                                             
           53*3.55E-04, 3.5470873E-04, 3.5427220E-04, 3.5383567E-04,    &
           3.5339911E-04, 3.5282588E-04, 3.5079606E-04/                          
                        
      STRRAT = 1.19268                                                           
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure),                
!     temperature, and appropriate species.  Below LAYTROP, the water            
!     vapor self-continuum is interpolated (in temperature) separately.          

      DO 2500 LAY = 1, LAYTROP                                                   
         SPECCOMB = COLH2O(LAY) + STRRAT*COLCO2(LAY)                             
         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
         SPECMULT = 8.*(SPECPARM)                                                
         JS = 1 + INT(SPECMULT)                                                  
         FS = AMOD(SPECMULT,1.0)                                                 
         IF (JS .EQ. 8) THEN                                                     
            IF (FS .GE. 0.9) THEN                                                
               JS = 9                                                            
               FS = 10. * (FS - 0.9)                                             
            ELSE                                                                 
               FS = FS/0.9                                                       
            ENDIF                                                                
         ENDIF                                                                   
         NS = JS + INT(FS + 0.5)                                                 
         FP = FAC01(LAY) + FAC11(LAY)                                            
         FAC000 = (1. - FS) * FAC00(LAY)                                         
         FAC010 = (1. - FS) * FAC10(LAY)                                         
         FAC100 = FS * FAC00(LAY)                                                
         FAC110 = FS * FAC10(LAY)                                                
         FAC001 = (1. - FS) * FAC01(LAY)                                         
         FAC011 = (1. - FS) * FAC11(LAY)                                         
         FAC101 = FS * FAC01(LAY)                                                
         FAC111 = FS * FAC11(LAY)                                                
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(3) + JS                         
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(3) + JS                            
         INDS = INDSELF(LAY)                                                     
         COLREF1 = N2OREF(JP(LAY))                                               
         COLREF2 = N2OREF(JP(LAY)+1)                                             
         IF (NS .EQ. 10) THEN                                                    
            WCOMB1 = H2OREF(JP(LAY))                                             
            WCOMB2 = H2OREF(JP(LAY)+1)                                           
         ELSE                                                                    
            WCOMB1 = STRRAT * CO2REF(JP(LAY))/(1.-ETAREF(NS))                    
            WCOMB2 = STRRAT * CO2REF(JP(LAY)+1)/(1.-ETAREF(NS))                  
         ENDIF                                                                   
         RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))         
         CURRN2O = SPECCOMB * RATIO                                              
         N2OMULT = COLN2O(LAY) - CURRN2O                                         
!!DIR$ VECTOR                                                                     
         DO 2000 IG = 1, NG3                                                     
            TAUG(NGS2+IG,LAY) = SPECCOMB *                     & 
                (FAC000 * ABSA3(IND0,IG) +                      &                 
                 FAC100 * ABSA3(IND0+1,IG) +                    &                 
                 FAC010 * ABSA3(IND0+10,IG) +                   &                 
                 FAC110 * ABSA3(IND0+11,IG) +                   &                 
                 FAC001 * ABSA3(IND1,IG) +                      &                 
                 FAC101 * ABSA3(IND1+1,IG) +                    &                 
                 FAC011 * ABSA3(IND1+10,IG) +                   &                 
                 FAC111 * ABSA3(IND1+11,IG)) +                  &                 
                 COLH2O(LAY) *                                 &                 
                 (SELFFAC(LAY) * (SELFREFC3(INDS,IG) +           &                 
                 SELFFRAC(LAY) *                               &                 
                 (SELFREFC3(INDS+1,IG) - SELFREFC3(INDS,IG))) +    &                 
                 FORFAC(LAY) * FORREFC3(IG))                     &                 
                 + N2OMULT * ABSN2OAC3(IG)                                         
            PFRAC(NGS2+IG,LAY) = FRACREFAC3(IG,JS) + FS *        & 
                 (FRACREFAC3(IG,JS+1) - FRACREFAC3(IG,JS))                           
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
!!DIR$ NOVECTOR                                                                   
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         SPECCOMB = COLH2O(LAY) + STRRAT*COLCO2(LAY)                             
         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
         SPECMULT = 4.*(SPECPARM)                                                
         JS = 1 + INT(SPECMULT)                                                  
         FS = AMOD(SPECMULT,1.0)                                                 
         NS = JS + INT(FS + 0.5)                                                 
         FP = FAC01(LAY) + FAC11(LAY)                                            
         FAC000 = (1. - FS) * FAC00(LAY)                                         
         FAC010 = (1. - FS) * FAC10(LAY)                                         
         FAC100 = FS * FAC00(LAY)                                                
         FAC110 = FS * FAC10(LAY)                                                
         FAC001 = (1. - FS) * FAC01(LAY)                                         
         FAC011 = (1. - FS) * FAC11(LAY)                                         
         FAC101 = FS * FAC01(LAY)                                                
         FAC111 = FS * FAC11(LAY)                                                
         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(3) + JS                        
         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(3) + JS                       
         COLREF1 = N2OREF(JP(LAY))                                               
         COLREF2 = N2OREF(JP(LAY)+1)                                             
         IF (NS .EQ. 5) THEN                                                     
            WCOMB1 = H2OREF(JP(LAY))                                             
            WCOMB2 = H2OREF(JP(LAY)+1)                                           
         ELSE                                                                    
            WCOMB1 = STRRAT * CO2REF(JP(LAY))/(1.-ETAREF(NS))                    
            WCOMB2 = STRRAT * CO2REF(JP(LAY)+1)/(1.-ETAREF(NS))                  
         ENDIF                                                                   
         RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))         
         CURRN2O = SPECCOMB * RATIO                                              
         N2OMULT = COLN2O(LAY) - CURRN2O                                         
!!DIR$ VECTOR                                                                     
         DO 3000 IG = 1, NG3                                                     
            TAUG(NGS2+IG,LAY) = SPECCOMB *                 &
                (FAC000 * ABSB3(IND0,IG) +                  &                     
                 FAC100 * ABSB3(IND0+1,IG) +                &                     
                 FAC010 * ABSB3(IND0+5,IG) +                &                     
                 FAC110 * ABSB3(IND0+6,IG) +                &                     
                 FAC001 * ABSB3(IND1,IG) +                  &                     
                 FAC101 * ABSB3(IND1+1,IG) +                &                     
                 FAC011 * ABSB3(IND1+5,IG) +                &                     
                 FAC111 * ABSB3(IND1+6,IG)) +               &                     
                 COLH2O(LAY) * FORFAC(LAY) * FORREFC3(IG)    &                     
                 + N2OMULT * ABSN2OBC3(IG)                                         
            PFRAC(NGS2+IG,LAY) = FRACREFBC3(IG,JS) + FS *    & 
                 (FRACREFBC3(IG,JS+1) - FRACREFBC3(IG,JS))                           
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 
      END SUBROUTINE TAUGB3
                                                                                 
!----------------------------------------------------------------------------    
      SUBROUTINE TAUGB4(kts,ktep1,COLH2O,COLCO2,COLO3,FAC00,FAC01,FAC10,    &
                        FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,           &
                        PFRAC,TAUG,LAYTROP                                  )
!----------------------------------------------------------------------------    
                                                                                 
!     BAND 4:  630-700 cm-1 (low - H2O,CO2; high - O3,CO2)                       
                                                                                 
      INTEGER, PARAMETER :: NGS3=38                                      
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )                      ::  LAYTROP

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLH2O, &
                                                    COLCO2, &
                                                     COLO3, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
      STRRAT1 = 850.577                                                          
      STRRAT2 = 35.7416                                                          
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure),                
!     temperature, and appropriate species.  Below LAYTROP, the water            
!     vapor self-continuum is interpolated (in temperature) separately.          
!!DIR$ NOVECTOR                                                                   
      DO 2500 LAY = 1, LAYTROP                                                   
         SPECCOMB = COLH2O(LAY) + STRRAT1*COLCO2(LAY)                            
         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
         SPECMULT = 8.*(SPECPARM)                                                
         JS = 1 + INT(SPECMULT)                                                  
         FS = AMOD(SPECMULT,1.0)                                                 
         FAC000 = (1. - FS) * FAC00(LAY)                                         
         FAC010 = (1. - FS) * FAC10(LAY)                                         
         FAC100 = FS * FAC00(LAY)                                                
         FAC110 = FS * FAC10(LAY)                                                
         FAC001 = (1. - FS) * FAC01(LAY)                                         
         FAC011 = (1. - FS) * FAC11(LAY)                                         
         FAC101 = FS * FAC01(LAY)                                                
         FAC111 = FS * FAC11(LAY)                                                
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(4) + JS                         
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(4) + JS                            
         INDS = INDSELF(LAY)                                                     
!!DIR$ VECTOR                                                                     
         DO 2000 IG = 1, NG4                                                     
            TAUG(NGS3+IG,LAY) = SPECCOMB *                    &
                (FAC000 * ABSA4(IND0,IG) +                     &                  
                 FAC100 * ABSA4(IND0+1,IG) +                   &                  
                 FAC010 * ABSA4(IND0+9,IG) +                   &                  
                 FAC110 * ABSA4(IND0+10,IG) +                  &                  
                 FAC001 * ABSA4(IND1,IG) +                     &                  
                 FAC101 * ABSA4(IND1+1,IG) +                   &                  
                 FAC011 * ABSA4(IND1+9,IG) +                   &                  
                 FAC111 * ABSA4(IND1+10,IG)) +                 &                  
                 COLH2O(LAY) *                                &                  
                 SELFFAC(LAY) * (SELFREFC4(INDS,IG) +           &                  
                 SELFFRAC(LAY) *                              &                  
                 (SELFREFC4(INDS+1,IG) - SELFREFC4(INDS,IG)))                        
            PFRAC(NGS3+IG,LAY) = FRACREFAC4(IG,JS) + FS *       &                  
                 (FRACREFAC4(IG,JS+1) - FRACREFAC4(IG,JS))                           
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
!!DIR$ NOVECTOR                                                                   
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         SPECCOMB = COLO3(LAY) + STRRAT2*COLCO2(LAY)                             
         SPECPARM = COLO3(LAY)/SPECCOMB                                          
         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
         SPECMULT = 4.*(SPECPARM)                                                
         JS = 1 + INT(SPECMULT)                                                  
         FS = AMOD(SPECMULT,1.0)                                                 
         IF (JS .GT. 1) THEN                                                     
            JS = JS + 1                                                          
         ELSEIF (FS .GE. 0.0024) THEN                                            
            JS = 2                                                               
            FS = (FS - 0.0024)/0.9976                                            
         ELSE                                                                    
            JS = 1                                                               
            FS = FS/0.0024                                                       
         ENDIF                                                                   
         FAC000 = (1. - FS) * FAC00(LAY)                                         
         FAC010 = (1. - FS) * FAC10(LAY)                                         
         FAC100 = FS * FAC00(LAY)                                                
         FAC110 = FS * FAC10(LAY)                                                
         FAC001 = (1. - FS) * FAC01(LAY)                                         
         FAC011 = (1. - FS) * FAC11(LAY)                                         
         FAC101 = FS * FAC01(LAY)                                                
         FAC111 = FS * FAC11(LAY)                                                
         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(4) + JS                        
         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(4) + JS                       
!!DIR$ VECTOR                                                                     
         DO 3000 IG = 1, NG4                                                     
            TAUG(NGS3+IG,LAY) = SPECCOMB *              &                        
                (FAC000 * ABSB4(IND0,IG) +               &                        
                 FAC100 * ABSB4(IND0+1,IG) +             &                        
                 FAC010 * ABSB4(IND0+6,IG) +             &                        
                 FAC110 * ABSB4(IND0+7,IG) +             &                        
                 FAC001 * ABSB4(IND1,IG) +               &                        
                 FAC101 * ABSB4(IND1+1,IG) +             &                        
                 FAC011 * ABSB4(IND1+6,IG) +             &                        
                 FAC111 * ABSB4(IND1+7,IG))                                       
            PFRAC(NGS3+IG,LAY) = FRACREFBC4(IG,JS) + FS * &
                 (FRACREFBC4(IG,JS+1) - FRACREFBC4(IG,JS))                           
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 
      END SUBROUTINE TAUGB4
                                                                                 
!----------------------------------------------------------------------------   
      SUBROUTINE TAUGB5(kts,ktep1,COLH2O,COLCO2,COLO3,FAC00,FAC01,FAC10,    &
                        FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX,        &
                        PFRAC,TAUG,LAYTROP                                  )
!----------------------------------------------------------------------------   
                                                                                 
!     BAND 5:  700-820 cm-1 (low - H2O,CO2; high - O3,CO2)                       
                                                                                 
      INTEGER, PARAMETER :: NGS4=52                                      
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )                      ::  LAYTROP

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( MAXXSEC,kts:ktep1 ),                 &
            INTENT(IN   )        ::                     WX

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLH2O, &
                                                    COLCO2, &
                                                     COLO3, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
      STRRAT1 = 90.4894                                                          
      STRRAT2 = 0.900502                                                         
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure),                
!     temperature, and appropriate species.  Below LAYTROP, the water            
!     vapor self-continuum is interpolated (in temperature) separately.          
!!DIR$ NOVECTOR                                                                   
      DO 2500 LAY = 1, LAYTROP                                                   
         SPECCOMB = COLH2O(LAY) + STRRAT1*COLCO2(LAY)                            
         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
         SPECMULT = 8.*(SPECPARM)                                                
         JS = 1 + INT(SPECMULT)                                                  
         FS = AMOD(SPECMULT,1.0)                                                 
         FAC000 = (1. - FS) * FAC00(LAY)                                         
         FAC010 = (1. - FS) * FAC10(LAY)                                         
         FAC100 = FS * FAC00(LAY)                                                
         FAC110 = FS * FAC10(LAY)                                                
         FAC001 = (1. - FS) * FAC01(LAY)                                         
         FAC011 = (1. - FS) * FAC11(LAY)                                         
         FAC101 = FS * FAC01(LAY)                                                
         FAC111 = FS * FAC11(LAY)                                                
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(5) + JS                         
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(5) + JS                            
         INDS = INDSELF(LAY)                                                     
!!DIR$ VECTOR                                                                     
         DO 2000 IG = 1, NG5                                                     
            TAUG(NGS4+IG,LAY) = SPECCOMB *                    &
                (FAC000 * ABSA5(IND0,IG) +                     &                  
                 FAC100 * ABSA5(IND0+1,IG) +                   &                  
                 FAC010 * ABSA5(IND0+9,IG) +                   &                  
                 FAC110 * ABSA5(IND0+10,IG) +                  &                  
                 FAC001 * ABSA5(IND1,IG) +                     &                  
                 FAC101 * ABSA5(IND1+1,IG) +                   &                  
                 FAC011 * ABSA5(IND1+9,IG) +                   &                  
                 FAC111 * ABSA5(IND1+10,IG)) +                 &                  
                 COLH2O(LAY) *                                &                  
                 SELFFAC(LAY) * (SELFREFC5(INDS,IG) +           &                  
                 SELFFRAC(LAY) *                              &                  
                 (SELFREFC5(INDS+1,IG) - SELFREFC5(INDS,IG)))     &                  
                 + WX(1,LAY) * CCL4C5(IG)                                          
            PFRAC(NGS4+IG,LAY) = FRACREFAC5(IG,JS) + FS *       &                  
                 (FRACREFAC5(IG,JS+1) - FRACREFAC5(IG,JS))                           
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
!!DIR$ NOVECTOR                                                                   
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         SPECCOMB = COLO3(LAY) + STRRAT2*COLCO2(LAY)                             
         SPECPARM = COLO3(LAY)/SPECCOMB                                          
         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
         SPECMULT = 4.*(SPECPARM)                                                
         JS = 1 + INT(SPECMULT)                                                  
         FS = AMOD(SPECMULT,1.0)                                                 
         FAC000 = (1. - FS) * FAC00(LAY)                                         
         FAC010 = (1. - FS) * FAC10(LAY)                                         
         FAC100 = FS * FAC00(LAY)                                                
         FAC110 = FS * FAC10(LAY)                                                
         FAC001 = (1. - FS) * FAC01(LAY)                                         
         FAC011 = (1. - FS) * FAC11(LAY)                                         
         FAC101 = FS * FAC01(LAY)                                                
         FAC111 = FS * FAC11(LAY)                                                
         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(5) + JS                        
         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(5) + JS                       
!!DIR$ VECTOR                                                                     
         DO 3000 IG = 1, NG5                                                     
            TAUG(NGS4+IG,LAY) = SPECCOMB *          &
                (FAC000 * ABSB5(IND0,IG) +           &                            
                 FAC100 * ABSB5(IND0+1,IG) +         &                            
                 FAC010 * ABSB5(IND0+5,IG) +         &                            
                 FAC110 * ABSB5(IND0+6,IG) +         &                            
                 FAC001 * ABSB5(IND1,IG) +           &                            
                 FAC101 * ABSB5(IND1+1,IG) +         &                            
                 FAC011 * ABSB5(IND1+5,IG) +         &                            
                 FAC111 * ABSB5(IND1+6,IG))          &                            
                 + WX(1,LAY) * CCL4C5(IG)                                          
            PFRAC(NGS4+IG,LAY) = FRACREFBC5(IG,JS) + FS *  &                       
                 (FRACREFBC5(IG,JS+1) - FRACREFBC5(IG,JS))                           
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 
      END SUBROUTINE TAUGB5
                                                                                 
!-----------------------------------------------------------------------------    
      SUBROUTINE TAUGB6(kts,ktep1,COLH2O,CO2MULT,FAC00,FAC01,FAC10,FAC11,    &
                        SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX,PFRAC,TAUG,    &
                        LAYTROP                                              )
!-----------------------------------------------------------------------------    
                                                                                 
!     BAND 6:  820-980 cm-1 (low - H2O; high - nothing)                          
                                                                                 
      INTEGER, PARAMETER :: NGS5=68                                       
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )                      ::  LAYTROP

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( MAXXSEC,kts:ktep1 ),                 &
            INTENT(IN   )        ::                     WX

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLH2O, &
                                                   CO2MULT, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure) and             
!     temperature. The water vapor self-continuum is interpolated                
!     (in temperature) separately.                                               
      DO 2500 LAY = 1, LAYTROP                                                   
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(6) + 1                          
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(6) + 1                             
         INDS = INDSELF(LAY)                                                     
         DO 2000 IG = 1, NG6                                                     
            TAUG(NGS5+IG,LAY) = COLH2O(LAY) *              & 
                (FAC00(LAY) * ABSA6(IND0,IG) +              &                     
                 FAC10(LAY) * ABSA6(IND0+1,IG) +            &                     
                 FAC01(LAY) * ABSA6(IND1,IG) +              &                     
                 FAC11(LAY) * ABSA6(IND1+1,IG) +            &                     
                 SELFFAC(LAY) * (SELFREFC6(INDS,IG) +        &                     
                 SELFFRAC(LAY)*                            &                     
                 (SELFREFC6(INDS+1,IG)-SELFREFC6(INDS,IG))))   &                     
                 + WX(2,LAY) * CFC11ADJC6(IG)                &                     
                 + WX(3,LAY) * CFC12C6(IG)                   &                     
                 + CO2MULT(LAY) * ABSCO2C6(IG)                                     
            PFRAC(NGS5+IG,LAY) = FRACREFAC6(IG)                                    
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
!     Nothing important goes on above LAYTROP in this band.                      
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         DO 3000 IG = 1, NG6                                                     
            TAUG(NGS5+IG,LAY) = 0.0                        & 
                 + WX(2,LAY) * CFC11ADJC6(IG)                &                     
                 + WX(3,LAY) * CFC12C6(IG)                                         
            PFRAC(NGS5+IG,LAY) = FRACREFAC6(IG)                                    
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 
      END SUBROUTINE TAUGB6
                                                                                 
!-----------------------------------------------------------------------------    
      SUBROUTINE TAUGB7(kts,ktep1,COLH2O,COLO3,CO2MULT,FAC00,FAC01,FAC10,    &   
                        FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,            &
                        PFRAC,TAUG,LAYTROP                                   )
!-----------------------------------------------------------------------------    
                                                                                 
!     BAND 7:  980-1080 cm-1 (low - H2O,O3; high - O3)                           
                                                                                 
      INTEGER, PARAMETER :: NGS6=76                                      
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )                      ::  LAYTROP

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLH2O, &
                                                     COLO3, &
                                                   CO2MULT, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
      STRRAT1 = 8.21104E4                                                        
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure),                
!     temperature, and appropriate species.  Below LAYTROP, the water            
!     vapor self-continuum is interpolated (in temperature) separately.          
!!DIR$ NOVECTOR                                                                   
      DO 2500 LAY = 1, LAYTROP                                                   
         SPECCOMB = COLH2O(LAY) + STRRAT1*COLO3(LAY)                             
         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
         SPECMULT = 8.*SPECPARM                                                  
         JS = 1 + INT(SPECMULT)                                                  
         FS = AMOD(SPECMULT,1.0)                                                 
         FAC000 = (1. - FS) * FAC00(LAY)                                         
         FAC010 = (1. - FS) * FAC10(LAY)                                         
         FAC100 = FS * FAC00(LAY)                                                
         FAC110 = FS * FAC10(LAY)                                                
         FAC001 = (1. - FS) * FAC01(LAY)                                         
         FAC011 = (1. - FS) * FAC11(LAY)                                         
         FAC101 = FS * FAC01(LAY)                                                
         FAC111 = FS * FAC11(LAY)                                                
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(7) + JS                         
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(7) + JS                            
         INDS = INDSELF(LAY)                                                     
!!DIR$ VECTOR                                                                     
         DO 2000 IG = 1, NG7                                                     
            TAUG(NGS6+IG,LAY) = SPECCOMB *                   & 
                (FAC000 * ABSA7(IND0,IG) +                   &                    
                 FAC100 * ABSA7(IND0+1,IG) +                 &                    
                 FAC010 * ABSA7(IND0+9,IG) +                 &                    
                 FAC110 * ABSA7(IND0+10,IG) +                &                    
                 FAC001 * ABSA7(IND1,IG) +                   &                    
                 FAC101 * ABSA7(IND1+1,IG) +                 &                    
                 FAC011 * ABSA7(IND1+9,IG) +                 &                    
                 FAC111 * ABSA7(IND1+10,IG)) +               &                    
                 COLH2O(LAY) *                               &                    
                 SELFFAC(LAY) * (SELFREFC7(INDS,IG) +        &                    
                 SELFFRAC(LAY) *                             &                    
                 (SELFREFC7(INDS+1,IG) - SELFREFC7(INDS,IG)))&
                 + CO2MULT(LAY) * ABSCO2C7(IG)                                     
         PFRAC(NGS6+IG,LAY) = FRACREFAC7(IG,JS) + FS *        &                    
                 (FRACREFAC7(IG,JS+1) - FRACREFAC7(IG,JS))                           
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(7) + 1                         
         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(7) + 1                        
         DO 3000 IG = 1, NG7                                                     
            TAUG(NGS6+IG,LAY) = COLO3(LAY) *                & 
                (FAC00(LAY) * ABSB7(IND0,IG) +               &                    
                 FAC10(LAY) * ABSB7(IND0+1,IG) +             &                    
                 FAC01(LAY) * ABSB7(IND1,IG) +               &                    
                 FAC11(LAY) * ABSB7(IND1+1,IG))              &                    
                 + CO2MULT(LAY) * ABSCO2C7(IG)                                     
            PFRAC(NGS6+IG,LAY) = FRACREFBC7(IG)                                    
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 
      END SUBROUTINE TAUGB7
                                                                                 
!----------------------------------------------------------------------------    
      SUBROUTINE TAUGB8(kts,ktep1,COLH2O,COLO3,COLN2O,CO2MULT,              &
                        FAC00,FAC01,FAC10,FAC11,SELFFAC,SELFFRAC,           &
                        JP,JT,JT1,INDSELF,WX,PFRAC,TAUG,LAYSWTCH            )
!----------------------------------------------------------------------------    
                                                                                 
!     BAND 8:  1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)               
                                                                                 
      INTEGER, PARAMETER :: NGS7=88                                       
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )                      :: LAYSWTCH

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( MAXXSEC,kts:ktep1 ),                 &
            INTENT(IN   )        ::                     WX

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLH2O, &
                                                     COLO3, &
                                                    COLN2O, &
                                                   CO2MULT, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
      DIMENSION H2OREF(59),O3REF(59)                                             
      REAL N2OMULT,N2OREF(59)                                              
                                                                                 
      DATA H2OREF/ &                                                             
           1.87599E-02,1.22233E-02,5.89086E-03,2.76753E-03,1.40651E-03, &        
           7.59698E-04,3.88758E-04,1.65422E-04,3.71895E-05,7.47648E-06, &        
           4.30818E-06,3.33194E-06,3.20393E-06,3.16186E-06,3.25235E-06, &        
           3.42258E-06,3.62884E-06,3.91482E-06,4.14875E-06,4.30810E-06, &        
           4.44204E-06,4.57783E-06,4.70865E-06,4.79432E-06,4.86971E-06, &        
           4.92603E-06,4.96688E-06,4.99628E-06,5.05266E-06,5.12658E-06, &        
           5.25028E-06,5.35708E-06,5.45085E-06,5.48304E-06,5.50000E-06, &        
           5.50000E-06,5.45359E-06,5.40468E-06,5.35576E-06,5.25327E-06, &        
           5.14362E-06,5.03396E-06,4.87662E-06,4.69787E-06,4.51911E-06, &        
           4.33600E-06,4.14416E-06,3.95232E-06,3.76048E-06,3.57217E-06, &        
           3.38549E-06,3.19881E-06,3.01212E-06,2.82621E-06,2.64068E-06, &        
           2.45515E-06,2.26962E-06,2.08659E-06,1.93029E-06/                      
      DATA N2OREF/ &                                                             
           3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07, &        
           3.19652E-07,3.15324E-07,3.03830E-07,2.94221E-07,2.84953E-07, &        
           2.76714E-07,2.64709E-07,2.42847E-07,2.09547E-07,1.71945E-07, &        
           1.37491E-07,1.13319E-07,1.00354E-07,9.12812E-08,8.54633E-08, &        
           8.03631E-08,7.33718E-08,6.59754E-08,5.60386E-08,4.70901E-08, &        
           3.99774E-08,3.29786E-08,2.60642E-08,2.10663E-08,1.65918E-08, &        
           1.30167E-08,1.00900E-08,7.62490E-09,6.11592E-09,4.66725E-09, &        
           3.28574E-09,2.84838E-09,2.46198E-09,2.07557E-09,1.85507E-09, &        
           1.65675E-09,1.45843E-09,1.31948E-09,1.20716E-09,1.09485E-09, &        
           9.97803E-10,9.31260E-10,8.64721E-10,7.98181E-10,7.51380E-10, &        
           7.13670E-10,6.75960E-10,6.38250E-10,6.09811E-10,5.85998E-10, &        
           5.62185E-10,5.38371E-10,5.15183E-10,4.98660E-10/                      
      DATA O3REF/  &                                                             
           3.01700E-08,3.47254E-08,4.24769E-08,5.27592E-08,6.69439E-08, &        
           8.71295E-08,1.13911E-07,1.56771E-07,2.17878E-07,3.24430E-07, &        
           4.65942E-07,5.68057E-07,6.96065E-07,1.11863E-06,1.76175E-06, &        
           2.32689E-06,2.95769E-06,3.65930E-06,4.59503E-06,5.31891E-06, &        
           5.96179E-06,6.51133E-06,7.06350E-06,7.69169E-06,8.25771E-06, &        
           8.70824E-06,8.83245E-06,8.71486E-06,8.09434E-06,7.33071E-06, &        
           6.31014E-06,5.36717E-06,4.48289E-06,3.83913E-06,3.28270E-06, &        
           2.82351E-06,2.49061E-06,2.16453E-06,1.83845E-06,1.66182E-06, &        
           1.50517E-06,1.34852E-06,1.19718E-06,1.04822E-06,8.99264E-07, &        
           7.63432E-07,6.53806E-07,5.44186E-07,4.34564E-07,3.64210E-07, &        
           3.11938E-07,2.59667E-07,2.07395E-07,1.91456E-07,1.93639E-07, &        
           1.95821E-07,1.98004E-07,2.06442E-07,2.81546E-07/                      
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure) and             
!     temperature.                                                               
      DO 2500 LAY = 1, LAYSWTCH                                                  
         FP = FAC01(LAY) + FAC11(LAY)                                            
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(8) + 1                          
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(8) + 1                             
         INDS = INDSELF(LAY)                                                     
         COLREF1 = N2OREF(JP(LAY))                                               
         COLREF2 = N2OREF(JP(LAY)+1)                                             
         WCOMB1 = H2OREF(JP(LAY))                                                
         WCOMB2 = H2OREF(JP(LAY)+1)                                              
         RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))         
         CURRN2O = COLH2O(LAY) * RATIO                                           
         N2OMULT = COLN2O(LAY) - CURRN2O                                         
         DO 2000 IG = 1, NG8                                                     
            TAUG(NGS7+IG,LAY) = COLH2O(LAY) *                 &
                (FAC00(LAY) * ABSA8(IND0,IG) +                &                   
                 FAC10(LAY) * ABSA8(IND0+1,IG) +              &                   
                 FAC01(LAY) * ABSA8(IND1,IG) +                &                   
                 FAC11(LAY) * ABSA8(IND1+1,IG) +              &                   
                 SELFFAC(LAY) * (SELFREFC8(INDS,IG) +         &                   
                 SELFFRAC(LAY) *                              &                   
                 (SELFREFC8(INDS+1,IG) - SELFREFC8(INDS,IG))))&                   
                 + WX(3,LAY) * CFC12C8(IG)                    &                   
                 + WX(4,LAY) * CFC22ADJC8(IG)                 &                   
                 + CO2MULT(LAY) * ABSCO2AC8(IG)               &                   
                 + N2OMULT * ABSN2OAC8(IG)        
            PFRAC(NGS7+IG,LAY) = FRACREFAC8(IG)                                    
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
      DO 3500 LAY = LAYSWTCH+1, NLAYERS                                          
         FP = FAC01(LAY) + FAC11(LAY)                                            
         IND0 = ((JP(LAY)-7)*5+(JT(LAY)-1))*NSPB(8) + 1                          
         IND1 = ((JP(LAY)-6)*5+(JT1(LAY)-1))*NSPB(8) + 1                         
         COLREF1 = N2OREF(JP(LAY))                                               
         COLREF2 = N2OREF(JP(LAY)+1)                                             
         WCOMB1 = O3REF(JP(LAY))                                                 
         WCOMB2 = O3REF(JP(LAY)+1)                                               
         RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))         
         CURRN2O = COLO3(LAY) * RATIO                                            
         N2OMULT = COLN2O(LAY) - CURRN2O                                         
         DO 3000 IG = 1, NG8                                                     
            TAUG(NGS7+IG,LAY) = COLO3(LAY) *        &
                (FAC00(LAY) * ABSB8(IND0,IG) +       &                            
                 FAC10(LAY) * ABSB8(IND0+1,IG) +     &                            
                 FAC01(LAY) * ABSB8(IND1,IG) +       &                            
                 FAC11(LAY) * ABSB8(IND1+1,IG))      &                            
                 + WX(3,LAY) * CFC12C8(IG)            &                            
                 + WX(4,LAY) * CFC22ADJC8(IG)         &                            
                 + CO2MULT(LAY) * ABSCO2BC8(IG)       &                            
                 + N2OMULT * ABSN2OBC8(IG)                                         
            PFRAC(NGS7+IG,LAY) = FRACREFBC8(IG)                                    
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 
      END SUBROUTINE TAUGB8
                                                                                 
!-----------------------------------------------------------------------------    
      SUBROUTINE TAUGB9(kts,ktep1,COLH2O,COLN2O,COLCH4,FAC00,FAC01,FAC10,    &
                        FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,            &
                        PFRAC,TAUG,LAYTROP,LAYSWTCH,LAYLOW                   )
!-----------------------------------------------------------------------------    
                                                                                 
!     BAND 9:  1180-1390 cm-1 (low - H2O,CH4; high - CH4)                        
                                                                                 
      INTEGER, PARAMETER :: NGS8=96                                      
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )   ::  LAYTROP,LAYSWTCH,LAYLOW

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLH2O, &
                                                    COLN2O, &
                                                    COLCH4, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
      DIMENSION H2OREF(13),CH4REF(13),ETAREF(11)                                 
      REAL N2OMULT,N2OREF(13)                                              
                                                                                 
      DATA N2OREF/  &                                                            
           3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07,  &
           3.19652E-07,3.15324E-07,3.03830E-07,2.94221E-07,2.84953E-07,  &       
           2.76714E-07,2.64709E-07,2.42847E-07/                                  
      DATA H2OREF/  &                                                            
           1.8759999E-02, 1.2223309E-02, 5.8908667E-03, 2.7675382E-03,   &       
           1.4065107E-03, 7.5969833E-04, 3.8875898E-04, 1.6542293E-04,   &       
           3.7189537E-05, 7.4764857E-06, 4.3081886E-06, 3.3319423E-06,   &       
           3.2039343E-06/                                                        
      DATA CH4REF/  &                                                            
           1.7000001E-06, 1.7000001E-06, 1.6998713E-06, 1.6904165E-06,   &       
           1.6671424E-06, 1.6350652E-06, 1.6097551E-06, 1.5590465E-06,   &       
           1.5119849E-06, 1.4741138E-06, 1.4384609E-06, 1.4002215E-06,   &       
           1.3573376E-06/                                                        
      DATA ETAREF/  &                                                            
           0.,0.125,0.25,0.375,0.5,0.625,0.75,0.875,0.96,0.99,1.0/               
                                                                                 
      STRRAT = 21.6282                                                           
      IOFF = 0                                                                   
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure),                
!     temperature, and appropriate species.  Below LAYTROP, the water            
!     vapor self-continuum is interpolated (in temperature) separately.          
      DO 2500 LAY = 1, LAYTROP                                                   
         SPECCOMB = COLH2O(LAY) + STRRAT*COLCH4(LAY)                             
         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
         SPECMULT = 8.*(SPECPARM)                                                
         JS = 1 + INT(SPECMULT)                                                  
         JFRAC = JS                                                              
         FS = AMOD(SPECMULT,1.0)                                                 
         FFRAC = FS                                                              
         IF (JS .EQ. 8) THEN                                                     
            IF (FS .LE. 0.68) THEN                                               
               FS = FS/0.68                                                      
            ELSEIF (FS .LE. 0.92) THEN                                           
               JS = JS + 1                                                       
               FS = (FS-0.68)/0.24                                               
            ELSE                                                                 
               JS = JS + 2                                                       
               FS = (FS-0.92)/0.08                                               
            ENDIF                                                                
         ELSEIF (JS .EQ.9) THEN                                                  
            JS = 10                                                              
            FS = 1.                                                              
            JFRAC = 8                                                            
            FFRAC = 1.                                                           
         ENDIF                                                                   
         FP = FAC01(LAY) + FAC11(LAY)                                            
         NS = JS + INT(FS + 0.5)                                                 
         FAC000 = (1. - FS) * FAC00(LAY)                                         
         FAC010 = (1. - FS) * FAC10(LAY)                                         
         FAC100 = FS * FAC00(LAY)                                                
         FAC110 = FS * FAC10(LAY)                                                
         FAC001 = (1. - FS) * FAC01(LAY)                                         
         FAC011 = (1. - FS) * FAC11(LAY)                                         
         FAC101 = FS * FAC01(LAY)                                                
         FAC111 = FS * FAC11(LAY)                                                
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(9) + JS                         
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(9) + JS                            
         INDS = INDSELF(LAY)                                                     
         IF (LAY .EQ. LAYLOW) IOFF = NG9                                         
         IF (LAY .EQ. LAYSWTCH) IOFF = 2*NG9                                     
         COLREF1 = N2OREF(JP(LAY))                                               
         COLREF2 = N2OREF(JP(LAY)+1)                                             
         IF (NS .EQ. 11) THEN                                                    
            WCOMB1 = H2OREF(JP(LAY))                                             
            WCOMB2 = H2OREF(JP(LAY)+1)                                           
         ELSE                                                                    
            WCOMB1 = STRRAT * CH4REF(JP(LAY))/(1.-ETAREF(NS))                    
            WCOMB2 = STRRAT * CH4REF(JP(LAY)+1)/(1.-ETAREF(NS))                  
         ENDIF                                                                   
         RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))         
         CURRN2O = SPECCOMB * RATIO                                              
         N2OMULT = COLN2O(LAY) - CURRN2O                                         
         DO 2000 IG = 1, NG9                                                     
            TAUG(NGS8+IG,LAY) = SPECCOMB *                      &
                (FAC000 * ABSA9(IND0,IG) +                      &                 
                 FAC100 * ABSA9(IND0+1,IG) +                    &                 
                 FAC010 * ABSA9(IND0+11,IG) +                   &                 
                 FAC110 * ABSA9(IND0+12,IG) +                   &                 
                 FAC001 * ABSA9(IND1,IG) +                      &                 
                 FAC101 * ABSA9(IND1+1,IG) +                    &                 
                 FAC011 * ABSA9(IND1+11,IG) +                   &                 
                 FAC111 * ABSA9(IND1+12,IG)) +                  &                 
                 COLH2O(LAY) *                                  &                 
                 SELFFAC(LAY) * (SELFREFC9(INDS,IG) +           &                 
                 SELFFRAC(LAY) *                                &                 
                 (SELFREFC9(INDS+1,IG) - SELFREFC9(INDS,IG)))   & 
                 + N2OMULT * ABSN2OC9(IG+IOFF)                                     
            PFRAC(NGS8+IG,LAY) = FRACREFAC9(IG,JFRAC) + FFRAC *  &                 
                 (FRACREFAC9(IG,JFRAC+1) - FRACREFAC9(IG,JFRAC))                     
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(9) + 1                         
         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(9) + 1                        
         DO 3000 IG = 1, NG9                                                     
            TAUG(NGS8+IG,LAY) = COLCH4(LAY) *                  &                 
                (FAC00(LAY) * ABSB9(IND0,IG) +                  &                 
                 FAC10(LAY) * ABSB9(IND0+1,IG) +                &                 
                 FAC01(LAY) * ABSB9(IND1,IG) +                  &                 
                 FAC11(LAY) * ABSB9(IND1+1,IG))                                   
            PFRAC(NGS8+IG,LAY) = FRACREFBC9(IG)                                    
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 
      END SUBROUTINE TAUGB9
                                                                                 
!--------------------------------------------------------------------------------    
      SUBROUTINE TAUGB10(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,    &
                         PFRAC,TAUG,LAYTROP                                     )
!--------------------------------------------------------------------------------    
                                                                                 
!     BAND 10:  1390-1480 cm-1 (low - H2O; high - H2O)                           
                                                                                 
      INTEGER, PARAMETER :: NGS9=108                                     
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )                      ::  LAYTROP

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLH2O, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure) and             
!     temperature.                                                               
      DO 2500 LAY = 1, LAYTROP                                                   
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(10) + 1                         
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(10) + 1                            
         DO 2000 IG = 1, NG10                                                    
            TAUG(NGS9+IG,LAY) = COLH2O(LAY) *          &
                (FAC00(LAY) * ABSA10(IND0,IG) +        &                           
                 FAC10(LAY) * ABSA10(IND0+1,IG) +      &                           
                 FAC01(LAY) * ABSA10(IND1,IG) +        &                           
                 FAC11(LAY) * ABSA10(IND1+1,IG))                                   
            PFRAC(NGS9+IG,LAY) = FRACREFAC10(IG)                                    
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(10) + 1                        
         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(10) + 1                       
         DO 3000 IG = 1, NG10                                                    
            TAUG(NGS9+IG,LAY) = COLH2O(LAY) *        &
                (FAC00(LAY) * ABSB10(IND0,IG) +        &                           
                 FAC10(LAY) * ABSB10(IND0+1,IG) +      &                           
                 FAC01(LAY) * ABSB10(IND1,IG) +        &                           
                 FAC11(LAY) * ABSB10(IND1+1,IG))                                   
            PFRAC(NGS9+IG,LAY) = FRACREFBC10(IG)                                    
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 
      END SUBROUTINE TAUGB10
                                                                                 
!--------------------------------------------------------------------------    
      SUBROUTINE TAUGB11(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11,        &
                         SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,   &
                         LAYTROP                                          )
!--------------------------------------------------------------------------    
                                                                                 
!     BAND 11:  1480-1800 cm-1 (low - H2O; high - H2O)                           
                                                                                 
      INTEGER, PARAMETER :: NGS10=114                                    
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )                      ::  LAYTROP

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLH2O, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 

!     Compute the optical depth by interpolating in ln(pressure) and             
!     temperature.  Below LAYTROP, the water vapor self-continuum                
!     is interpolated (in temperature) separately.                               
      DO 2500 LAY = 1, LAYTROP                                                   
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(11) + 1                         
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(11) + 1                            
         INDS = INDSELF(LAY)                                                     
         DO 2000 IG = 1, NG11                                                    
            TAUG(NGS10+IG,LAY) = COLH2O(LAY) *                 &                   
                (FAC00(LAY) * ABSA11(IND0,IG) +                &                   
                 FAC10(LAY) * ABSA11(IND0+1,IG) +              &                   
                 FAC01(LAY) * ABSA11(IND1,IG) +                &                   
                 FAC11(LAY) * ABSA11(IND1+1,IG) +              &                   
                 SELFFAC(LAY) * (SELFREFC11(INDS,IG) +         & 
                 SELFFRAC(LAY) *                               &                   
                 (SELFREFC11(INDS+1,IG) - SELFREFC11(INDS,IG))))                       
            PFRAC(NGS10+IG,LAY) = FRACREFAC11(IG)                                   
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(11) + 1                        
         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(11) + 1                       
         DO 3000 IG = 1, NG11                                                    
            TAUG(NGS10+IG,LAY) = COLH2O(LAY) *               &                   
                (FAC00(LAY) * ABSB11(IND0,IG) +                &                   
                 FAC10(LAY) * ABSB11(IND0+1,IG) +              &                   
                 FAC01(LAY) * ABSB11(IND1,IG) +                &                   
                 FAC11(LAY) * ABSB11(IND1+1,IG))                                   
            PFRAC(NGS10+IG,LAY) = FRACREFBC11(IG)                                   
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 
      END SUBROUTINE TAUGB11
                                                                                 
!-----------------------------------------------------------------------------    
      SUBROUTINE TAUGB12(kts,ktep1,COLH2O,COLCO2,FAC00,FAC01,FAC10,FAC11,    &
                         SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,      &
                         LAYTROP                                             )
!-----------------------------------------------------------------------------   
                                                                                 
!     BAND 12:  1800-2080 cm-1 (low - H2O,CO2; high - nothing)                   
                                                                                 
      INTEGER, PARAMETER :: NGS11=122                                    
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )                      ::  LAYTROP

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLH2O, &
                                                    COLCO2, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
      STRRAT1 = 0.009736757                                                      
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure),                
!     temperature, and appropriate species.  Below LAYTROP, the water            
!     vapor self-continuum is interpolated (in temperature) separately.          
!!DIR$ NOVECTOR                                                                   
      DO 2500 LAY = 1, LAYTROP                                                   
         SPECCOMB = COLH2O(LAY) + STRRAT1*COLCO2(LAY)                            
         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
         SPECMULT = 8.*(SPECPARM)                                                
         JS = 1 + INT(SPECMULT)                                                  
         FS = AMOD(SPECMULT,1.0)                                                 
         FAC000 = (1. - FS) * FAC00(LAY)                                         
         FAC010 = (1. - FS) * FAC10(LAY)                                         
         FAC100 = FS * FAC00(LAY)                                                
         FAC110 = FS * FAC10(LAY)                                                
         FAC001 = (1. - FS) * FAC01(LAY)                                         
         FAC011 = (1. - FS) * FAC11(LAY)                                         
         FAC101 = FS * FAC01(LAY)                                                
         FAC111 = FS * FAC11(LAY)                                                
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(12) + JS                        
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(12) + JS                           
         INDS = INDSELF(LAY)                                                     
!!DIR$ VECTOR                                                                     
         DO 2000 IG = 1, NG12                                                    
            TAUG(NGS11+IG,LAY) = SPECCOMB *             & 
                (FAC000 * ABSA12(IND0,IG) +             &                          
                 FAC100 * ABSA12(IND0+1,IG) +           &                          
                 FAC010 * ABSA12(IND0+9,IG) +           &                          
                 FAC110 * ABSA12(IND0+10,IG) +          &                          
                 FAC001 * ABSA12(IND1,IG) +             &                          
                 FAC101 * ABSA12(IND1+1,IG) +           &                          
                 FAC011 * ABSA12(IND1+9,IG) +           &                          
                 FAC111 * ABSA12(IND1+10,IG)) +         &                          
                 COLH2O(LAY) *                          &                          
                 SELFFAC(LAY) * (SELFREFC12(INDS,IG) +  &                          
                 SELFFRAC(LAY) *                        &                          
                 (SELFREFC12(INDS+1,IG) - SELFREFC12(INDS,IG)))                        
            PFRAC(NGS11+IG,LAY) = FRACREFAC12(IG,JS) + FS *  & 
                 (FRACREFAC12(IG,JS+1) - FRACREFAC12(IG,JS))                           
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         DO 3000 IG = 1, NG12                                                    
            TAUG(NGS11+IG,LAY) = 0.0                                             
            PFRAC(NGS11+IG,LAY) = 0.0                                            
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 
      END SUBROUTINE TAUGB12
                                                                                 
!-----------------------------------------------------------------------------    
      SUBROUTINE TAUGB13(kts,ktep1,COLH2O,COLN2O,FAC00,FAC01,FAC10,FAC11,    &
                         SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,      &
                         LAYTROP                                             )
!-----------------------------------------------------------------------------    
                                                                                 
!     BAND 13:  2080-2250 cm-1 (low - H2O,N2O; high - nothing)                   
                                                                                 
      INTEGER, PARAMETER :: NGS12=130                                    
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )                      ::  LAYTROP

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLH2O, &
                                                    COLN2O, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
      STRRAT1 = 16658.87                                                         
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure),                
!     temperature, and appropriate species.  Below LAYTROP, the water            
!     vapor self-continuum is interpolated (in temperature) separately.          
      DO 2500 LAY = 1, LAYTROP                                                   
         SPECCOMB = COLH2O(LAY) + STRRAT1*COLN2O(LAY)                            
         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
         SPECMULT = 8.*(SPECPARM)                                                
         JS = 1 + INT(SPECMULT)                                                  
         FS = AMOD(SPECMULT,1.0)                                                 
         FAC000 = (1. - FS) * FAC00(LAY)                                         
         FAC010 = (1. - FS) * FAC10(LAY)                                         
         FAC100 = FS * FAC00(LAY)                                                
         FAC110 = FS * FAC10(LAY)                                                
         FAC001 = (1. - FS) * FAC01(LAY)                                         
         FAC011 = (1. - FS) * FAC11(LAY)                                         
         FAC101 = FS * FAC01(LAY)                                                
         FAC111 = FS * FAC11(LAY)                                                
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(13) + JS                        
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(13) + JS                           
         INDS = INDSELF(LAY)                                                     
         DO 2000 IG = 1, NG13                                                    
            TAUG(NGS12+IG,LAY) = SPECCOMB *                &                       
                (FAC000 * ABSA13(IND0,IG) +                &                       
                 FAC100 * ABSA13(IND0+1,IG) +              &                       
                 FAC010 * ABSA13(IND0+9,IG) +              &                       
                 FAC110 * ABSA13(IND0+10,IG) +             &                       
                 FAC001 * ABSA13(IND1,IG) +                &                       
                 FAC101 * ABSA13(IND1+1,IG) +              &                       
                 FAC011 * ABSA13(IND1+9,IG) +              &                       
                 FAC111 * ABSA13(IND1+10,IG)) +            &                       
                 COLH2O(LAY) *                           &                       
                 SELFFAC(LAY) * (SELFREFC13(INDS,IG) +      &                       
                 SELFFRAC(LAY) *                         &                       
                 (SELFREFC13(INDS+1,IG) - SELFREFC13(INDS,IG)))                        
            PFRAC(NGS12+IG,LAY) = FRACREFAC13(IG,JS) + FS * &                       
                 (FRACREFAC13(IG,JS+1) - FRACREFAC13(IG,JS))                           
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         DO 3000 IG = 1, NG13                                                    
            TAUG(NGS12+IG,LAY) = 0.0                                             
            PFRAC(NGS12+IG,LAY) = 0.0                                            
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 

      END SUBROUTINE TAUGB13
                                                                                 
!----------------------------------------------------------------------------    
      SUBROUTINE TAUGB14(kts,ktep1,COLCO2,FAC00,FAC01,FAC10,FAC11,          &
                         SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,     &
                         LAYTROP                                            )
!----------------------------------------------------------------------------    
                                                                                 
!     BAND 14:  2250-2380 cm-1 (low - CO2; high - CO2)                           
                                                                                 
      INTEGER, PARAMETER :: NGS13=134                                    
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )                      ::  LAYTROP

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLCO2, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure) and             
!     temperature.  Below LAYTROP, the water vapor self-continuum                
!     is interpolated (in temperature) separately.                               
      DO 2500 LAY = 1, LAYTROP                                                   
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(14) + 1                         
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(14) + 1                            
         INDS = INDSELF(LAY)                                                     
         DO 2000 IG = 1, NG14                                                    
            TAUG(NGS13+IG,LAY) = COLCO2(LAY) *           &
                (FAC00(LAY) * ABSA14(IND0,IG) +          &                         
                 FAC10(LAY) * ABSA14(IND0+1,IG) +        &                         
                 FAC01(LAY) * ABSA14(IND1,IG) +          &                         
                 FAC11(LAY) * ABSA14(IND1+1,IG) +        &                         
                 SELFFAC(LAY) * (SELFREFC14(INDS,IG) +   &                         
                 SELFFRAC(LAY) *                         &                         
                 (SELFREFC14(INDS+1,IG) - SELFREFC14(INDS,IG))))                       
            PFRAC(NGS13+IG,LAY) = FRACREFAC14(IG)                                   
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(14) + 1                        
         IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(14) + 1                       
         DO 3000 IG = 1, NG14                                                    
            TAUG(NGS13+IG,LAY) = COLCO2(LAY) *       &                           
                (FAC00(LAY) * ABSB14(IND0,IG) +        &                           
                 FAC10(LAY) * ABSB14(IND0+1,IG) +      &                           
                 FAC01(LAY) * ABSB14(IND1,IG) +        &                           
                 FAC11(LAY) * ABSB14(IND1+1,IG))                                   
            PFRAC(NGS13+IG,LAY) = FRACREFBC14(IG)                                   
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 
      END SUBROUTINE TAUGB14
                                                                                 
!------------------------------------------------------------------------------    
      SUBROUTINE TAUGB15(kts,ktep1,COLH2O,COLCO2,COLN2O,FAC00,FAC01,FAC10,    &
                         FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,            &
                         PFRAC,TAUG,LAYTROP                                   )
!------------------------------------------------------------------------------    
                                                                                 
!     BAND 15:  2380-2600 cm-1 (low - N2O,CO2; high - nothing)                   
                                                                                 
      INTEGER, PARAMETER :: NGS14=136                                    
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )                      ::  LAYTROP

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLH2O, &
                                                    COLCO2, &
                                                    COLN2O, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
      STRRAT1 = 0.2883201                                                        
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure),                
!     temperature, and appropriate species.  Below LAYTROP, the water            
!     vapor self-continuum is interpolated (in temperature) separately.          
      DO 2500 LAY = 1, LAYTROP                                                   
         SPECCOMB = COLN2O(LAY) + STRRAT1*COLCO2(LAY)                            
         SPECPARM = COLN2O(LAY)/SPECCOMB                                         
         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
         SPECMULT = 8.*(SPECPARM)                                                
         JS = 1 + INT(SPECMULT)                                                  
         FS = AMOD(SPECMULT,1.0)                                                 
         FAC000 = (1. - FS) * FAC00(LAY)                                         
         FAC010 = (1. - FS) * FAC10(LAY)                                         
         FAC100 = FS * FAC00(LAY)                                                
         FAC110 = FS * FAC10(LAY)                                                
         FAC001 = (1. - FS) * FAC01(LAY)                                         
         FAC011 = (1. - FS) * FAC11(LAY)                                         
         FAC101 = FS * FAC01(LAY)                                                
         FAC111 = FS * FAC11(LAY)                                                
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(15) + JS                        
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(15) + JS                           
         INDS = INDSELF(LAY)                                                     
         DO 2000 IG = 1, NG15                                                    
            TAUG(NGS14+IG,LAY) = SPECCOMB *                     &                  
                (FAC000 * ABSA15(IND0,IG) +                     &                  
                 FAC100 * ABSA15(IND0+1,IG) +                   &                  
                 FAC010 * ABSA15(IND0+9,IG) +                   &                  
                 FAC110 * ABSA15(IND0+10,IG) +                  &                  
                 FAC001 * ABSA15(IND1,IG) +                     &                  
                 FAC101 * ABSA15(IND1+1,IG) +                   &                  
                 FAC011 * ABSA15(IND1+9,IG) +                   &                  
                 FAC111 * ABSA15(IND1+10,IG)) +                 &                  
                 COLH2O(LAY) *                                &                  
                 SELFFAC(LAY) * (SELFREFC15(INDS,IG) +           &                  
                 SELFFRAC(LAY) *                              &                  
                 (SELFREFC15(INDS+1,IG) - SELFREFC15(INDS,IG)))                        
            PFRAC(NGS14+IG,LAY) = FRACREFAC15(IG,JS) + FS *      &                  
                 (FRACREFAC15(IG,JS+1) - FRACREFAC15(IG,JS))                           
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         DO 3000 IG = 1, NG15                                                    
            TAUG(NGS14+IG,LAY) = 0.0                                             
            PFRAC(NGS14+IG,LAY) = 0.0                                            
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 
      END SUBROUTINE TAUGB15
                                                                                 
!-----------------------------------------------------------------------------    
      SUBROUTINE TAUGB16(kts,ktep1,COLH2O,COLCH4,FAC00,FAC01,FAC10,FAC11,    &
                         SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,      &
                         LAYTROP                                             )
!-----------------------------------------------------------------------------    
                                                                                 
!     BAND 16:  2600-3000 cm-1 (low - H2O,CH4; high - nothing)                   
                                                                                 
      INTEGER, PARAMETER :: NGS15=138                                    
                                                                                 
      INTEGER, INTENT(IN )                      :: kts,ktep1

      INTEGER, INTENT(IN )                      ::  LAYTROP

      REAL, DIMENSION( NGPT,kts:ktep1 ),                    &
            INTENT(INOUT)        ::                  PFRAC, &
                                                      TAUG

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::        &
                                                    COLH2O, &
                                                    COLCH4, &
                                                     FAC00, &
                                                     FAC01, &
                                                     FAC10, &
                                                     FAC11, &
                                                   SELFFAC, &
                                                  SELFFRAC 
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::     &
                                                        JP, &
                                                        JT, &
                                                       JT1, &
                                                   INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
      STRRAT1 = 830.411                                                          
                                                                                 
!     Compute the optical depth by interpolating in ln(pressure),                
!     temperature, and appropriate species.  Below LAYTROP, the water            
!     vapor self-continuum is interpolated (in temperature) separately.          
      DO 2500 LAY = 1, LAYTROP                                                   
         SPECCOMB = COLH2O(LAY) + STRRAT1*COLCH4(LAY)                            
         SPECPARM = COLH2O(LAY)/SPECCOMB                                         
         IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS                         
         SPECMULT = 8.*(SPECPARM)                                                
         JS = 1 + INT(SPECMULT)                                                  
         FS = AMOD(SPECMULT,1.0)                                                 
         FAC000 = (1. - FS) * FAC00(LAY)                                         
         FAC010 = (1. - FS) * FAC10(LAY)                                         
         FAC100 = FS * FAC00(LAY)                                                
         FAC110 = FS * FAC10(LAY)                                                
         FAC001 = (1. - FS) * FAC01(LAY)                                         
         FAC011 = (1. - FS) * FAC11(LAY)                                         
         FAC101 = FS * FAC01(LAY)                                                
         FAC111 = FS * FAC11(LAY)                                                
         IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(16) + JS                        
         IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(16) + JS                           
         INDS = INDSELF(LAY)                                                     
         DO 2000 IG = 1, NG16                                                    
            TAUG(NGS15+IG,LAY) = SPECCOMB *                 &
                (FAC000 * ABSA16(IND0,IG) +                 &                      
                 FAC100 * ABSA16(IND0+1,IG) +               &                      
                 FAC010 * ABSA16(IND0+9,IG) +               &                      
                 FAC110 * ABSA16(IND0+10,IG) +              &                      
                 FAC001 * ABSA16(IND1,IG) +                 &                      
                 FAC101 * ABSA16(IND1+1,IG) +               &                      
                 FAC011 * ABSA16(IND1+9,IG) +               &                      
                 FAC111 * ABSA16(IND1+10,IG)) +             &                      
                 COLH2O(LAY) *                            &                      
                 SELFFAC(LAY) * (SELFREFC16(INDS,IG) +       &                      
                 SELFFRAC(LAY) *                          &                      
                 (SELFREFC16(INDS+1,IG) - SELFREFC16(INDS,IG)))                        
            PFRAC(NGS15+IG,LAY) = FRACREFAC16(IG,JS) + FS *  &                      
                 (FRACREFAC16(IG,JS+1) - FRACREFAC16(IG,JS))                           
 2000    CONTINUE                                                                
 2500 CONTINUE                                                                   
                                                                                 
      DO 3500 LAY = LAYTROP+1, NLAYERS                                           
         DO 3000 IG = 1, NG16                                                    
            TAUG(NGS15+IG,LAY) = 0.0                                             
            PFRAC(NGS15+IG,LAY) = 0.0                                            
 3000    CONTINUE                                                                
 3500 CONTINUE                                                                   
                                                                                 
      END SUBROUTINE TAUGB16
                                                                                 

!-------------------------------------------------------------------------
      SUBROUTINE RTRN(kts,ktep1,                                         &
                      TAVEL, PZ, TZ, CLDFRAC, TAUCLOUD, TOTDFLUX,        &
                      HTR, ICLDLYR, ITR, PFRAC, TBOUND,SEMISS            )
!-------------------------------------------------------------------------
!  RRTM Longwave Radiative Transfer Model                                        
!  Atmospheric and Environmental Research, Inc., Cambridge, MA                   
!                                                                                
!  Original version:       E. J. Mlawer, et al.                                  
!  Revision for NCAR CCM:  Michael J. Iacono; September, 1998                    
!                                                                                
!  This program calculates the upward fluxes, downward fluxes, and               
!  heating rates for an arbitrary clear or cloudy atmosphere.  The input         
!  to this program is the atmospheric profile, all Planck function               
!  information, and the cloud fraction by layer.  The diffusivity angle          
!  (SECANG=1.66) is used for the angle integration for consistency with          
!  the NCAR CCM; the Gaussian weight appropriate to this angle (WTNUM=0.5)       
!  is applied here.  Note that use of the emissivity angle for the flux          
!  integration can cause errors of 1 to 4 W/m2 within cloudy layers.             
!-------------------------------------------------------------------------
                                                                                 
      INTEGER, INTENT(IN )    ::      kts,ktep1
 
      INTEGER, DIMENSION( NGPT,kts:ktep1 ),               &
               INTENT(IN   )  ::                     ITR

      REAL, DIMENSION( NGPT,kts:ktep1 ),                  &
            INTENT(IN   )     ::                   PFRAC

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::      &
                                                   TAVEL
      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::      &
                                                 CLDFRAC, &
                                                TAUCLOUD

      REAL, DIMENSION(   0:ktep1 ),INTENT(INOUT)::        &
                                                TOTDFLUX

      REAL, DIMENSION(   0:ktep1 ), INTENT(INOUT) ::        &
                                                     HTR  

      REAL, DIMENSION(   0:ktep1 ), INTENT(IN   ) ::      &
                                                      PZ, &
                                                      TZ
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::   &
                                                 ICLDLYR

      REAL, INTENT(IN   )        ::               TBOUND
      REAL, DIMENSION(NBANDS), INTENT(IN   ) ::   SEMISS

! LOCAL VAR

      REAL, DIMENSION(   0:ktep1 )              ::        &
                                                TOTUCLFL, &
                                                TOTDCLFL, &
                                                TOTUFLUX

      REAL, DIMENSION(   0:ktep1 )              ::        &
                                                    FNET, &
                                                   FNETC, &
                                                    HTRC

      INTEGER :: kk
     
      REAL    :: CLRNTTOA,CLRNTSRF 

! Parameters                                                                     

!     INTEGER, PARAMETER :: MXLAY=101                                                      
      REAL, PARAMETER :: SECANG=1.66                                                    
      REAL, PARAMETER :: WTNUM=0.5                                                      
                                                                                 
! RRTM Definitions                                                               
! Input                                                                          
!    MXLAY                        ! Maximum number of model layers               
!    NGPT                         ! Total number of g-point subintervals         
!    NBANDS                       ! Number of longwave spectral bands            
!    SECANG                       ! Diffusivity angle                            
!    WTNUM                        ! Weight for radiance to flux conversion       
!    NLAYERS                      ! Number of model layers (plev+1)              
!    PAVEL(MXLAY)                 ! Layer pressures (mb)                         
!    PZ(0:MXLAY)                  ! Level (interface) pressures (mb)             
!    TAVEL(MXLAY)                 ! Layer temperatures (K)                       
!    TZ(0:MXLAY)                  ! Level (interface) temperatures(mb)           
!    TBOUND                       ! Surface temperature (K)                      
!    CLDFRAC(MXLAY)               ! Layer cloud fraction                         
!    TAUCLOUD(MXLAY)              ! Layer cloud optical depth                    
!    ITR(NGPT,MXLAY)              ! Integer look-up table index                  
!    PFRAC(NGPT,MXLAY)               ! Planck fractions                             
!    ICLDLYR(MXLAY)               ! Flag for cloudy layers                       
!    ICLD                         ! Flag for cloudy in column                    
!    SEMISS(NBANDS)               ! Surface emissivities for each band           
!    BPADE                        ! Pade constant                                
!    TAU                          ! Clear sky optical depth look-up table        
!    TF                           ! Tau transition function look-up table        
!    TRANS                        ! Clear sky transmittance look-up table        
! Local                                                                          
!    ABSS(NGPT*MXLAY)             ! Gaseous absorptivity                         
!    ABSCLD(MXLAY)                ! Cloud absorptivity                           
!    ATOT(NGPT*MXLAY)             ! Combined gaseous and cloud absorptivity      
!    ODCLR(NGPT,MXLAY)            ! Clear sky (gaseous) optical depth            
!    ODCLD(MXLAY)                 ! Cloud optical depth                          
!    EFCLFRAC(MXLAY)              ! Effective cloud fraction                     
!    RADLU(NGPT)                  ! Upward radiance                              
!    URAD                         ! Spectrally summed upward radiance            
!    RADCLRU(NGPT)                ! Clear sky upward radiance                    
!    CLRURAD                      ! Spectrally summed clear sky upward radiance  
!    RADLD(NGPT)                  ! Downward radiance                            
!    DRAD                         ! Spectrally summed downward radiance          
!    RADCLRD(NGPT)                ! Clear sky downward radiance                  
!    CLRDRAD                      ! Spectrally summed clear sky downward radianc 
! Output                                                                         
!    TOTUFLUX(0:MXLAY)            ! Upward longwave flux (W/m2)                  
!    TOTDFLUX(0:MXLAY)            ! Downward longwave flux (W/m2)                
!    FNET(0:MXLAY)                ! Net longwave flux (W/m2)                     
!    HTR(0:MXLAY)                 ! Longwave heating rate (K/day)                
!    CLRNTTOA                     ! Clear sky TOA outgoing flux (W/m2)           
!    CLRNTSFC                     ! Clear sky net surface flux (W/m2)            
!    TOTUCLFL(0:MXLAY)            ! Clear sky upward longwave flux (W/m2)        
!    TOTDCLFL(0:MXLAY)            ! Clear sky downward longwave flux (W/m2)      
!    FNETC(0:MXLAY)               ! Clear sky net longwave flux (W/m2)           
!    HTRC(0:MXLAY)                ! Clear sky longwave heating rate (K/day)      
!                                                                                
                                                                                 
! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               

      DIMENSION BBU(NGPT*(ktep1-kts+1)),BBUTOT(NGPT*(ktep1-kts)),BGLEV(NGPT)                   
      DIMENSION PLANKBND(NBANDS),PLNKEMIT(NBANDS)                                
      DIMENSION PLVL(NBANDS,0:ktep1),PLAY(NBANDS,kts:ktep1)                          
      DIMENSION INDLAY(kts:ktep1),INDLEV(0:ktep1)                                    
      DIMENSION TLAYFRAC(kts:ktep1),TLEVFRAC(0:ktep1)                                
      DIMENSION ABSS(NGPT*(ktep1-kts+1)),ABSCLD(kts:ktep1-1),ATOT(NGPT*(ktep1-kts)) 
      DIMENSION ODCLR(NGPT,kts:ktep1-1),ODCLD(kts:ktep1-1),EFCLFRAC(kts:ktep1-1)
      DIMENSION RADLU(NGPT),RADLD(NGPT)                                          
      DIMENSION RADCLRU(NGPT),RADCLRD(NGPT)                                      
      DIMENSION SEMIS(NGPT),RADUEMIT(NGPT)                                       
                                                                                 
      INDBOUND = TBOUND - 159.                                                   
      TBNDFRAC = TBOUND - INT(TBOUND)                                            
                                                                                 
      DO 200 LAY = 0, NLAYERS                                                    
         TOTUFLUX(LAY) = 0.0                                                     
         TOTDFLUX(LAY) = 0.0                                                     
         TOTUCLFL(LAY) = 0.0                                                     
         TOTDCLFL(LAY) = 0.0                                                     
         INDLEV(LAY) = TZ(LAY) - 159.                                            
         TLEVFRAC(LAY) = TZ(LAY) - INT(TZ(LAY))                                  
 200  CONTINUE                                                                   
                                                                                 
      DO 220 LEV = 1, NLAYERS                                                    
                                                                                 
         IF (ICLDLYR(LEV).EQ.1) THEN                                             
            INDLAY(LEV) = TAVEL(LEV) - 159.                                      
            TLAYFRAC(LEV) = TAVEL(LEV) - INT(TAVEL(LEV))                         
!  Cloudy sky optical depth and absorptivity.                                    
            ODCLD(LEV) = SECANG * TAUCLOUD(LEV)                                  
            TRANSCLD = EXP(-ODCLD(LEV))                                          
            ABSCLD(LEV) = 1. - TRANSCLD                                          
            EFCLFRAC(LEV) = ABSCLD(LEV) * CLDFRAC(LEV)                           
!  Get clear sky optical depth from TAU lookup table                             
            DO 250 IPR = 1, NGPT                                                 
               IND = ITR(IPR,LEV)                                                
               ODCLR(IPR,LEV) = TAU(IND)                                         
 250        CONTINUE                                                             
         ELSE                                                                    
            INDLAY(LEV) = TAVEL(LEV) - 159.                                      
            TLAYFRAC(LEV) = TAVEL(LEV) - INT(TAVEL(LEV))                         
         ENDIF                                                                   
                                                                                 
 220  CONTINUE                                                                   
                                                                                 
!      SUMPL   = 0.0                                                             
!      SUMPLEM = 0.0                                                             
! *** Loop over frequency bands.                                                 
      DO 600 IBAND = 1, NBANDS                                                   
         DBDTLEV = TOTPLNK(INDBOUND+1,IBAND)-TOTPLNK(INDBOUND,IBAND)             
         PLANKBND(IBAND) = DELWAVE(IBAND) * (TOTPLNK(INDBOUND,IBAND) +  &
              TBNDFRAC * DBDTLEV)                                                
         DBDTLEV = TOTPLNK(INDLEV(0)+1,IBAND) -                         &        
              TOTPLNK(INDLEV(0),IBAND)                                           
         PLVL(IBAND,0) = DELWAVE(IBAND) * (TOTPLNK(INDLEV(0),IBAND) +   &        
              TLEVFRAC(0)*DBDTLEV)                                               
                                                                                 
         PLNKEMIT(IBAND) = SEMISS(IBAND) * PLANKBND(IBAND)                       
!         SUMPLEM  = SUMPLEM + PLNKEMIT(IBAND)                                   
!         SUMPL    = SUMPL   + PLANKBND(IBAND)                                   
                                                                                 
         DO 300 LEV = 1, NLAYERS                                                 
!     Calculate the integrated Planck functions at the level and                 
!     layer temperatures.                                                        
            DBDTLEV = TOTPLNK(INDLEV(LEV)+1,IBAND) -          &
                 TOTPLNK(INDLEV(LEV),IBAND)                                      
            DBDTLAY = TOTPLNK(INDLAY(LEV)+1,IBAND) -          &                  
                 TOTPLNK(INDLAY(LEV),IBAND)                                      
            PLAY(IBAND,LEV) = DELWAVE(IBAND) *                &                  
                 (TOTPLNK(INDLAY(LEV),IBAND) + TLAYFRAC(LEV) * DBDTLAY)          
            PLVL(IBAND,LEV) = DELWAVE(IBAND) *                &                  
                 (TOTPLNK(INDLEV(LEV),IBAND) + TLEVFRAC(LEV) * DBDTLEV)          
 300     CONTINUE                                                                
 600  CONTINUE                                                                   
                                                                                 
!      SEMISLW = SUMPLEM / SUMPL                                                 
                                                                                 
! *** Initialize for radiative transfer.                                         
      DO 500 IPR = 1, NGPT                                                       
         RADCLRD(IPR) = 0.                                                       
         RADLD(IPR) = 0.                                                         
         SEMIS(IPR) = SEMISS(NGB(IPR))                                           
         RADUEMIT(IPR) = PFRAC(IPR,1) * PLNKEMIT(NGB(IPR))                          
         BGLEV(IPR) = PFRAC(IPR,NLAYERS) * PLVL(NGB(IPR),NLAYERS)                   
 500  CONTINUE                                                                   
                                                                                 
                                                                                 
! *** DOWNWARD RADIATIVE TRANSFER                                                
! *** DRAD holds summed radiance for total sky stream                            
! *** CLRDRAD holds summed radiance for clear sky stream                         
                                                                                 
      ICLDDN = 0                                                                 
      DO 3000 LEV = NLAYERS, 1, -1                                               
         DRAD = 0.0                                                              
         CLRDRAD = 0.0                                                           
                                                                                 
         IF (ICLDLYR(LEV).EQ.1) THEN                                             
                                                                                 
! *** Cloudy layer                                                               
         ICLDDN = 1                                                              
         IENT = NGPT * (LEV-1)                                                   
         DO 2000 IPR = 1, NGPT                                                   
            INDEX = IENT + IPR                                                   
!     Get lookup table index                                                     
            IND = ITR(IPR,LEV)                                                   
!     Add clear sky and cloud optical depths                                     
            ODSM = ODCLR(IPR,LEV) + ODCLD(LEV)                                   
            FACTOT = ODSM / (BPADE + ODSM)                                       
            BGLAY = PFRAC(IPR,LEV) * PLAY(NGB(IPR),LEV)                             
            DELBGUP = BGLEV(IPR) - BGLAY                                         
!     Get TF from lookup table                                                   
            TAUF = TF(IND)                                                       
            BBU(INDEX) = BGLAY + TAUF * DELBGUP                                  
            BBUTOT(INDEX) = BGLAY + FACTOT * DELBGUP                             
            BGLEV(IPR) = PFRAC(IPR,LEV) * PLVL(NGB(IPR),LEV-1)                      
            DELBGDN = BGLEV(IPR) - BGLAY                                         
            BBD = BGLAY + TAUF * DELBGDN                                         
            BBDLEVD = BGLAY + FACTOT * DELBGDN                                   
!     Get clear sky transmittance from lookup table                              
            ABSS(INDEX) = 1. - TRANS(IND)                                        
            ATOT(INDEX) = ABSS(INDEX) + ABSCLD(LEV) -      &
                ABSS(INDEX) * ABSCLD(LEV)                                        
            GASSRC = BBD * ABSS(INDEX)                                           
!     Total sky radiance                                                         
            RADLD(IPR) = RADLD(IPR) - RADLD(IPR) * (ABSS(INDEX) +  &             
               EFCLFRAC(LEV) * (1.-ABSS(INDEX))) + GASSRC +        &             
               CLDFRAC(LEV) * (BBDLEVD * ATOT(INDEX) - GASSRC)                   
            DRAD = DRAD + RADLD(IPR)                                             
!     Clear sky radiance                                                         
            RADCLRD(IPR) = RADCLRD(IPR) + (BBD - RADCLRD(IPR))     & 
                         * ABSS(INDEX)                                           
            CLRDRAD = CLRDRAD + RADCLRD(IPR)                                     
 2000    CONTINUE                                                                
                                                                                 
         ELSE                                                                    
                                                                                 
! *** Clear layer                                                                
         IENT = NGPT * (LEV-1)                                                   
         DO 2100 IPR = 1, NGPT                                                   
            INDEX = IENT + IPR                                                   
            IND = ITR(IPR,LEV)                                                   
            BGLAY = PFRAC(IPR,LEV) * PLAY(NGB(IPR),LEV)                             
            DELBGUP = BGLEV(IPR) - BGLAY                                         
!     Get TF from lookup table                                                   
            TAUF = TF(IND)                                                       
            BBU(INDEX) = BGLAY + TAUF * DELBGUP                                  
            BGLEV(IPR) = PFRAC(IPR,LEV) * PLVL(NGB(IPR),LEV-1)                      
            DELBGDN = BGLEV(IPR) - BGLAY                                         
            BBD = BGLAY + TAUF * DELBGDN                                         
!     Get clear sky transmittance from lookup table                              
            ABSS(INDEX) = 1. - TRANS(IND)                                        
!     Total sky radiance                                                         
            RADLD(IPR) = RADLD(IPR) + (BBD - RADLD(IPR)) *     & 
                         ABSS(INDEX)                                             
            DRAD = DRAD + RADLD(IPR)                                             
 2100    CONTINUE                                                                
!     Set clear sky stream to total sky stream as long as layers                 
!     remain clear.  Streams diverge when a cloud is reached.                    
            IF (ICLDDN.EQ.1) THEN                                                
         DO 2200 IPR = 1, NGPT                                                   
               RADCLRD(IPR) = RADCLRD(IPR) + (BBD - RADCLRD(IPR)) *   & 
                              ABSS(INDEX)                                        
               CLRDRAD = CLRDRAD + RADCLRD(IPR)                                  
 2200    CONTINUE                                                                
            ELSE                                                                 
         DO 2300 IPR = 1, NGPT                                                   
               RADCLRD(IPR) = RADLD(IPR)                                         
               CLRDRAD = DRAD                                                    
 2300    CONTINUE                                                                
            ENDIF                                                                
                                                                                 
! 2100    CONTINUE                                                               
                                                                                 
         ENDIF                                                                   
                                                                                 
         TOTDFLUX(LEV-1) = DRAD * WTNUM                                          
         TOTDCLFL(LEV-1) = CLRDRAD * WTNUM                                       
                                                                                 
 3000 CONTINUE                                                                   
                                                                                 
                                                                                 
! SPECTRAL EMISSIVITY & REFLECTANCE                                              
! Include the contribution of spectrally varying longwave emissivity and         
! reflection from the surface to the upward radiative transfer.                  
! Note: Spectral and Lambertian reflection are identical for the one angle       
! flux integration used here.                                                    
                                                                                 
      URAD = 0.0                                                                 
      CLRURAD = 0.0                                                              
      DO 3500 IPR = 1, NGPT                                                      
!     Total sky radiance                                                         
         RADLU(IPR) = RADUEMIT(IPR) + (1. - SEMIS(IPR)) * RADLD(IPR)             
         URAD = URAD + RADLU(IPR)                                                
!     Clear sky radiance                                                         
         RADCLRU(IPR) = RADUEMIT(IPR) + (1. - SEMIS(IPR))  & 
                        * RADCLRD(IPR)                                           
         CLRURAD = CLRURAD + RADCLRU(IPR)                                        
 3500 CONTINUE                                                                   
      TOTUFLUX(0) = URAD * WTNUM                                                 
      TOTUCLFL(0) = CLRURAD * WTNUM                                              
                                                                                 
                                                                                 
! *** UPWARD RADIATIVE TRANSFER                                                  
! *** URAD holds the summed radiance for total sky stream                        
! *** CLRURAD holds the summed radiance for clear sky stream                     
                                                                                 
      DO 5000 LEV = 1, NLAYERS                                                   
         URAD = 0.0                                                              
         CLRURAD = 0.0                                                           
                                                                                 
! Check flag for cloud in current layer                                          
                                                                                 
         IF (ICLDLYR(LEV).EQ.1) THEN                                             
                                                                                 
! *** Cloudy layers                                                              
         IENT = NGPT * (LEV-1)                                                   
         DO 4000 IPR = 1, NGPT                                                   
            INDEX = IENT + IPR                                                   
            GASSRC = BBU(INDEX) * ABSS(INDEX)                                    
!     Total sky radiance                                                         
            RADLU(IPR) = RADLU(IPR) - RADLU(IPR) * (ABSS(INDEX) +    &           
               EFCLFRAC(LEV) * (1.-ABSS(INDEX))) + GASSRC +          &
               CLDFRAC(LEV) * (BBUTOT(INDEX) * ATOT(INDEX) - GASSRC)             
            URAD = URAD + RADLU(IPR)                                             
!     Clear sky radiance                                                         
            RADCLRU(IPR) = RADCLRU(IPR) + (BBU(INDEX) - RADCLRU(IPR)) * &        
                           ABSS(INDEX)                                           
            CLRURAD = CLRURAD + RADCLRU(IPR)                                     
 4000    CONTINUE                                                                
                                                                                 
         ELSE                                                                    
                                                                                 
! *** Clear layer                                                                
         IENT = NGPT * (LEV-1)                                                   
         DO 4100 IPR = 1, NGPT                                                   
            INDEX = IENT + IPR                                                   
!     Total sky radiance                                                         
            RADLU(IPR) = RADLU(IPR) + (BBU(INDEX)-RADLU(IPR)) *  & 
                         ABSS(INDEX)                                             
            URAD = URAD + RADLU(IPR)                                             
!     Clear sky radiance                                                         
!     Upward clear and total sky streams must remain separate because surface    
!     reflectance is different for each.                                         
            RADCLRU(IPR) = RADCLRU(IPR) + (BBU(INDEX) - RADCLRU(IPR))   &         
                           * ABSS(INDEX)                                         
            CLRURAD = CLRURAD + RADCLRU(IPR)                                     
 4100    CONTINUE                                                                
                                                                                 
         ENDIF                                                                   
                                                                                 
         TOTUFLUX(LEV) = URAD * WTNUM                                            
         TOTUCLFL(LEV) = CLRURAD * WTNUM                                         
                                                                                 
 5000 CONTINUE                                                                   
                                                                                 
                                                                                 
! *** Convert radiances to fluxes and heating rates for total sky.  Calculates   
!     clear sky surface and TOA values.  To compute clear sky profiles, uncommen 
!     relevant lines below.                                                      
      TOTUFLUX(0) = TOTUFLUX(0) * FLUXFAC                                        
      TOTDFLUX(0) = TOTDFLUX(0) * FLUXFAC                                        
      FNET(0) = TOTUFLUX(0) - TOTDFLUX(0)                                        
      TOTUCLFL(0) = TOTUCLFL(0) * FLUXFAC                                        
      TOTDCLFL(0) = TOTDCLFL(0) * FLUXFAC                                        
      FNETC(0) = TOTUCLFL(0) - TOTDCLFL(0)                                       
      CLRNTTOA = TOTUCLFL(NLAYERS)                                               
      CLRNTSRF = TOTUFLUX(0) - TOTDCLFL(0)                                       
                                                                                 
      DO 7000 LEV = 1, NLAYERS                                                   
         TOTUFLUX(LEV) = TOTUFLUX(LEV) * FLUXFAC                                 
         TOTDFLUX(LEV) = TOTDFLUX(LEV) * FLUXFAC                                 
         FNET(LEV) = TOTUFLUX(LEV) - TOTDFLUX(LEV)                               
         TOTUCLFL(LEV) = TOTUCLFL(LEV) * FLUXFAC                                 
         TOTDCLFL(LEV) = TOTDCLFL(LEV) * FLUXFAC                                 
         FNETC(LEV) = TOTUCLFL(LEV) - TOTDCLFL(LEV)                              
         L = LEV - 1                                                             
!     Calculate Heating Rates.                                                   
         HTR(L) = HEATFAC * (FNET(L) - FNET(LEV)) / (PZ(L) - PZ(LEV))            
         HTRC(L) = HEATFAC * (FNETC(L) - FNETC(LEV)) / (PZ(L) - PZ(LEV))         
 7000 CONTINUE                                                                   
      HTR(NLAYERS) = 0.0                                                         
      HTRC(NLAYERS) = 0.0                                                        
                                                                                 

      END  SUBROUTINE RTRN

!---------------------------------------------------------------------------
      SUBROUTINE GASABS(kts,ktep1,                                         &
                        COLDRY,COLH2O,COLCO2,COLO3,COLN2O,COLCH4,          &
                        COLO2,CO2MULT,                                     &
                        FAC00,FAC01,FAC10,FAC11,                           &
                        FORFAC,SELFFAC,SELFFRAC,                           &
                        JP,JT,JT1,INDSELF,ITR,WX,PFRAC,TAUG,               &
                        LAYTROP,LAYSWTCH,LAYLOW                            )
!---------------------------------------------------------------------------
!  RRTM Longwave Radiative Transfer Model                                        
!  Atmospheric and Environmental Research, Inc., Cambridge, MA                   
!                                                                                
!  Original version:       E. J. Mlawer, et al.                                  
!  Revision for NCAR CCM:  Michael J. Iacono; September, 1998                    
!                                                                                
!  This routine calculates the gaseous optical depths for all 16 longwave        
!  spectral bands.  The optical depths are used to define the Pade               
!  approximation to the function of tau transition from tranparancy to           
!  opacity.  This function, which varies from 0 to 1, is converted to an         
!  integer that will serve as an index for the lookup tables of tau              
!  transition function and transmittance used in the radiative transfer.         
!  These lookup tables are created on initialization in routine RRTMINIT.        
!---------------------------------------------------------------------------
!                                                                                
! Definitions                                                                    
!    NGPT                         ! Total number of g-point subintervals         
!    MXLAY                        ! Maximum number of model layers               
!    SECANG                       ! Diffusivity angle for flux computation       
!    TAU(NGPT,MXLAY)              ! Gaseous optical depths                       
!    NLAYERS                      ! Number of model layers used in RRTM          
!    PAVEL(MXLAY)                 ! Model layer pressures (mb)                   
!    PZ(0:MXLAY)                  ! Model level (interface) pressures (mb)       
!    TAVEL(MXLAY)                 ! Model layer temperatures (K)                 
!    TZ(0:MXLAY)                  ! Model level (interface) temperatures (K)     
!    TBOUND                       ! Surface temperature (K)                      
!    BPADE                        ! Pade approximation constant (=1./0.278)      
!    ITR(NGPT,MXLAY)              ! Integer lookup table index                   
!                                                                                
! Parameters                                                                     
      REAL, PARAMETER :: SECANG=1.66                                                    

      INTEGER, INTENT(IN )   ::  kts,ktep1
      INTEGER, INTENT(IN )   ::  LAYTROP,LAYSWTCH,LAYLOW

      REAL, DIMENSION( NGPT,kts:ktep1 ),                  &
            INTENT(INOUT)        ::                PFRAC

      REAL, DIMENSION( NGPT,kts:ktep1 ),                  &
            INTENT(INOUT)        ::                 TAUG

      REAL, DIMENSION( MAXXSEC,kts:ktep1 ),               &
            INTENT(IN   )        ::                   WX

      INTEGER, DIMENSION( NGPT,kts:ktep1 ),               &
               INTENT(INOUT)  ::                     ITR

      REAL, DIMENSION( kts:ktep1 ), INTENT(IN   ) ::      &
                                                  COLDRY, &  
                                                  COLH2O, &
                                                  COLCO2, &
                                                   COLO3, &
                                                  COLN2O, &
                                                  COLCH4, &
                                                   COLO2, &
                                                 CO2MULT, &
                                                   FAC00, &
                                                   FAC01, &
                                                   FAC10, &
                                                   FAC11, &
                                                  FORFAC, &
                                                 SELFFAC, &
                                                SELFFRAC
 
      INTEGER, DIMENSION( kts:ktep1 ), INTENT(INOUT) ::   &
                                                      JP, &
                                                      JT, &
                                                     JT1, &
                                                 INDSELF

! This compiler directive was added to insure private common block storage       
! in multi-tasked mode on a CRAY or SGI for all commons except those that        
! carry constants.                                                               
                                                                                 
! **************************************************************************     

!  Calculate optical depth for each band                                         
     
      CALL TAUGB1(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11,              &
                  FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,  &
                  LAYTROP)
      CALL TAUGB2(kts,ktep1,COLDRY,COLH2O,FAC00,FAC01,FAC10,FAC11,       &
                  FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,  &
                  LAYTROP)
      CALL TAUGB3(kts,ktep1,COLH2O,COLCO2,COLN2O,FAC00,FAC01,FAC10,FAC11,&
                  FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,  &
                  LAYTROP)
      CALL TAUGB4(kts,ktep1,COLH2O,COLCO2,COLO3,FAC00,FAC01,FAC10,FAC11, &
                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
                  LAYTROP)
      CALL TAUGB5(kts,ktep1,COLH2O,COLCO2,COLO3,FAC00,FAC01,FAC10,FAC11, &
                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX,PFRAC,TAUG,      &
                  LAYTROP)
      CALL TAUGB6(kts,ktep1,COLH2O,CO2MULT,FAC00,FAC01,FAC10,FAC11,      &
                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX,PFRAC,TAUG,      &
                  LAYTROP)
      CALL TAUGB7(kts,ktep1,COLH2O,COLO3,CO2MULT,FAC00,FAC01,FAC10,FAC11,&
                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
                  LAYTROP)
      CALL TAUGB8(kts,ktep1,COLH2O,COLO3,COLN2O,CO2MULT,FAC00,FAC01,FAC10,&
                  FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX,PFRAC,TAUG,&
                  LAYSWTCH)
      CALL TAUGB9(kts,ktep1,COLH2O,COLN2O,COLCH4,FAC00,FAC01,FAC10,FAC11,&
                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
                  LAYTROP,LAYSWTCH,LAYLOW)
      CALL TAUGB10(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
                  PFRAC,TAUG,LAYTROP)
      CALL TAUGB11(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11,             &
                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
                  LAYTROP)
      CALL TAUGB12(kts,ktep1,COLH2O,COLCO2,FAC00,FAC01,FAC10,FAC11,      &
                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
                  LAYTROP)
      CALL TAUGB13(kts,ktep1,COLH2O,COLN2O,FAC00,FAC01,FAC10,FAC11,      &
                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
                  LAYTROP)
      CALL TAUGB14(kts,ktep1,COLCO2,FAC00,FAC01,FAC10,FAC11,             &
                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
                  LAYTROP)
      CALL TAUGB15(kts,ktep1,COLH2O,COLCO2,COLN2O,FAC00,FAC01,FAC10,FAC11,&
                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
                  LAYTROP)
      CALL TAUGB16(kts,ktep1,COLH2O,COLCH4,FAC00,FAC01,FAC10,FAC11,      &
                  SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG,         &
                  LAYTROP)
                                                                                 
!  Compute the lookup table index from the Pade approximation of the             
!  tau transition function, which is derived from the optical depth.             
                                                                                 
      DO 6000 LAY = 1, NLAYERS                                                   
         DO 5000 IPR = 1, NGPT                                                   
            ODEPTH = SECANG * TAUG(IPR,LAY)                                       
            TFF = ODEPTH/(BPADE+ODEPTH)                                           
            IF (ODEPTH.LE.0.) TFF=0.                                              
            ITR(IPR,LAY) = INT(5.E3*TFF+0.5)
 5000    CONTINUE                                                                
 6000 CONTINUE                                                                   
      
   END SUBROUTINE GASABS

!====================================================================
   SUBROUTINE rrtminit(RTHRATEN,RTHRATENLW,CLDFRA,restart,          &
                       allowed_to_read ,                            &
                       ids, ide, jds, jde, kds, kde,                &
                       ims, ime, jms, jme, kms, kme,                &
                       its, ite, jts, jte, kts, kte                 )
!--------------------------------------------------------------------
   IMPLICIT NONE
!--------------------------------------------------------------------

   LOGICAL , INTENT(IN)           :: restart, allowed_to_read
   INTEGER , INTENT(IN)           :: ids, ide, jds, jde, kds, kde,  &
                                     ims, ime, jms, jme, kms, kme,  &
                                     its, ite, jts, jte, kts, kte

   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::        &
                                                          RTHRATEN, &
                                                        RTHRATENLW, &
                                                            CLDFRA
   REAL :: pi

   INTEGER :: i, j, k, itf, jtf, ktf

   jtf=min0(jte,jde-1)
   ktf=min0(kte,kde-1)
   itf=min0(ite,ide-1)

   IF(.not.restart)THEN
     DO j=jts,jtf
     DO k=kts,ktf
     DO i=its,itf
        RTHRATEN(i,k,j)=0.
        RTHRATENLW(i,k,j)=0.
        CLDFRA(i,k,j)=0.
     ENDDO
     ENDDO
     ENDDO
   ENDIF

   PI = 2.*ASIN(1.) 
   FLUXFAC  = PI   * 2.D4                     
   NLAYERS = kme

   IF ( allowed_to_read ) THEN
     CALL rrtm_lookuptable
   ENDIF

   END SUBROUTINE rrtminit


! **************************************************************************     
      SUBROUTINE rrtm_lookuptable
! **************************************************************************     

USE module_wrf_error
USE module_dm

!  RRTM Longwave Radiative Transfer Model                                        
!  Atmospheric and Environmental Research, Inc., Cambridge, MA                   
!                                                                                
!  Original version:       Michael J. Iacono; July, 1998                         
!  Revision for NCAR CCM:  Michael J. Iacono; September, 1998                    
!                                                                                
!  This subroutine performs calculations necessary for the initialization        
!  of the LW model, RRTM.  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-points to 140 for use in RRTM.           
! **************************************************************************     
                                                                                 
! Definitions                                                                    
!     Arrays for 5000-point look-up tables:                                      
!     TAU     Clear-sky optical depth (used in cloudy radiative transfer)        
!     TF      Tau transition function; i.e. the transition of the Planck         
!             function from that for the mean layer temperature to that for      
!             the layer boundary temperature as a function of optical depth.     
!             The "linear in tau" method is used to make the table.              
!     TRANS   Transmittance                                                      
!     BPADE   Inverse of the Pade approximation constant (= 1./0.278)            

! Local                                         
      LOGICAL                 :: opened
      LOGICAL , EXTERNAL      :: wrf_dm_on_monitor

      DIMENSION WTSM(MG)                       
      CHARACTER*80 errmess
      INTEGER rrtm_unit

      IF ( wrf_dm_on_monitor() ) THEN
        DO i = 10,99
          INQUIRE ( i , OPENED = opened )
          IF ( .NOT. opened ) THEN
            rrtm_unit = i
            GOTO 2010
          ENDIF
        ENDDO
        rrtm_unit = -1
 2010   CONTINUE
      ENDIF
      CALL wrf_dm_bcast_bytes ( rrtm_unit , IWORDSIZE )
      IF ( rrtm_unit < 0 ) THEN
        CALL wrf_error_fatal ( 'module_ra_rrtm: rrtm_lookuptable: Can not find unused fortran unit to read in lookup table.' )
      ENDIF

! start data 1

! **************************************************************************     
!  RRTM Longwave Radiative Transfer Model                                        
!  Atmospheric and Environmental Research, Inc., Cambridge, MA                   
!                                                                                
!  Original version:       E. J. Mlawer, et al.                                  
!  Revision for NCAR CCM:  Michael J. Iacono; September, 1998                    
!                                                                                
!  This routine contains 16 READ statements that include the                
!  absorption coefficients and other data for each of the 16 longwave            
!  spectral bands used in RRTM.  Here, the data are defined for 16               
!  g-points, or sub-intervals, per band.  These data are combined and            
!  weighted using a mapping procedure in routine RRTMINIT to reduce              
!  the total number of g-points from 256 to 140 for use in the CCM.              
! **************************************************************************     
        IF ( wrf_dm_on_monitor() ) THEN
          OPEN(rrtm_unit,FILE='RRTM_DATA',                  &
               FORM='UNFORMATTED',STATUS='OLD',ERR=9009)
        ENDIF
                                                                                 
!     The array abscoefL1 contains absorption coefs at the 16 chosen g-values   
!     for a range of pressure levels > ~100mb and temperatures.  The first       
!     index in the array, JT, which runs from 1 to 5, corresponds to     
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the corresponding TREF for this  pressure level,              
!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30,            
!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second              
!     index, JP, runs from 1 to 13 and refers to the corresponding               
!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).      
!     The third index, IG, goes from 1 to 16, and tells us which                 
!     g-interval the absorption coefficients are for.                            


                                                                                 
!     The array abscoefH1 contains absorption coefs at the 16 chosen g-values           
!     for a range of pressure levels < ~100mb and temperatures. The first        
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the reference temperature TREF for this pressure              
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
!     The second index, JP, runs from 13 to 59 and refers to the JPth            
!     reference pressure level (see taumol.f for the value of these              
!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
!     and tells us which g-interval the absorption coefficients are for.         

                                                                                 
!     The array SELFREF1 contains the coefficient of the water vapor              
!     self-continuum (including the energy term).  The first index               
!     refers to temperature in 7.2 degree increments.  For instance, &          
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
!     etc.  The second index runs over the g-channel (1 to 16).                  

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL1, abscoefH1, SELFREF1
         DM_BCAST_MACRO(abscoefL1)
         DM_BCAST_MACRO(abscoefH1)
         DM_BCAST_MACRO(SELFREF1)

! **************************************************************************     
!     The array abscoefL2 contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels > ~100mb and temperatures.  The first       
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the corresponding TREF for this  pressure level, &           
!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &         
!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second              
!     index, JP, runs from 1 to 13 and refers to the corresponding               
!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).      
!     The third index, IG, goes from 1 to 16, and tells us which                 
!     g-interval the absorption coefficients are for.                            

                                                                                 
!     The array abscoefH2 contains absorption coefs at the 16 chosen g-values           
!     for a range of pressure levels < ~100mb and temperatures. The first        
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the reference temperature TREF for this pressure              
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
!     The second index, JP, runs from 13 to 59 and refers to the JPth            
!     reference pressure level (see taumol.f for the value of these              
!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
!     and tells us which g-interval the absorption coefficients are for.         

                                                                                 
!     The array SELFREF2 contains the coefficient of the water vapor              
!     self-continuum (including the energy term).  The first index               
!     refers to temperature in 7.2 degree increments.  For instance, &          
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
!     etc.  The second index runs over the g-channel (1 to 16).                  

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL2, abscoefH2, SELFREF2
         DM_BCAST_MACRO(abscoefL2)
         DM_BCAST_MACRO(abscoefH2)
         DM_BCAST_MACRO(SELFREF2)
                                                                                 
! **************************************************************************     

!     The array abscoefL3 contains absorption coefs for each of the 16 g-intervals   
!     for a range of pressure levels > ~100mb, temperatures, and ratios          
!     of water vapor to CO2.  The first index in the array, JS, runs             
!     from 1 to 10, and corresponds to different water vapor to CO2 ratios, &   
!     as expressed through the binary species parameter eta, defined as          
!     eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated    
!     line strength in the band of co2 to that of h2o.  For instance, &         
!     JS=1 refers to dry air (eta = 0), JS = 10 corresponds to eta = 1.0.        
!     The 2nd index in the array, JT, which runs from 1 to 5, corresponds        
!     to different temperatures.  More specifically, JT = 3 means that the       
!     data are for the reference temperature TREF for this  pressure             
!     level, JT = 2 refers to the temperature                                    
!     TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5          
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
!     to the reference pressure level (e.g. JP = 1 is for a                      
!     pressure of 1053.63 mb).  The fourth index, IG, goes from 1 to 16, &      
!     and tells us which g-interval the absorption coefficients are for.         

                                                                                 
!     The array abscoefH3 contains absorption coefs for each of the 16 g-intervals      
!     for a range of pressure levels  < ~100mb, temperatures, and ratios         
!     of H2O to CO2.  The first index in the array, JS, runs from 1 to 5, &     
!     and corresponds to different H2O to CO2 ratios, as expressed through       
!     the binary species parameter eta, defined as eta = H2O/(H2O+RAT*CO2), &   
!     where RAT is the ratio of the integrated line strength in the band         
!     of CO2 to that of H2O.  For instance, JS=1 refers to no H2O, &            
!     JS = 2 corresponds to eta = 0.25, etc.  The second index, JT, which        
!     runs from 1 to 5, corresponds to different temperatures.  More             
!     specifically, JT = 3 means that the data are for the corresponding         
!     reference temperature TREF for this  pressure level, JT = 2 refers         
!     to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and          
!     JT = 5 is for TREF+30.  The third index, JP, runs from 13 to 59 and        
!     refers to the corresponding pressure level in PREF (e.g. JP = 13 is        
!     for a pressure of 95.5835 mb).  The fourth index, IG, goes from 1 to       
!     16, and tells us which g-interval the absorption coefficients are for.     

                                                                                 
!     The array SELFREF3 contains the coefficient of the water vapor              
!     self-continuum (including the energy term).  The first index               
!     refers to temperature in 7.2 degree increments.  For instance, &          
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
!     etc.  The second index runs over the g-channel (1 to 16).                  

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL3, abscoefH3, SELFREF3
         DM_BCAST_MACRO(abscoefL3)
         DM_BCAST_MACRO(abscoefH3)
         DM_BCAST_MACRO(SELFREF3)
                                                                                 
! **************************************************************************     
                                                                                 
!     The array abscoefL4 contains absorption coefs for each of the 16 g-intervals      
!     for a range of pressure levels > ~100mb, temperatures, and ratios          
!     of water vapor to CO2.  The first index in the array, JS, runs             
!     from 1 to 9 and corresponds to different water vapor to CO2 ratios, &     
!     as expressed through the binary species parameter eta, defined as          
!     eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated    
!     line strength in the band of co2 to that of h2o.  For instance, &         
!     JS=1 refers to dry air (eta = 0), JS = 9 corresponds to eta = 1.0.         
!     The 2nd index in the array, JT, which runs from 1 to 5, corresponds        
!     to different temperatures.  More specifically, JT = 3 means that the       
!     data are for the reference temperature TREF for this pressure              
!     level, JT = 2 refers to the temperature TREF-15, &                        
!     JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5                   
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
!     to the reference pressure level (e.g. JP = 1 is for a                      
!     pressure of 1053.63 mb).  The fourth index, IG, goes from 1 to 16, &      
!     and tells us which g-interval the absorption coefficients are for.         

                                                                                 
!     The array abscoefH4 contains absorption coefs for each of the 16 g-intervals      
!     for a range of pressure levels  < ~100mb, temperatures, and ratios         
!     of O3 to CO2.  The first index in the array, JS, runs from 1 to 6, &      
!     and corresponds to different O3 to CO2 ratios, as expressed through        
!     the binary species parameter eta, defined as eta = O3/(O3+RAT*H2O), &     
!     where RAT is the ratio of the integrated line strength in the band         
!     of CO2 to that of O3.  For instance, JS=1 refers to no O3 (eta = 0)        
!     and JS = 5 corresponds to eta = 1.0.  The second index, JT, which          
!     runs from 1 to 5, corresponds to different temperatures.  More             
!     specifically, JT = 3 means that the data are for the corresponding         
!     reference temperature TREF for this  pressure level, JT = 2 refers         
!     to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and          
!     JT = 5 is for TREF+30.  The third index, JP, runs from 13 to 59 and        
!     refers to the corresponding pressure level in PREF (e.g. JP = 13 is        
!     for a pressure of 95.5835 mb).  The fourth index, IG, goes from 1 to       
!     16, and tells us which g-interval the absorption coefficients are for.     

                                                                                 
!     The array SELFREF4 contains the coefficient of the water vapor              
!     self-continuum (including the energy term).  The first index               
!     refers to temperature in 7.2 degree increments.  For instance, &          
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
!     etc.  The second index runs over the g-channel (1 to 16).                  

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL4, abscoefH4, SELFREF4
         DM_BCAST_MACRO(abscoefL4)
         DM_BCAST_MACRO(abscoefH4)
         DM_BCAST_MACRO(SELFREF4)
                                                                                 
! **************************************************************************     
                                                                                 
!     The array abscoefL5 contains absorption coefs for each of the 16 g-intervals
!     for a range of pressure levels > ~100mb, temperatures, and ratios          
!     of water vapor to CO2.  The first index in the array, JS, runs             
!     from 1 to 9 and corresponds to different water vapor to CO2 ratios, &     
!     as expressed through the binary species parameter eta, defined as          
!     eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated    
!     line strength in the band of co2 to that of h2o.  For instance, &         
!     JS=1 refers to dry air (eta = 0), JS = 9 corresponds to eta = 1.0.         
!     The 2nd index in the array, JT, which runs from 1 to 5, corresponds        
!     to different temperatures.  More specifically, JT = 3 means that the       
!     data are for the reference temperature TREF for this  pressure             
!     level, JT = 2 refers to the temperature TREF-15, &                        
!     JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5                   
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
!     to the reference pressure level (e.g. JP = 1 is for a                      
!     pressure of 1053.63 mb).  The fourth index, IG, goes from 1 to 16, &      
!     and tells us which g-interval the absorption coefficients are for.         

                                                                                 
!     The array abscoefH5 contains absorption coefs for each of the 16 g-intervals      
!     for a range of pressure levels  < ~100mb, temperatures, and ratios         
!     of O3 to CO2.  The first index in the array, JS, runs from 1 to 5, &      
!     and corresponds to different O3 to CO2 ratios, as expressed through        
!     the binary species parameter eta, defined as eta = O3/(O3+RAT*CO2), &     
!     where RAT is the ratio of the integrated line strength in the band         
!     of co2 to that of O3.  For instance, JS=1 refers to no O3 (eta = 0)        
!     and JS = 5 corresponds to eta = 1.0.  The second index, JT, which          
!     runs from 1 to 5, corresponds to different temperatures.  More             
!     specifically, JT = 3 means that the data are for the corresponding         
!     reference temperature TREF for this  pressure level, JT = 2 refers         
!     to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and          
!     JT = 5 is for TREF+30.  The third index, JP, runs from 13 to 59 and        
!     refers to the corresponding pressure level in PREF (e.g. JP = 13 is        
!     for a pressure of 95.5835 mb).  The fourth index, IG, goes from 1 to       
!     16, and tells us which g-interval the absorption coefficients are for.     

                                                                                 
!     The array SELFREF5 contains the coefficient of the water vapor              
!     self-continuum (including the energy term).  The first index               
!     refers to temperature in 7.2 degree increments.  For instance, &          
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
!     etc.  The second index runs over the g-channel (1 to 16).                  

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL5, abscoefH5, SELFREF5
         DM_BCAST_MACRO(abscoefL5)
         DM_BCAST_MACRO(abscoefH5)
         DM_BCAST_MACRO(SELFREF5)
                                                                                 
! **************************************************************************     
                                                                                 
!     The array abscoefL6 contains absorption coefs at the 16 chosen g-values    
!     for a range of pressure levels > ~100mb and temperatures.  The first       
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the corresponding TREF for this  pressure level, &           
!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &         
!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second              
!     index, JP, runs from 1 to 13 and refers to the corresponding               
!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).      
!     The third index, IG, goes from 1 to 16, and tells us which                 
!     g-interval the absorption coefficients are for.                            

                                                                                 
!     The array SELFREF6 contains the coefficient of the water vapor              
!     self-continuum (including the energy term).  The first index               
!     refers to temperature in 7.2 degree increments.  For instance, &          
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
!     etc.  The second index runs over the g-channel (1 to 16).                  

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL6, SELFREF6
         DM_BCAST_MACRO(abscoefL6)
         DM_BCAST_MACRO(SELFREF6)
                                                                                 
! **************************************************************************     
                                                                                 
!     The array abscoefL7 contains absorption coefs at the 16 chosen g-values           
!     for a range of pressure levels> ~100mb, temperatures, and binary           
!     species parameters (see taumol.f for definition).  The first               
!     index in the array, JS, runs from 1 to 9, and corresponds to               
!     different values of the binary species parameter.  For instance, &        
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &   
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index      
!     in the array, JT, which runs from 1 to 5, corresponds to different         
!     temperatures.  More specifically, JT = 3 means that the data are for       
!     the reference temperature TREF for this  pressure level, JT = 2 refers     
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5       
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
!     to the JPth reference pressure level (see taumol.f for these levels        
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates            
!     which g-interval the absorption coefficients are for.                      

                                                                                 
!     The array abscoefH7 contains absorption coefs at the 16 chosen g-values           
!     for a range of pressure levels < ~100mb and temperatures. The first        
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the reference temperature TREF for this pressure              
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
!     The second index, JP, runs from 13 to 59 and refers to the JPth            
!     reference pressure level (see taumol.f for the value of these              
!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
!     and tells us which g-interval the absorption coefficients are for.         

                                                                                 
!     The array SELFREF7 contains the coefficient of the water vapor              
!     self-continuum (including the energy term).  The first index               
!     refers to temperature in 7.2 degree increments.  For instance, &          
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
!     etc.  The second index runs over the g-channel (1 to 16).                  

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL7, abscoefH7, SELFREF7
         DM_BCAST_MACRO(abscoefL7)
         DM_BCAST_MACRO(abscoefH7)
         DM_BCAST_MACRO(SELFREF7)
                                                                                 
! **************************************************************************
                                                                                 
!     The array abscoefL8 contains absorption coefs at the 16 chosen g-values    
!     for a range of pressure levels > ~100mb and temperatures.  The first       
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the corresponding TREF for this  pressure level, &           
!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &         
!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second              
!     index, JP, runs from 1 to 13 and refers to the corresponding               
!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).      
!     The third index, IG, goes from 1 to 16, and tells us which                 
!     g-interval the absorption coefficients are for.                            
!     The array abscoefL8 contains absorption coef5s at the 16 chosen g-values          
!     for a range of pressure levels > ~100mb and temperatures.  The first       
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the cooresponding TREF for this  pressure level, &           
!     JT = 2 refers to the temperature                                           
!     TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5          
!     is for TREF+30.  The second index, JP, runs from 1 to 13 and refers        
!     to the corresponding pressure level in PREF (e.g. JP = 1 is for a          
!     pressure of 1053.63 mb).  The third index, IG, goes from 1 to 16, &       
!     and tells us which "g-channel" the absorption coefficients are for.        

                                                                                 
!     The array abscoefH8 contains absorption coefs at the 16 chosen g-values           
!     for a range of pressure levels < ~100mb and temperatures. The first        
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the reference temperature TREF for this pressure              
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
!     The second index, JP, runs from 13 to 59 and refers to the JPth            
!     reference pressure level (see taumol.f for the value of these              
!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
!     and tells us which g-interval the absorption coefficients are for.         

!                                                                                
!       SELFREF8 is the array for the self-continuum.                                   
!                                                                                
         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL8, abscoefH8, SELFREF8
         DM_BCAST_MACRO(abscoefL8)
         DM_BCAST_MACRO(abscoefH8)
         DM_BCAST_MACRO(SELFREF8)
                                                                                 
! **************************************************************************
                                                                                 
!     The array abscoefL9 contains absorption coefs at the 16 chosen g-values    
!     for a range of pressure levels> ~100mb, temperatures, and binary           
!     species parameters (see taumol.f for definition).  The first               
!     index in the array, JS, runs from 1 to 11, and corresponds to              
!     different values of the binary species parameter.  For instance, &        
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &   
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index      
!     in the array, JT, which runs from 1 to 5, corresponds to different         
!     temperatures.  More specifically, JT = 3 means that the data are for       
!     the reference temperature TREF for this  pressure level, JT = 2 refers     
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5       
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
!     to the JPth reference pressure level (see taumol.f for these levels        
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates            
!     which g-interval the absorption coefficients are for.                      

                                                                                 
!     The array abscoefH9 contains absorption coefs at the 16 chosen g-values           
!     for a range of pressure levels < ~100mb and temperatures. The first        
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the reference temperature TREF for this pressure              
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
!     The second index, JP, runs from 13 to 59 and refers to the JPth            
!     reference pressure level (see taumol.f for the value of these              
!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
!     and tells us which g-interval the absorption coefficients are for.         

                                                                                 
!     The array SELFREF9 contains the coefficient of the water vapor              
!     self-continuum (including the energy term).  The first index               
!     refers to temperature in 7.2 degree increments.  For instance, &          
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
!     etc.  The second index runs over the g-channel (1 to 16).                  

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL9, abscoefH9, SELFREF9
         DM_BCAST_MACRO(abscoefL9)
         DM_BCAST_MACRO(abscoefH9)
         DM_BCAST_MACRO(SELFREF9)
                                                                                 
! **************************************************************************
                                                                                 
!     The array abscoefL10 contains absorption coefs at the 16 chosen g-values   
!     for a range of pressure levels > ~100mb and temperatures.  The first       
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the corresponding TREF for this  pressure level, &           
!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &         
!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second              
!     index, JP, runs from 1 to 13 and refers to the corresponding               
!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).      
!     The third index, IG, goes from 1 to 16, and tells us which                 
!     g-interval the absorption coefficients are for.                            

                                                                                 
!     The array abscoefH10 contains absorption coefs at the 16 chosen g-values           
!     for a range of pressure levels < ~100mb and temperatures. The first        
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the reference temperature TREF for this pressure              
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
!     The second index, JP, runs from 13 to 59 and refers to the JPth            
!     reference pressure level (see taumol.f for the value of these              
!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
!     and tells us which g-interval the absorption coefficients are for.         

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL10, abscoefH10
         DM_BCAST_MACRO(abscoefL10)
         DM_BCAST_MACRO(abscoefH10)
                                                                                 
! **************************************************************************
                                                                                 
!     The array abscoefL11 contains absorption coefs at the 16 chosen g-values   
!     for a range of pressure levels > ~100mb and temperatures.  The first       
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the corresponding TREF for this  pressure level, &           
!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &         
!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second              
!     index, JP, runs from 1 to 13 and refers to the corresponding               
!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).      
!     The third index, IG, goes from 1 to 16, and tells us which                 
!     g-interval the absorption coefficients are for.                            

                                                                                 
!     The array abscoefH11 contains absorption coefs at the 16 chosen g-values           
!     for a range of pressure levels < ~100mb and temperatures. The first        
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the reference temperature TREF for this pressure              
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
!     The second index, JP, runs from 13 to 59 and refers to the JPth            
!     reference pressure level (see taumol.f for the value of these              
!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
!     and tells us which g-interval the absorption coefficients are for.         

                                                                                 
!     The array SELFREF11 contains the coefficient of the water vapor              
!     self-continuum (including the energy term).  The first index               
!     refers to temperature in 7.2 degree increments.  For instance, &          
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
!     etc.  The second index runs over the g-channel (1 to 16).                  

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL11, abscoefH11, SELFREF11
         DM_BCAST_MACRO(abscoefL11)
         DM_BCAST_MACRO(abscoefH11)
         DM_BCAST_MACRO(SELFREF11)
                                                                                        
! **************************************************************************
                                                                                 
!     The array abscoefL12 contains absorption coefs at the 16 chosen g-values   
!     for a range of pressure levels> ~100mb, temperatures, and binary           
!     species parameters (see taumol.f for definition).  The first               
!     index in the array, JS, runs from 1 to 9, and corresponds to               
!     different values of the binary species parameter.  For instance, &        
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &   
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index      
!     in the array, JT, which runs from 1 to 5, corresponds to different         
!     temperatures.  More specifically, JT = 3 means that the data are for       
!     the reference temperature TREF for this  pressure level, JT = 2 refers     
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5       
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
!     to the JPth reference pressure level (see taumol.f for these levels        
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates            
!     which g-interval the absorption coefficients are for.                      

                                                                                 
!     The array SELFREF12 contains the coefficient of the water vapor              
!     self-continuum (including the energy term).  The first index               
!     refers to temperature in 7.2 degree increments.  For instance, &          
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
!     etc.  The second index runs over the g-channel (1 to 16).                  

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL12, SELFREF12
         DM_BCAST_MACRO(abscoefL12)
         DM_BCAST_MACRO(SELFREF12)
                                                                                 
! **************************************************************************
                                                                                 
!     The array abscoefL13 contains absorption coefs at the 16 chosen g-values   
!     for a range of pressure levels> ~100mb, temperatures, and binary           
!     species parameters (see taumol.f for definition).  The first               
!     index in the array, JS, runs from 1 to 9, and corresponds to               
!     different values of the binary species parameter.  For instance, &        
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &   
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index      
!     in the array, JT, which runs from 1 to 5, corresponds to different         
!     temperatures.  More specifically, JT = 3 means that the data are for       
!     the reference temperature TREF for this  pressure level, JT = 2 refers     
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5       
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
!     to the JPth reference pressure level (see taumol.f for these levels        
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates            
!     which g-interval the absorption coefficients are for.                      

                                                                                 
!     The array SELFREF13 contains the coefficient of the water vapor              
!     self-continuum (including the energy term).  The first index               
!     refers to temperature in 7.2 degree increments.  For instance, &          
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
!     etc.  The second index runs over the g-channel (1 to 16).                  

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL13, SELFREF13
         DM_BCAST_MACRO(abscoefL13)
         DM_BCAST_MACRO(SELFREF13)
                                                                                 
! **************************************************************************
                                                                                 
!     The array abscoefL14 contains absorption coefs at the 16 chosen g-values   
!     for a range of pressure levels > ~100mb and temperatures.  The first       
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the corresponding TREF for this  pressure level, &           
!     JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &         
!     JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  The second              
!     index, JP, runs from 1 to 13 and refers to the corresponding               
!     pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).      
!     The third index, IG, goes from 1 to 16, and tells us which                 
!     g-interval the absorption coefficients are for.                            

                                                                                 
!     The array abscoefH14 contains absorption coefs at the 16 chosen g-values           
!     for a range of pressure levels < ~100mb and temperatures. The first        
!     index in the array, JT, which runs from 1 to 5, corresponds to             
!     different temperatures.  More specifically, JT = 3 means that the          
!     data are for the reference temperature TREF for this pressure              
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for             
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.                 
!     The second index, JP, runs from 13 to 59 and refers to the JPth            
!     reference pressure level (see taumol.f for the value of these              
!     pressure levels in mb).  The third index, IG, goes from 1 to 16, &        
!     and tells us which g-interval the absorption coefficients are for.         

                                                                                 
!     The array SELFREF14 contains the coefficient of the water vapor              
!     self-continuum (including the energy term).  The first index               
!     refers to temperature in 7.2 degree increments.  For instance, &          
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
!     etc.  The second index runs over the g-channel (1 to 16).                  

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL14, abscoefH14, SELFREF14
         DM_BCAST_MACRO(abscoefL14)
         DM_BCAST_MACRO(abscoefH14)
         DM_BCAST_MACRO(SELFREF14)
                                                                                        
! **************************************************************************
                                                                                 
!     The array abscoefL15 contains absorption coefs at the 16 chosen g-values   
!     for a range of pressure levels> ~100mb, temperatures, and binary           
!     species parameters (see taumol.f for definition).  The first               
!     index in the array, JS, runs from 1 to 9, and corresponds to               
!     different values of the binary species parameter.  For instance, &        
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &   
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index      
!     in the array, JT, which runs from 1 to 5, corresponds to different         
!     temperatures.  More specifically, JT = 3 means that the data are for       
!     the reference temperature TREF for this  pressure level, JT = 2 refers     
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5       
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
!     to the JPth reference pressure level (see taumol.f for these levels        
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates            
!     which g-interval the absorption coefficients are for.                      

                                                                                 
!     The array SELFREF15 contains the coefficient of the water vapor              
!     self-continuum (including the energy term).  The first index               
!     refers to temperature in 7.2 degree increments.  For instance, &          
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
!     etc.  The second index runs over the g-channel (1 to 16).                  

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL15, SELFREF15
         DM_BCAST_MACRO(abscoefL15)
         DM_BCAST_MACRO(SELFREF15)
                                                                                 
! **************************************************************************
                                                                                 
!     The array abscoefL16 contains absorption coefs at the 16 chosen g-values  
!     for a range of pressure levels> ~100mb, temperatures, and binary           
!     species parameters (see taumol.f for definition).  The first               
!     index in the array, JS, runs from 1 to 9, and corresponds to               
!     different values of the binary species parameter.  For instance, &        
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &   
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index      
!     in the array, JT, which runs from 1 to 5, corresponds to different         
!     temperatures.  More specifically, JT = 3 means that the data are for       
!     the reference temperature TREF for this  pressure level, JT = 2 refers     
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5       
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers         
!     to the JPth reference pressure level (see taumol.f for these levels        
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates            
!     which g-interval the absorption coefficients are for.                      

                                                                                 
!     The array SELFREF16 contains the coefficient of the water vapor              
!     self-continuum (including the energy term).  The first index               
!     refers to temperature in 7.2 degree increments.  For instance, &          
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &        
!     etc.  The second index runs over the g-channel (1 to 16).                  

         IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL16, SELFREF16
         DM_BCAST_MACRO(abscoefL16)
         DM_BCAST_MACRO(SELFREF16)

         IF ( wrf_dm_on_monitor() ) CLOSE (rrtm_unit)
                                                                                 
!-----------------------------------------------------------------------
                                                            
                
                                                                           
!  Compute lookup tables for transmittance, tau transition function,             
!  and clear sky tau (for the cloudy sky radiative transfer).  Tau is            
!  computed as a function of the tau transition function, transmittance          
!  is calculated as a function of tau, and the tau transition function           
!  is calculated using the linear in tau formulation at values of tau            
!  above 0.01.  TF is approximated as tau/6 for tau < 0.01.  All tables          
!  are computed at intervals of 0.001.  The inverse of the constant used         
!  in the Pade approximation to the tau transition function is set to b.         
                                                                                 
      TAU(0) = 0.0                                                               
      TAU(5000) = 1.E10                                                          
      TRANS(0) = 1.0                                                             
      TRANS(5000) = 0.0                                                          
      TF(0) = 0.0                                                                
      TF(5000) = 1.0                                                             
      BPADE=1./0.278                                                             
      DO 1000 ITRE = 1,4999                                                       
         TFN = ITRE/5.E3                                                          
         TAU(ITRE) = BPADE*TFN/(1.-TFN)                                           
         TRANS(ITRE) = EXP(-TAU(ITRE))                                             
         IF (TAU(ITRE).LT.0.1) THEN                                               
            TF(ITRE) = TAU(ITRE)/6.                                                
         ELSE                                                                    
            TF(ITRE) = 1.-2.*((1./TAU(ITRE))-(TRANS(ITRE)/(1.-TRANS(ITRE))))         
         ENDIF                                                                   
 1000 CONTINUE                                                                   
!  Calculate lookup tables for functions needed in routine TAUMOL (TAUGB2)       
      CORR1(0) = 1.                                                              
      CORR1(200) = 1.                                                            
      CORR2(0) = 1.                                                              
      CORR2(200) = 1.                                                            
      DO 1200 I = 1,199                                                          
         FP = 0.005*FLOAT(I)                                                     
         RTFP = SQRT(FP)                                                         
         CORR1(I) = RTFP/FP                                                      
         CORR2(I) = (1.-RTFP)/(1.-FP)                                            
 1200 CONTINUE                                                                   
                                                                                 
!  Perform g-point reduction from 16 per band (256 total points) to              
!  a band dependant number (140 total points) for all absorption                 
!  coefficient input data and Planck fraction input data.                        
!  Compute relative weighting for new g-point combinations.                      
                                                                                 
      IGCSM = 0                                                                  
      DO 500 IBND = 1,NBANDS                                                     
         IPRSM = 0                                                               
         IF (NGC(IBND).LT.16) THEN                                               
            DO 450 IGC = 1,NGC(IBND)                                             
               IGCSM = IGCSM + 1                                                 
               WTSUM = 0.                                                        
               DO 420 IPR = 1, NGN(IGCSM)                                        
                  IPRSM = IPRSM + 1                                              
                  WTSUM = WTSUM + WT(IPRSM)                                      
 420           CONTINUE                                                          
               WTSM(IGC) = WTSUM                                                 
 450        CONTINUE                                                             
            DO 400 IG = 1,NG(IBND)                                               
               IND = (IBND-1)*16 + IG                                            
               RWGT(IND) = WT(IG)/WTSM(NGM(IND))                                 
 400        CONTINUE                                                             
         ELSE                                                                    
            DO 300 IG = 1,NG(IBND)                                               
               IGCSM = IGCSM + 1                                                 
               IND = (IBND-1)*16 + IG                                            
               RWGT(IND) = 1.0                                                   
 300        CONTINUE                                                             
         ENDIF                                                                   
 500  CONTINUE                                                                   
                                                                                 
!  Reduce g-points for relevant data in each LW spectral band.                   
                                                                                 
      CALL CMBGB1 (abscoefL1,   abscoefH1,  SELFREF1,                   &
                   FRACREFA1,   FRACREFB1,  FORREF1,                    &
                   SELFREFC1,  FORREFC1, FRACREFAC1,                    &
                   FRACREFBC1   &
                  )
      CALL CMBGB2 (abscoefL2,   abscoefH2,  SELFREF2,                   &
                   FRACREFA2,   FRACREFB2,  FORREF2,                    &
                   SELFREFC2,  FORREFC2, FRACREFAC2,                    &
                   FRACREFBC2   &
                  )
      CALL CMBGB3 (abscoefL3,   abscoefH3,  SELFREF3,                   &
                   FRACREFA3,   FRACREFB3,                              &
                   FORREF3,     ABSN2OA3,   ABSN2OB3,                   &
                   SELFREFC3,  FORREFC3,                                &
                   ABSN2OAC3,   ABSN2OBC3,  FRACREFAC3, FRACREFBC3      &
                  )
      CALL CMBGB4 (abscoefL4,   abscoefH4,  SELFREF4,                   &
                   FRACREFA4,   FRACREFB4,                              &
                   SELFREFC4,  FRACREFAC4, FRACREFBC4                   &
                  )
      CALL CMBGB5 (abscoefL5,   abscoefH5,  SELFREF5,                   &
                   FRACREFA5,   FRACREFB5,  CCL45,                      &
                   SELFREFC5,  CCL4C5, FRACREFAC5,                      &
                   FRACREFBC5   &
                  )
      CALL CMBGB6 (abscoefL6,               SELFREF6,                   &
                   FRACREFA6,   ABSCO26,    CFC11ADJ6, CFC126,          &
                   SELFREFC6, ABSCO2C6, CFC11ADJC6, CFC12C6,            &
                   FRACREFAC6   &
                  )
      CALL CMBGB7 (abscoefL7,   abscoefH7,  SELFREF7,                   &
                   FRACREFA7,   FRACREFB7,  ABSCO27,                    &
                   SELFREFC7,  ABSCO2C7, FRACREFAC7,                    &
                   FRACREFBC7   &
                  )
      CALL CMBGB8 (abscoefL8,   abscoefH8,  SELFREF8,                   &
                   FRACREFA8,   FRACREFB8,  ABSCO2A8, ABSCO2B8,         &
                   ABSN2OA8,    ABSN2OB8,   CFC128,   CFC22ADJ8,        &
                   SELFREFC8,  ABSCO2AC8, ABSCO2BC8,                    &
                   ABSN2OAC8,   ABSN2OBC8,  CFC12C8,   CFC22ADJC8,      &
                   FRACREFAC8, FRACREFBC8                               &
                  )
      CALL CMBGB9 (abscoefL9,   abscoefH9,  SELFREF9,                   &
                   FRACREFA9,   FRACREFB9,  ABSN2O9,                    &
                   SELFREFC9,  ABSN2OC9, FRACREFAC9,                    &
                   FRACREFBC9                                           &
                  )  
      CALL CMBGB10(abscoefL10, abscoefH10,                              &
                   FRACREFA10, FRACREFB10,                              &
                   FRACREFAC10, FRACREFBC10                             &
                  )
      CALL CMBGB11(abscoefL11, abscoefH11, SELFREF11,                   &
                   FRACREFA11, FRACREFB11,                              &
                   SELFREFC11,  FRACREFAC11,                            &
                   FRACREFBC11  &
                  )
      CALL CMBGB12(abscoefL12,             SELFREF12,                   &
                   FRACREFA12,                                          &
                   SELFREFC12, FRACREFAC12                              &
                  )
      CALL CMBGB13(abscoefL13,             SELFREF13,                   &
                   FRACREFA13,                                          &
                   SELFREFC13, FRACREFAC13                              &
                  )
      CALL CMBGB14(abscoefL14, abscoefH14, SELFREF14,                   &
                   FRACREFA14, FRACREFB14,                              &
                   SELFREFC14, FRACREFAC14,                             &
                   FRACREFBC14 &
                  )
      CALL CMBGB15(abscoefL15,             SELFREF15,                   &
                   FRACREFA15,                                          &
                   SELFREFC15, FRACREFAC15                              &
                  )
      CALL CMBGB16(abscoefL16,             SELFREF16,                   &
                   FRACREFA16,                                          &
                   SELFREFC16, FRACREFAC16                              &
                  )
      RETURN
9009 CONTINUE
     WRITE( errmess , '(A,I4)' ) 'module_ra_rrtm: error opening RRTM_DATA on unit ',rrtm_unit
     CALL wrf_error_fatal(errmess)
     RETURN
9010 CONTINUE
     WRITE( errmess , '(A,I4)' ) 'module_ra_rrtm: error reading RRTM_DATA on unit ',rrtm_unit
     CALL wrf_error_fatal(errmess)
      END SUBROUTINE rrtm_lookuptable

!------------------------------------------------------------------

END MODULE module_ra_rrtm
