SpectraRust/tlusty/extracted/collhe.f
2026-03-19 14:05:33 +08:00

315 lines
17 KiB
Fortran

SUBROUTINE COLLHE(TEMP,COLHE1)
C ==============================
C
C GENERATES COLLISIONAL RATE COEFFICIENTS AMONG THE 19 STATES OF
C HELIUM WITH N = 1, 2, 3, AND 4, USING RATES EVALUATED FROM THE
C CROSS SECTIONS CALCULATED BY BERRINGTON AND KINGSTON (J. PHYS.B. 20,
C 6631(1987)). COLLISIONAL RATE COEFFICIENTS HAVE BEEN EVALUATED
C NUMERICALLY BY P.J.STOREY FROM THE UNPUBLISHED COMPUTER OUTPUT
C FILES OF BERRINGTON AND KINGSTON.
C
C THE STATES INCLUDED IN THE CALCULATION ARE LABELLED SEQUENTIALLY
C IN ORDER OF INCREASING ENERGY:
C 1 1 SING S
C 2 2 TRIP S
C 3 2 SING S
C 4 2 TRIP P
C 5 2 SING P
C 6 3 TRIP S
C 7 3 SING S
C 8 3 TRIP P
C 9 3 TRIP D
C 10 3 SING D
C 11 3 SING P
C 12 4 TRIP S
C 13 4 SING S
C 14 4 TRIP P
C 15 4 TRIP D
C 16 4 SING D
C 17 4 TRIP F
C 18 4 SING F
C 19 4 SING P
C
C THIS ORDERING DIFFERS SLIGHTLY FROM THAT OF BERRINGTON AND KINGSTON,
C IN WHICH 15 AND 16, AND 17 AND 18, WERE INTERCHANGED.
C
C THE INTRINSIC ACCURACY OF TRANSITIONS AMONG STATES WITH N = 1, 2,
C AND 3 IS EXPECTED TO BE CONSIDERABLY BETTER THAN THOSE WITH N = 4
C AS DISCUSSED BY BERRINGTON AND KINGSTON. THE FITTING ACCURACY IS
C EVERYWHERE BETTER THAN 2%. THE ENERGIES OF THE LEVELS ARE TAKEN
C FROM W. C. MARTIN, PHYS. CHEM. REF. DATA., VOL.2, 257 (1973) AND
C ARE GIVEN IN ELECTRON VOLTS. (BOLTZMANN'S CONSTANT = 8.62E-5)
C
C FIRST REVISED VERSION: D.G.HUMMER, MAY 1988, JILA
C slightly modified by I.H., July 1988
C
INCLUDE 'IMPLIC.FOR'
PARAMETER (UN=1.D0,
* C1=3.849485D0,
* C2=8.49485002D-1,
* N=19)
DIMENSION ENER(19),COLHE1(19,19),
* NSTART(172),A(929),B(10),STWT(19)
C
DATA ENER/ 0.0D0,19.8198D0,20.6160D0,20.96432D0,21.2182D0,
.22.7187D0,22.9206D0,23.00731D0,23.0739D0,23.0743D0,23.0873D0,
.23.5942D0,23.6738D0,23.7081D0,23.7363D0,23.7366D0,23.7373D0,
.23.7373D0,23.7423D0/
C
DATA STWT/1.0D0,3.0D0,1.0D0,9.0D0,3.0D0,3.0D0,1.0D0,9.0D0,
.1.5D1,5.0D0,3.0D0,3.0D0,1.0D0,9.0D0,1.5D1,5.0D0,2.1D1,
.7.0D0,3.0D0/
C
DATA NSTART/
. 1, 6, 11, 16, 20, 28, 32, 40, 44, 52, 57, 62, 67, 72, 77, 82,
. 88, 92, 98,104,110,114,120,125,129,135,139,147,151,157,164,170,
.177,183,190,195,202,208,213,220,225,232,236,243,247,251,260,266,
.273,278,285,290,300,304,309,316,320,324,329,333,338,343,347,352,
.357,362,367,372,376,382,386,391,395,401,405,410,414,421,425,431,
.435,440,445,449,454,459,465,470,475,480,487,491,497,503,508,515,
.520,525,530,536,542,547,552,559,564,571,576,581,587,592,598,603,
.608,613,617,623,630,635,642,646,650,655,660,666,671,677,683,689,
.695,702,707,713,718,723,728,732,737,741,745,750,754,759,765,771,
.777,782,789,796,801,805,810,815,819,824,831,837,844,850,856,861,
.868,873,877,882,890,895,905,909,913,920,925,930/
C
DATA (A(I),I=1,95)/
. 1.7339D-07, 2.7997D-08,-1.3812D-08, 2.6639D-09, 1.7776D-09,
. 2.9820D-07, 7.5210D-08,-3.5975D-09, 3.2270D-09, 1.5245D-09,
. 1.5601D-05, 1.5340D-06,-2.2122D-06,-1.1073D-07, 1.9249D-07,
. 2.3682D-08, 1.0638D-08, 2.0959D-09, 2.8381D-10, 3.0497D-05,
. 1.9252D-05, 6.3109D-06, 6.9098D-07,-2.8039D-07,-2.1128D-07,
.-1.2192D-07,-4.4417D-08, 1.3896D-06, 1.5715D-07,-8.4358D-08,
.-2.8800D-08, 5.9599D-08, 3.4756D-08, 1.2183D-08, 3.7999D-09,
. 8.5500D-10,-3.9428D-10,-5.3999D-10,-2.2962D-10, 2.2510D-06,
. 6.1436D-07,-1.2437D-07,-7.1718D-08, 5.9026D-05, 3.8150D-05,
. 1.1426D-05, 9.2886D-07,-6.4827D-07,-4.4270D-07,-1.8611D-07,
.-5.6403D-08, 5.8752D-06, 2.5167D-06, 2.0787D-07,-2.3353D-07,
.-8.9900D-08, 5.6334D-08, 2.9313D-09, 1.7775D-09, 5.5494D-10,
.-5.8914D-10, 8.1939D-06, 2.4014D-07, 3.8681D-07, 2.8446D-07,
.-6.1936D-08, 1.8173D-06,-4.7530D-07,-6.6432D-08, 5.4898D-08,
.-1.2377D-08, 2.0732D-05, 6.5991D-07, 1.5840D-06, 4.9920D-07,
.-1.8332D-07, 3.2273D-06,-4.9880D-07,-2.4929D-07, 1.1964D-07,
.-2.1996D-08, 9.7096D-08, 1.3557D-08, 7.4404D-09, 1.3858D-09,
.-1.3778D-09,-8.4885D-10, 3.5068D-06,-5.0675D-07,-1.2252D-07,
. 6.0514D-08, 7.0524D-06, 1.4454D-06, 8.3966D-07, 2.7203D-07/
DATA (A(I),I=96,190)/
.-2.3854D-08,-8.6693D-08, 7.1193D-06, 8.3111D-09,-9.3916D-07,
.-2.7944D-08, 1.7803D-07,-3.9216D-08, 9.2760D-06, 2.4761D-06,
. 1.0095D-06, 3.4039D-07,-8.6900D-08,-1.1156D-07, 2.5036D-05,
.-5.7791D-06,-1.8197D-06, 1.0630D-06, 9.8746D-09, 3.1048D-09,
. 1.2172D-09, 1.8411D-10,-1.5835D-10,-1.4443D-10, 1.9240D-06,
. 1.5012D-07, 7.9741D-08, 2.9323D-08,-1.2796D-08, 5.0457D-07,
.-5.5146D-08,-2.7506D-08, 1.4341D-09, 1.3321D-05, 2.6960D-06,
. 2.8059D-07, 1.7548D-08,-2.3623D-07,-1.4619D-07, 1.5294D-06,
.-9.4925D-08,-1.1347D-07, 8.1980D-09, 1.3324D-04, 7.8068D-05,
. 2.9238D-05, 4.2718D-06,-1.6556D-06,-1.4529D-06,-8.6046D-07,
.-2.1062D-07, 2.8510D-06,-4.7936D-07,-2.4042D-07, 6.2333D-08,
. 1.3493D-09, 3.5113D-10,-4.7269D-11, 2.4872D-11,-9.7136D-12,
.-1.4217D-11, 1.5680D-06, 8.9272D-07, 2.8313D-07, 5.2456D-08,
.-2.3404D-08,-2.7304D-08,-8.4539D-09, 1.7967D-07, 6.2133D-08,
.-3.2814D-09,-3.7299D-09,-1.9587D-09,-1.6685D-09, 1.2707D-05,
. 7.5029D-06, 2.8330D-06, 6.7478D-07,-1.5012D-07,-2.3916D-07,
.-8.9594D-08, 7.6160D-07, 2.0422D-07,-2.5881D-08,-1.7624D-08,
.-8.3518D-09,-4.1743D-09, 4.6044D-05, 2.2425D-05, 3.3079D-06,
. 3.6752D-07,-8.4476D-08,-4.8455D-07,-2.5391D-07, 7.0824D-07/
DATA (A(I),I=191,285)/
. 1.4917D-07,-1.2005D-07,-1.6983D-08, 1.1545D-08, 7.2866D-04,
. 3.8907D-04, 9.6365D-05, 2.3153D-05, 1.8462D-07,-9.0627D-06,
.-5.4332D-06, 1.0458D-08, 1.6430D-09, 5.6453D-10, 2.0276D-10,
.-1.6501D-10,-1.0656D-10, 5.2198D-07, 4.2898D-08,-1.0332D-08,
.-5.6754D-09,-7.1960D-09, 3.0390D-06, 1.5385D-06, 6.2110D-07,
. 1.4111D-07,-3.7415D-08,-4.8395D-08,-1.7219D-08, 2.7227D-06,
. 1.4381D-07,-5.5030D-08,-2.2192D-10,-2.8583D-08, 1.8417D-05,
. 9.3860D-06, 3.9999D-06, 1.0424D-06,-2.1337D-07,-3.3271D-07,
.-1.2684D-07, 4.6063D-06,-6.7185D-07,-2.5830D-07, 2.9976D-08,
. 7.8012D-05, 3.4921D-05, 8.3012D-06, 1.5643D-06,-4.3892D-07,
.-9.5318D-07,-4.6534D-07, 1.7584D-05,-2.8817D-06,-1.0081D-06,
. 1.3259D-07, 1.8561D-05, 2.6602D-06,-1.7243D-06,-3.5533D-07,
. 2.3315D-08, 1.6239D-08, 7.3739D-09, 1.9570D-09,-2.5667D-10,
.-5.8101D-10,-2.3947D-10, 4.5821D-12, 4.5024D-11, 3.8796D-07,
. 1.1239D-07,-2.9033D-08,-5.7237D-09, 2.4186D-09,-2.9670D-09,
. 1.0887D-06, 4.3737D-07, 8.3753D-08, 3.6771D-08, 1.6545D-09,
.-1.3849D-08,-5.8855D-09, 2.1028D-06, 4.3725D-07,-1.7621D-07,
.-3.0743D-08, 1.7119D-08, 8.4698D-06, 4.5395D-06, 1.5774D-06,
. 4.1647D-07,-7.9865D-08,-1.6003D-07,-6.0171D-08, 3.1692D-06/
DATA (A(I),I=286,380)/
. 3.6965D-07,-4.9333D-07,-2.8856D-08, 4.2819D-08, 2.0492D-04,
. 1.3705D-04, 4.0972D-05, 2.9565D-06,-1.4061D-06,-1.8775D-06,
.-1.6306D-06,-3.6380D-07, 3.1213D-07, 2.0912D-07, 1.1965D-05,
. 9.9088D-07,-1.3565D-06,-2.3128D-07, 1.1379D-05, 2.6632D-06,
.-1.6877D-06,-4.0541D-07, 9.8921D-08, 5.9262D-03, 3.2332D-03,
. 9.2954D-04, 1.6597D-04,-3.7972D-05,-7.1646D-05,-4.0073D-05,
. 2.5789D-08, 5.2124D-09,-2.2517D-10,-7.9400D-10, 3.3181D-06,
. 1.9117D-07, 1.0299D-07,-7.7443D-08, 2.2953D-06,-1.0879D-06,
. 3.4368D-07,-1.1230D-07, 1.6826D-08, 6.9774D-06, 9.2721D-07,
.-1.8983D-08,-1.6068D-07, 1.5843D-06,-3.5616D-08,-1.1262D-07,
.-4.3051D-08, 8.8140D-09, 3.4244D-05, 8.0163D-06, 2.9703D-06,
.-1.6480D-07,-6.3282D-07, 2.3791D-06,-4.9305D-07,-1.7122D-07,
. 1.2147D-07, 7.2131D-05, 1.7699D-05, 8.4281D-06,-9.3966D-07,
.-6.8048D-07, 5.3785D-05, 6.9745D-06,-2.3554D-06,-7.2141D-07,
. 3.8501D-07, 4.4794D-06,-6.2435D-07,-2.7340D-07, 2.3127D-08,
. 4.2314D-08, 3.3784D-06,-5.1356D-07,-2.4321D-07,-6.2698D-09,
. 3.0812D-08, 5.6419D-08, 1.6889D-08, 2.7037D-09,-1.7433D-09,
.-9.4507D-10, 1.9714D-06, 4.2743D-08,-7.4114D-08,-2.9304D-08,
. 2.8973D-06, 1.0079D-06, 2.9561D-07,-6.2977D-09,-4.5782D-08/
DATA (A(I),I=381,475)/
.-2.4331D-08, 4.3284D-06, 2.8398D-07,-3.2705D-07,-1.5079D-07,
. 5.2686D-06, 1.6539D-06, 3.6079D-07,-1.1589D-07,-5.4904D-08,
. 7.0939D-06,-1.9534D-06, 3.2391D-08, 5.5702D-08, 3.9072D-05,
. 1.7299D-05, 5.1530D-06,-6.0911D-07,-1.2652D-06,-4.6507D-07,
. 1.1506D-05,-2.0422D-06,-6.1195D-07, 5.8641D-08, 1.0150D-05,
.-4.6977D-07,-6.9446D-07, 2.2516D-08, 1.1109D-07, 3.6715D-05,
. 5.6186D-06,-3.2309D-06,-1.6403D-06, 4.1051D-05, 2.3335D-05,
. 7.8106D-06, 2.0279D-07,-8.1139D-07,-3.7619D-07,-1.4982D-07,
. 2.5621D-05,-1.0798D-05, 1.4607D-06, 3.2421D-07, 6.5478D-09,
. 2.7233D-09, 3.8646D-10,-1.9143D-10,-1.0483D-10,-4.8664D-11,
. 1.0698D-06, 2.7752D-07,-2.6636D-08,-3.7583D-08, 2.6989D-07,
. 3.0325D-08,-2.4613D-08,-1.0828D-08, 2.2522D-09, 8.0777D-06,
. 2.2558D-06, 7.4760D-08,-2.4140D-07,-5.4292D-08, 8.8362D-07,
. 9.5045D-08,-5.0543D-08,-1.9134D-08, 1.1284D-05, 4.0659D-06,
. 7.6246D-07,-9.0394D-08,-8.7408D-08, 1.2192D-06,-2.0362D-07,
.-1.0700D-07, 2.1990D-08, 1.2519D-08, 5.2758D-05, 2.0175D-05,
. 3.6690D-06,-4.9014D-07,-7.0474D-07,-3.9931D-07, 4.7638D-05,
. 1.5546D-05, 6.2294D-07,-1.3428D-06,-1.8177D-07, 4.1203D-06,
.-4.9340D-07,-3.0198D-07,-1.5902D-08, 2.8567D-08, 2.2397D-06/
DATA (A(I),I=476,570)/
.-2.1306D-08,-1.7897D-07, 2.8178D-08, 4.1722D-08, 2.0594D-04,
. 1.2838D-04, 5.8219D-05, 1.1735D-05,-6.9778D-06,-6.2486D-06,
.-1.3800D-06, 2.9170D-06,-7.0833D-07,-1.2673D-07, 4.5069D-08,
. 1.0974D-09, 4.7908D-10, 3.0294D-11,-7.0815D-11,-1.2039D-11,
. 5.6357D-12, 8.1274D-07, 4.5158D-07, 1.1655D-07,-2.1481D-08,
.-2.2493D-08,-6.5884D-09, 9.8696D-08, 3.6499D-08, 1.4768D-09,
.-8.0141D-09,-2.8147D-09, 5.8287D-06, 3.2469D-06, 9.4927D-07,
.-7.2550D-08,-1.4231D-07,-5.8408D-08,-1.4468D-08, 4.6070D-07,
. 1.5956D-07,-3.2311D-09,-3.3487D-08,-7.9013D-09, 4.0092D-06,
. 1.2195D-06, 1.1192D-07,-1.3870D-07,-6.2194D-08, 5.4918D-07,
.-5.1133D-08,-5.4844D-08,-3.1054D-09, 6.1049D-09, 2.4833D-05,
. 1.1280D-05, 2.2680D-06,-4.4637D-07,-2.8942D-07,-1.2382D-07,
. 6.8223D-05, 3.6505D-05, 7.8792D-06,-1.7946D-06,-1.4925D-06,
.-4.6018D-07, 2.5677D-06,-7.2440D-08,-2.2441D-07,-4.1769D-08,
. 2.3833D-08, 1.1885D-06, 4.0457D-09,-1.2273D-07,-2.3271D-08,
. 1.5149D-08, 9.1912D-05, 5.6621D-05, 1.4338D-05,-2.6072D-06,
.-2.3688D-06,-6.2490D-07,-1.4386D-07, 1.0821D-06,-1.6304D-07,
.-7.9756D-08,-4.9881D-09, 9.9527D-09, 1.5288D-03, 9.8517D-04,
. 3.4966D-04, 3.4238D-05,-4.3610D-05,-3.2734D-05,-8.3676D-06/
DATA (A(I),I=571,665)/
. 9.6630D-09, 3.2976D-09, 2.1545D-10,-3.3938D-10,-1.4397D-10,
. 3.4140D-07, 7.6536D-08,-2.2485D-08,-1.8244D-08,-2.0611D-09,
. 1.3128D-06, 6.4165D-07, 1.4728D-07,-2.7600D-08,-3.0125D-08,
.-1.0320D-08, 1.6295D-06, 3.3697D-07,-5.7547D-08,-7.3134D-08,
.-1.5301D-08, 8.0375D-06, 4.0695D-06, 1.1441D-06,-5.8423D-08,
.-1.6488D-07,-7.5920D-08, 2.1173D-06,-1.9184D-07,-2.4986D-07,
. 7.2656D-09, 2.7560D-08, 7.9040D-06, 3.3963D-06, 4.8082D-07,
.-3.1619D-07,-1.6501D-07, 5.8017D-06,-5.5173D-07,-6.3613D-07,
. 1.9633D-08, 7.8681D-08, 9.4568D-06, 9.8227D-08,-7.8983D-07,
.-2.0343D-07, 7.0351D-05, 3.6017D-05, 8.0504D-06,-1.7276D-06,
.-1.5329D-06,-4.7799D-07, 3.5263D-05, 1.8639D-05, 4.2070D-06,
.-4.2643D-07,-5.2726D-07,-2.5481D-07,-1.0144D-07, 4.4613D-06,
.-8.7802D-07,-3.9633D-07, 6.7953D-08, 4.1539D-08, 1.8780D-04,
. 1.0547D-04, 2.0983D-05,-3.7076D-06,-3.7090D-06,-1.5934D-06,
.-2.6146D-07, 1.6384D-05,-3.3765D-06,-7.8390D-07, 1.2382D-07,
. 1.5748D-05,-9.4352D-07,-4.8936D-07,-4.9967D-07, 3.8177D-10,
. 9.6781D-11,-1.9622D-11,-1.7859D-11,-4.4781D-12, 3.0310D-07,
. 1.1193D-07,-5.4059D-09,-1.4249D-08,-1.9549D-09, 4.7664D-08,
. 8.5684D-09,-5.0948D-09,-3.1313D-09, 4.9557D-10, 4.2702D-10/
DATA (A(I),I=666,760)/
. 2.3433D-06, 8.3824D-07, 2.6585D-08,-7.5944D-08,-1.5093D-08,
. 1.8775D-07, 2.7614D-08,-2.1193D-08,-1.0264D-08, 1.9660D-09,
. 1.1637D-09, 7.7890D-06, 3.2901D-06,-2.9753D-07,-5.3153D-07,
.-5.2098D-08, 3.3947D-08, 5.5937D-07, 5.1363D-08,-8.5390D-08,
.-2.2580D-08, 1.0857D-08, 3.5157D-09, 4.1303D-05, 2.1947D-05,
. 3.9480D-06,-1.4234D-06,-9.0220D-07,-2.4485D-07, 1.1031D-04,
. 6.6726D-05, 1.9581D-05,-4.3637D-07,-2.8911D-06,-1.4332D-06,
.-3.2332D-07, 3.0922D-06, 2.0624D-07,-4.0771D-07,-1.0402D-07,
. 4.8807D-08, 1.2491D-06, 2.1187D-07,-1.5951D-07,-7.2537D-08,
. 1.4035D-08, 9.6514D-09, 2.5146D-05,-9.4490D-08,-3.4103D-06,
. 2.4020D-07, 2.9564D-07, 6.6566D-07,-3.0772D-08,-1.0055D-07,
.-3.1082D-09, 1.4897D-08, 7.7189D-04, 3.3710D-04, 3.9258D-05,
.-1.5271D-05,-6.0652D-06, 2.1986D-04,-3.3135D-05,-8.5682D-06,
.-9.2988D-07, 3.8085D-06,-1.3259D-07,-3.8517D-07,-5.7276D-08,
. 3.7226D-08, 2.0825D-09, 1.6707D-10,-1.2443D-10,-3.9117D-11,
. 1.0068D-07, 6.2278D-09,-5.9169D-09,-3.9535D-09, 5.3334D-07,
. 2.2022D-07, 1.4522D-08,-2.8440D-08,-8.1406D-09, 6.0187D-07,
. 5.8318D-08,-2.7772D-08,-2.6639D-08, 3.0929D-06, 1.0648D-06,
. 1.2317D-07,-9.9233D-08,-4.0796D-08, 1.5217D-06, 8.3095D-08/
DATA (A(I),I=761,855)/
.-1.9819D-07,-6.0417D-08, 2.9553D-08, 9.0905D-09, 8.6651D-06,
. 3.9125D-06,-2.2871D-07,-6.4651D-07,-7.4440D-08, 4.3543D-08,
. 4.4505D-06, 2.7350D-07,-4.6428D-07,-2.2293D-07, 5.5275D-08,
. 3.6505D-08, 8.3471D-06, 5.0215D-07,-1.1189D-06,-2.5404D-07,
. 1.3175D-07, 1.1687D-04, 7.0674D-05, 2.0219D-05,-1.2136D-06,
.-3.2299D-06,-1.3981D-06,-2.8271D-07, 3.7298D-05, 2.2054D-05,
. 5.5510D-06,-9.1515D-07,-1.0832D-06,-3.6657D-07,-4.8581D-08,
. 2.2506D-06,-2.9469D-07,-2.1641D-07,-3.9630D-08, 5.2879D-08,
. 2.7894D-05,-3.9312D-06,-2.6413D-06, 5.5848D-07, 8.7829D-06,
.-1.4800D-06,-7.0982D-07,-2.1645D-08, 1.3258D-07, 1.2248D-05,
.-1.4244D-06,-7.6696D-07,-1.5029D-07, 6.8467D-08, 1.9392D-04,
.-2.6676D-05,-8.0536D-06,-6.3609D-07, 2.3074D-05, 7.2856D-07,
.-2.3751D-06,-5.8464D-07, 1.3685D-07, 1.9646D-08, 1.2918D-08,
. 4.6924D-09, 5.1593D-10,-4.4715D-10,-3.4091D-10,-9.7254D-11,
. 3.4117D-07, 1.2731D-07,-2.2300D-08,-2.5297D-08,-1.1877D-10,
. 2.3436D-09, 9.4463D-07, 4.9464D-07, 8.9138D-08,-2.2158D-08,
.-1.2008D-08,-4.3715D-09,-2.8719D-09, 1.4091D-06, 4.8184D-07,
.-9.6135D-08,-1.0945D-07,-9.3174D-09, 9.0166D-09, 4.3747D-06,
. 2.1053D-06, 1.7702D-07,-3.0956D-07,-1.2902D-07,-8.9418D-09/
DATA (A(I),I=856,929)/
. 1.4297D-06, 7.7612D-08,-1.7188D-07, 6.4348D-10, 1.1572D-08,
. 7.4828D-06, 4.0177D-06, 1.0890D-06, 8.6393D-08,-5.4701D-08,
.-5.7656D-08,-3.3030D-08, 5.0379D-06, 1.2861D-07,-7.1313D-07,
.-3.3703D-09, 7.9367D-08, 6.2235D-06, 9.8196D-07,-4.6416D-07,
.-2.3278D-07, 2.9519D-05, 1.5275D-05, 3.1448D-06,-6.4571D-07,
.-3.4445D-07, 3.6508D-05, 2.0524D-05, 3.1203D-06,-2.3606D-06,
.-1.5012D-06,-2.5807D-07, 1.3807D-07, 9.9656D-08, 3.1628D-06,
.-5.6361D-08,-3.8861D-07,-1.0385D-09, 2.9930D-08, 3.1351D-04,
. 2.3774D-04, 1.0342D-04, 1.2429D-05,-1.4107D-05,-9.2597D-06,
.-1.7338D-06, 8.4903D-07, 7.3795D-07, 2.2065D-07, 1.2134D-05,
. 4.6651D-07,-9.3659D-07,-2.7485D-07, 1.2462D-05, 6.2559D-07,
.-6.1634D-07,-5.1080D-07, 1.2493D-02, 8.2057D-03, 2.9562D-03,
. 3.3090D-04,-3.7349D-04,-2.8886D-04,-7.4606D-05, 1.2726D-05,
.-1.6480D-07,-1.5006D-06,-1.1181D-07, 1.4846D-07, 8.7160D-03,
. 4.2652D-03, 5.2455D-04,-2.6363D-04,-7.9836D-05/
SAVE ENER,NSTART,A,STWT
C
C SET ALL ELEMENTS OF COLHE1 = 0
C
DO I=1,N
DO J=1,N
COLHE1(I,J)=0.
END DO
END DO
C
C EVALUATE GAMMAS FOR REQUESTED LEVELS
C
XXX=2.D0*(LOG10(TEMP)-C1)/C2
TFAC=UN/SQRT(TEMP)
C
C LOOPS OVER LEVELS
C
DO IL=1,N-1
DO IU=IL+1,N
J=((IU*IU-3*IU+4)/2)+IL-1
N1=NSTART(J)
NF=NSTART(J+1)-1
NT=NF-N1+1
NTM2=NT-2
C
C CLENSHAW SUMMATION
C
B(NT)=A(NF)
B(NT-1)=XXX*B(NT)+A(NF-1)
IR=NTM2
JJ=NF-2
DO J=1,NTM2
B(IR)=XXX*B(IR+1)-B(IR+2)+A(JJ)
IR=IR-1
JJ=JJ-1
END DO
COLHE1(IU,IL)=(B(1)-B(3))*TFAC
X=(ENER(IL)-ENER(IU))/8.62D-5/TEMP
COLHE1(IL,IU)=COLHE1(IU,IL)*STWT(IU)/STWT(IL)*EXP(X)
END DO
END DO
RETURN
END