      SUBROUTINE KAPP(N,NSTEPS,STEPWT)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /IFOP/IFOP(20)
      COMMON /OPS/AHYD(kw),AH2P(kw),AHMIN(kw),SIGH(kw),AHE1(kw),
     1       AHE2(kw),AHEMIN(kw),SIGHE(kw),ACOOL(kw),ALUKE(kw),AHOT(kw),
     2            SIGEL(kw),SIGH2(kw),AHLINE(kw),ALINES(kw),SIGLIN(kw),
     3            AXLINE(kw),SIGXL(kw),AXCONT(kw),SIGX(kw),SHYD(kw),
     4            SHMIN(kw),SHLINE(kw),SXLINE(kw),SXCONT(kw)
      COMMON /OPTOT/ACONT(kw),SCONT(kw),ALINE(kw),SLINE(kw),SIGMAC(kw),
     1              SIGMAL(kw)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      DIMENSION DUMMY(kw,25)
      EQUIVALENCE (AHYD(1),DUMMY(1,1))
      STEPWT=1.
      NSTEPS=1
      IF(N.GT.1)GO TO 200
      DO 91 J=1,NRHOX
      DO 91 I=1,25
   91 DUMMY(J,I)=0.
      IF(IFOP(1).EQ.1)CALL HOP
      IF(IFOP(2).EQ.1)CALL H2PLOP
      IF(IFOP(3).EQ.1)CALL HMINOP
      IF(IFOP(4).EQ.1)CALL HRAYOP
      IF(IFOP(5).EQ.1)CALL HE1OP
      IF(IFOP(6).EQ.1)CALL HE2OP
      IF(IFOP(7).EQ.1)CALL HEMIOP
      IF(IFOP(8).EQ.1)CALL HERAOP
      IF(IFOP(9).EQ.1)CALL COOLOP
      IF(IFOP(10).EQ.1)CALL LUKEOP
      IF(IFOP(11).EQ.1)CALL HOTOP
      IF(IFOP(12).EQ.1)CALL ELECOP
      IF(IFOP(13).EQ.1)CALL H2RAOP
      IF(IFOP(14).EQ.1.AND.N.GT.0)CALL HLINOP
!      IF(IFOP(15).EQ.1.AND.N.GT.0)CALL LINOP(N,NSTEPS,STEPWT)
!      IF(IFOP(16).EQ.1.AND.N.GT.0)CALL LINSOP(N,NSTEPS,STEPWT)
!      IF(IFOP(17).EQ.1.AND.N.GT.0)CALL XLINOP
!      IF(IFOP(18).EQ.1.AND.N.GT.0)CALL XLISOP
!      IF(IFOP(19).EQ.1)CALL XCONOP
!      IF(IFOP(20).EQ.1)CALL XSOP
      DO 100 J=1,NRHOX
      A=AH2P(J)+AHE1(J)+AHE2(J)+AHEMIN(J)+ACOOL(J)+ALUKE(J)+AHOT(J)
      ACONT(J)=A+AHYD(J)+AHMIN(J)+AXCONT(J)
      SCONT(J)=BNU(J)
      IF(ACONT(J).GT.0.)SCONT(J)=(A*BNU(J)+AHYD(J)*SHYD(J)+AHMIN(J)*
     1SHMIN(J)+AXCONT(J)*SXCONT(J))/ACONT(J)
      ALINE(J)=AHLINE(J)+ALINES(J)+AXLINE(J)
      SLINE(J)=BNU(J)
      IF(ALINE(J).GT.0.)SLINE(J)=(AHLINE(J)*SHLINE(J)+ALINES(J)*BNU(J)+
     1AXLINE(J)*SXLINE(J))/ALINE(J)
      SIGMAC(J)=SIGH(J)+SIGHE(J)+SIGEL(J)+SIGH2(J)+SIGX(J)
  100 SIGMAL(J)=SIGLIN(J)+SIGXL(J)
      RETURN
!  200 IF(IFOP(15).EQ.1)CALL LINOP(N,NSTEPS,STEPWT)
!      IF(IFOP(16).EQ.1)CALL LINSOP(N,NSTEPS,STEPWT)
200	continue
      DO 201 J=1,NRHOX
      ALINE(J)=AHLINE(J)+ALINES(J)+AXLINE(J)
      IF(ALINE(J).GT.0.)SLINE(J)=(AHLINE(J)*SHLINE(J)+ALINES(J)*BNU(J)+
     1AXLINE(J)*SXLINE(J))/ALINE(J)
  201 SIGMAL(J)=SIGLIN(J)+SIGXL(J)
      RETURN
      END
      SUBROUTINE HOP
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     REQUIRES FUNCTIONS COULX AND COULFF
      COMMON /DEPART/BHYD(kw,6),BMIN(kw),NLTEON
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /IONS/XNFPH(kw,2),XNFPHE(kw,3),XNFH(kw,2),XNFHE(kw,3)
      COMMON /OPS/AHYD(kw),D1(kw,19),SHYD(kw),D2(kw,4)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      DIMENSION CONT(8),BOLT(kw,8),EXLIM(kw),FREET(kw),BOLTEX(kw)
      DATA ITEMP1/0/
      IF(ITEMP.EQ.ITEMP1)GO TO 20
      ITEMP1=ITEMP
      DO 15 J=1,NRHOX
      DO 11 N=1,8
   11 BOLT(J,N)=EXP(-(13.595-13.595/DFLOAT(N*N))/TKEV(J))*2.*
     1DFLOAT(N*N)*XNFPH(J,1)/RHO(J)
      DO 12 N=1,6
   12 BOLT(J,N)=BOLT(J,N)*BHYD(J,N)
      FREET(J)=XNE(J)*XNFH(J,2)/RHO(J)/SQRT(T(J))
      XR=XNFPH(J,1)*(2./2./13.595)*TKEV(J)/RHO(J)
      BOLTEX(J)=EXP(-13.427/TKEV(J))*XR
   15 EXLIM(J)=EXP(-13.595/TKEV(J))*XR
   20 DO 21 N=1,8
C   21 CONT(N)=COULX(N,FREQ,1.D0)
   21 CONT(N)=XKARSAS(FREQ,1.D0,N,N)
      FREQ3=FREQ**3
      CFREE=3.6919E8/FREQ3
      C=2.815E29/FREQ3
      DO 32 J=1,NRHOX
      EX=BOLTEX(J)
      IF(FREQ.LT.4.05933E13)EX=EXLIM(J)/EHVKT(J)
      H=(CONT(7)*BOLT(J,7)+CONT(8)*BOLT(J,8)+(EX-EXLIM(J))*C+
     1COULFF(J,1)*FREET(J)*CFREE)*STIM(J)
      S=H*BNU(J)
      DO 31 N=1,6
      H=H+CONT(N)*BOLT(J,N)*(1.-EHVKT(J)/BHYD(J,N))
   31 S=S+CONT(N)*BOLT(J,N)*BNU(J)*STIM(J)/BHYD(J,N)
      AHYD(J)=H
   32 SHYD(J)=S/H
      RETURN
      END
      FUNCTION XKARSAS(FREQ,ZEFF2,N,L)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      DIMENSION FREQ1(29),FREQ2(29),FREQ3(29),FREQ4(29),FREQ5(29)
      DIMENSION FREQ6(29),FREQ7(29),FREQ8(29),FREQ9(29),FREQ10(29)
      DIMENSION FREQ11(29),FREQ12(29),FREQ13(29),FREQ14(29),FREQ15(29)
      DIMENSION X1(29),X2(29),X3(29),X4(29),X5(29)
      DIMENSION X6(29),X7(29),X8(29),X9(29),X10(29)
      DIMENSION X11(29),X12(29),X13(29),X14(29),X15(29)
      DIMENSION X1s(29),X2s(29),X3s(29),X4s(29),X5s(29),X6s(29)
      DIMENSION X2p(29),X3p(29),X4p(29),X5p(29),X6p(29)
      DIMENSION X3d(29),X4d(29),X5d(29),X6d(29)
      DIMENSION X4f(29),X5f(29),X6f(29),X5g(29),X6g(29),X6h(29)
      DIMENSION FREQN(29,15),XN(29,15),XL(29,6,6),FREQN15(29)
      DIMENSION EKARSAS(29)
      EQUIVALENCE (XN(1,1),X1(1)),(FREQN(1,1),FREQ1(1))
      EQUIVALENCE (XN(1,2),X2(1)),(FREQN(1,2),FREQ2(1))
      EQUIVALENCE (XN(1,3),X3(1)),(FREQN(1,3),FREQ3(1))
      EQUIVALENCE (XN(1,4),X4(1)),(FREQN(1,4),FREQ4(1))
      EQUIVALENCE (XN(1,5),X5(1)),(FREQN(1,5),FREQ5(1))
      EQUIVALENCE (XN(1,6),X6(1)),(FREQN(1,6),FREQ6(1))
      EQUIVALENCE (XN(1,7),X7(1)),(FREQN(1,7),FREQ7(1))
      EQUIVALENCE (XN(1,8),X8(1)),(FREQN(1,8),FREQ8(1))
      EQUIVALENCE (XN(1,9),X9(1)),(FREQN(1,9),FREQ9(1))
      EQUIVALENCE (XN(1,10),X10(1)),(FREQN(1,10),FREQ10(1))
      EQUIVALENCE (XN(1,11),X11(1)),(FREQN(1,11),FREQ11(1))
      EQUIVALENCE (XN(1,12),X12(1)),(FREQN(1,12),FREQ12(1))
      EQUIVALENCE (XN(1,13),X13(1)),(FREQN(1,13),FREQ13(1))
      EQUIVALENCE (XN(1,14),X14(1)),(FREQN(1,14),FREQ14(1))
      EQUIVALENCE (XN(1,15),X15(1)),(FREQN(1,15),FREQ15(1))
      EQUIVALENCE (XL(1,1,1),X1s(1)),(XL(1,1,2),X2s(1))
      EQUIVALENCE (XL(1,1,3),X3s(1)),(XL(1,1,4),X4s(1))
      EQUIVALENCE (XL(1,1,5),X5s(1)),(XL(1,1,6),X6s(1))
      EQUIVALENCE (XL(1,2,2),X2p(1)),(XL(1,2,3),X3p(1))
      EQUIVALENCE (XL(1,2,4),X4p(1)),(XL(1,2,5),X5p(1))
      EQUIVALENCE (XL(1,2,6),X6p(1))
      EQUIVALENCE (XL(1,3,3),X3d(1)),(XL(1,3,4),X4d(1))
      EQUIVALENCE (XL(1,3,5),X5d(1)),(XL(1,3,6),X6d(1))
      EQUIVALENCE (XL(1,4,4),X4f(1)),(XL(1,4,5),X5f(1))
      EQUIVALENCE (XL(1,4,6),X6f(1))
      EQUIVALENCE (XL(1,5,5),X5g(1)),(XL(1,5,6),X6g(1))
      EQUIVALENCE (XL(1,6,6),X6h(1))
      DATA FREQ1/
     1    19.516982,   19.164810,   18.915052,   18.563043,   18.120083,
     2    17.828904,   17.521260,   17.174377,   16.931912,   16.747387,
     3    16.600083,   16.377277,   16.215909,   16.094200,   15.999955,
     4    15.925518,   15.866216,   15.817969,   15.745954,   15.676626,
     5    15.613849,   15.562692,   15.533972,   15.525713,   15.521260,
     6    15.518864,   15.518023,   15.517421,   15.516939/
      DATA X1/
     1   -30.274422,  -29.048572,  -28.181067,  -26.962272,  -25.437868,
     2   -24.444170,  -23.404269,  -22.248421,  -21.454163,  -20.858944,
     3   -20.390346,  -19.694283,  -19.200905,  -18.835387,  -18.556686,
     4   -18.339364,  -18.168213,  -18.030238,  -17.826632,  -17.633456,
     5   -17.461067,  -17.322353,  -17.245241,  -17.223162,  -17.211266,
     6   -17.204840,  -17.202587,  -17.200999,  -17.199715/
      DATA X1s/
     1   -30.274422,  -29.048572,  -28.181067,  -26.962272,  -25.437868,
     2   -24.444170,  -23.404269,  -22.248421,  -21.454163,  -20.858944,
     3   -20.390346,  -19.694283,  -19.200905,  -18.835387,  -18.556686,
     4   -18.339364,  -18.168213,  -18.030238,  -17.826632,  -17.633456,
     5   -17.461067,  -17.322353,  -17.245241,  -17.223162,  -17.211266,
     6   -17.204840,  -17.202587,  -17.200999,  -17.199715/
      DATA FREQ2/
     1    19.516949,   19.164737,   18.914922,   18.562750,   18.119270,
     2    17.827313,   17.518023,   17.167149,   16.919200,   16.727792,
     3    16.572317,   16.329852,   16.145327,   15.998094,   15.876964,
     4    15.775097,   15.688665,   15.613849,   15.492095,   15.358548,
     5    15.215909,   15.074566,   14.979337,   14.948961,   14.931912,
     6    14.922531,   14.919200,   14.916804,   14.914879/
      DATA X2/
     1   -31.779474,  -30.553459,  -29.685827,  -28.466543,  -26.940432,
     2   -25.943993,  -24.898608,  -23.729491,  -22.917021,  -22.298979,
     3   -21.803393,  -21.042629,  -20.473370,  -20.025469,  -19.660029,
     4   -19.355246,  -19.098003,  -18.876442,  -18.517855,  -18.127425,
     5   -17.714170,  -17.308930,  -17.038908,  -16.953361,  -16.905447,
     6   -16.879127,  -16.869826,  -16.863085,  -16.857754/
      DATA X2s/
     1   -31.177414,  -29.951530,  -29.083850,  -27.864712,  -26.339031,
     2   -25.343652,  -24.299685,  -23.134693,  -22.327692,  -21.716473,
     3   -21.228927,  -20.487480,  -19.941059,  -19.517455,  -19.178033,
     4   -18.899376,  -18.668043,  -18.471683,  -18.160149,  -17.830286,
     5   -17.492277,  -17.172499,  -16.965517,  -16.901255,  -16.865263,
     6   -16.845632,  -16.838714,  -16.833696,  -16.829681/
      DATA X2p/
     1   -35.779538,  -34.184208,  -33.083933,  -31.512708,  -29.543604,
     2   -28.256123,  -26.903279,  -25.387738,  -24.333408,  -23.531477,
     3   -22.889415,  -21.907557,  -21.178842,  -20.610306,  -20.152156,
     4   -19.774043,  -19.458248,  -19.189136,  -18.759267,  -18.299831,
     5   -17.823327,  -17.365980,  -17.066362,  -16.972218,  -16.919695,
     6   -16.890892,  -16.880696,  -16.873357,  -16.867478/
      DATA FREQ3/
     1    19.516943,   19.164723,   18.914898,   18.562696,   18.119119,
     2    17.827018,   17.517421,   17.165797,   16.916804,   16.724064,
     3    16.566974,   16.320472,   16.130898,   15.977703,   15.849803,
     4    15.740463,   15.646019,   15.562696,   15.423010,   15.261631,
     5    15.074579,   14.863704,   14.696235,   14.635934,   14.600123,
     6    14.579728,   14.572359,   14.567017,   14.562696/
      DATA X3/
     1   -32.659912,  -31.433874,  -30.566210,  -29.346836,  -27.820290,
     2   -26.823453,  -25.777089,  -24.605440,  -23.789519,  -23.167057,
     3   -22.666147,  -21.891933,  -21.306393,  -20.839041,  -20.451712,
     4   -20.122889,  -19.840361,  -19.591597,  -19.176587,  -18.699419,
     5   -18.149566,  -17.533628,  -17.049033,  -16.875774,  -16.773227,
     6   -16.714935,  -16.693926,  -16.678663,  -16.666369/
      DATA X3s/
     1   -31.705705,  -30.479739,  -29.612265,  -28.392746,  -26.866974,
     2   -25.871133,  -24.826672,  -23.659806,  -22.850344,  -22.235989,
     3   -21.744734,  -20.993964,  -20.435725,  -19.998364,  -19.643303,
     4   -19.347420,  -19.097776,  -18.881962,  -18.529746,  -18.137370,
     5   -17.701228,  -17.231454,  -16.873769,  -16.748412,  -16.674666,
     6   -16.633129,  -16.617776,  -16.606984,  -16.598091/
      DATA X3p/
     1   -36.234105,  -34.655854,  -33.538432,  -31.967064,  -29.997698,
     2   -28.709867,  -27.356451,  -25.839127,  -24.782259,  -23.977343,
     3   -23.331485,  -22.340276,  -21.599900,  -21.017917,  -20.544424,
     4   -20.149344,  -19.815760,  -19.527654,  -19.058410,  -18.538322,
     5   -17.967020,  -17.364676,  -16.918642,  -16.765111,  -16.675798,
     6   -16.625318,  -16.607492,  -16.594210,  -16.583614/
      DATA X3d/
     1   -41.364414,  -39.434006,  -38.066663,  -36.143204,  -33.730242,
     2   -32.150245,  -30.487089,  -28.617809,  -27.311427,  -26.313205,
     3   -25.509946,  -24.270587,  -23.339149,  -22.602299,  -21.924436,
     4   -21.493723,  -21.063954,  -20.691590,  -20.080654,  -19.397357,
     5   -18.637161,  -17.823176,  -17.209853,  -16.996234,  -16.871214,
     6   -16.800539,  -16.775144,  -16.756765,  -16.741919/
      DATA FREQ4/
     1    19.516941,   19.164719,   18.914889,   18.562677,   18.119066,
     2    17.826915,   17.517210,   17.165323,   16.915963,   16.722752,
     3    16.565089,   16.317140,   16.125732,   15.970333,   15.839881,
     4    15.727658,   15.630046,   15.543267,   15.395977,   15.221861,
     5    15.011789,   14.756488,   14.527662,   14.435545,   14.377277,
     6    14.342650,   14.329852,   14.320471,   14.312819/
      DATA X4/
     1   -33.284599,  -32.058554,  -31.190879,  -29.971473,  -28.444826,
     2   -27.447836,  -26.401066,  -25.228582,  -24.411413,  -23.787317,
     3   -23.284581,  -22.505775,  -21.914353,  -21.439606,  -21.044235,
     4   -20.705972,  -20.413135,  -20.153596,  -19.714525,  -19.197426,
     5   -18.576241,  -17.824248,  -17.155428,  -16.887819,  -16.719154,
     6   -16.619216,  -16.582315,  -16.555295,  -16.533276/
      DATA X4s/
     1   -32.080641,  -30.854674,  -29.986801,  -28.767697,  -27.241693,
     2   -26.245685,  -25.200974,  -24.033538,  -23.223063,  -22.607845,
     3   -22.115266,  -21.360872,  -20.798453,  -20.355878,  -19.995174,
     4   -19.692644,  -19.435600,  -19.211713,  -18.841933,  -18.420428,
     5   -17.932110,  -17.363567,  -16.873130,  -16.680219,  -16.559751,
     6   -16.488746,  -16.462241,  -16.443053,  -16.427763/
      DATA X4p/
     1   -36.585694,  -35.007703,  -33.890016,  -32.318668,  -30.349350,
     2   -29.061334,  -27.707618,  -26.189677,  -25.132040,  -24.325956,
     3   -23.678826,  -22.684226,  -21.939671,  -21.352566,  -20.873369,
     4   -20.471723,  -20.130813,  -19.835172,  -19.348733,  -18.800381,
     5   -18.178384,  -17.480038,  -16.904760,  -16.685329,  -16.550262,
     6   -16.471169,  -16.442151,  -16.420831,  -16.403759/
      DATA X4d/
     1   -41.585694,  -39.655304,  -38.288039,  -36.364454,  -33.951410,
     2   -32.371226,  -30.707789,  -28.837992,  -27.530994,  -26.531796,
     3   -25.727043,  -24.484484,  -23.549206,  -22.807462,  -22.198909,
     4   -21.686891,  -21.250382,  -20.870478,  -20.243060,  -19.532238,
     5   -18.722925,  -17.815346,  -17.075994,  -16.798160,  -16.628568,
     6   -16.529588,  -16.493472,  -16.467238,  -16.445815/
      DATA X4f/
     1   -47.062815,  -44.780358,  -43.163100,  -40.887314,  -38.030685,
     2   -36.158301,  -34.185235,  -31.963719,  -30.407089,  -29.214529,
     3   -28.252197,  -26.761810,  -25.634821,  -24.737662,  -23.998757,
     4   -23.374580,  -22.839980,  -22.373323,  -21.598611,  -20.713453,
     5   -19.693804,  -18.530997,  -17.563112,  -17.193424,  -16.965517,
     6   -16.832288,  -16.783370,  -16.747717,  -16.718672/
      DATA FREQ5/
     1    19.516940,   19.164717,   18.914886,   18.562668,   18.119042,
     2    17.826867,   17.517112,   17.165103,   16.915573,   16.722143,
     3    16.564213,   16.315589,   16.123320,   15.966880,   15.835211,
     4    15.721601,   15.622449,   15.533972,   15.382871,   15.202143,
     5    14.979337,   14.696203,   14.420029,   14.298047,   14.215909,
     6    14.164752,   14.145327,   14.130897,   14.118999/
      DATA X5/
     1   -33.769146,  -32.543097,  -31.675417,  -30.455996,  -28.929303,
     2   -27.932243,  -26.885239,  -25.712408,  -24.894628,  -24.269941,
     3   -23.766226,  -22.985245,  -22.390846,  -21.912586,  -21.513577,
     4   -21.170761,  -20.873304,  -20.608270,  -20.156957,  -19.619181,
     5   -18.958075,  -18.121143,  -17.308727,  -16.951892,  -16.712503,
     6   -16.563827,  -16.507488,  -16.465627,  -16.431184/
      DATA X5s/
     1   -32.371142,  -31.145245,  -30.277611,  -29.058332,  -27.532386,
     2   -26.536299,  -25.491539,  -24.323724,  -23.512880,  -22.897091,
     3   -22.403960,  -21.648140,  -21.083702,  -20.638728,  -20.275002,
     4   -19.969127,  -19.708598,  -19.480857,  -19.102318,  -18.665521,
     5   -18.148008,  -17.516456,  -16.921283,  -16.663742,  -16.492247,
     6   -16.386117,  -16.345903,  -16.316173,  -16.291778/
      DATA X5p/
     1   -36.866137,  -35.287883,  -34.170413,  -32.599199,  -30.629663,
     2   -29.341564,  -27.987755,  -26.469536,  -25.411517,  -24.604882,
     3   -23.957191,  -22.961135,  -22.214481,  -21.625034,  -21.142933,
     4   -20.738297,  -20.393941,  -20.094254,  -19.599261,  -19.036165,
     5   -18.385686,  -17.626125,  -16.948476,  -16.665818,  -16.480643,
     6   -16.367024,  -16.324502,  -16.292865,  -16.266917/
      DATA X5d/
     1   -41.816885,  -39.886598,  -38.519116,  -36.595706,  -34.182651,
     2   -32.602365,  -30.938792,  -29.068803,  -27.761491,  -26.761551,
     3   -25.956256,  -24.712472,  -23.775049,  -23.031086,  -22.420027,
     4   -21.905038,  -21.464940,  -21.081321,  -20.445565,  -19.720393,
     5   -18.883701,  -17.916497,  -17.077571,  -16.738117,  -16.519620,
     6   -16.387033,  -16.337715,  -16.301341,  -16.271391/
      DATA X5f/
     1   -47.128880,  -44.846322,  -43.229046,  -40.953347,  -38.096716,
     2   -36.224291,  -34.250943,  -32.029199,  -30.472360,  -29.279276,
     3   -28.316408,  -26.824527,  -25.695751,  -24.796176,  -24.054627,
     4   -23.427631,  -22.889877,  -22.419401,  -21.636478,  -20.737351,
     5   -19.690904,  -18.469715,  -17.404053,  -16.973748,  -16.697901,
     6   -16.531879,  -16.469784,  -16.423961,  -16.386588/
      DATA X5g/
     1   -52.894711,  -50.260082,  -48.392958,  -45.765034,  -42.464679,
     2   -40.300146,  -38.017153,  -35.443424,  -33.636754,  -32.250427,
     3   -31.129593,  -29.389103,  -28.068001,  -27.012118,  -26.138711,
     4   -25.398332,  -24.761042,  -24.202462,  -23.268415,  -22.188504,
     5   -20.919298,  -19.415147,  -18.073478,  -17.521544,  -17.163795,
     6   -16.946562,  -16.865194,  -16.805098,  -16.755865/
      DATA FREQ6/
     1    19.516940,   19.164715,   18.914883,   18.562663,   18.119029,
     2    17.826841,   17.517059,   17.164984,   16.915361,   16.721812,
     3    16.563737,   16.314744,   16.122004,   15.964992,   15.832652,
     4    15.718275,   15.618265,   15.528838,   15.375583,   15.191044,
     5    14.960636,   14.659571,   14.348026,   14.199875,   14.094175,
     6    14.025088,   13.998063,   13.977668,   13.960636/
      DATA X6/
     1   -34.165051,  -32.939000,  -32.071317,  -30.851888,  -29.325169,
     2   -28.328071,  -27.280986,  -26.107892,  -25.289843,  -24.664705,
     3   -24.160564,  -23.378190,  -22.782394,  -22.302428,  -21.901012,
     4   -21.555896,  -21.255472,  -20.987585,  -20.529803,  -19.979782,
     5   -19.295022,  -18.402541,  -17.482757,  -17.047424,  -16.737838,
     6   -16.536084,  -16.457331,  -16.397931,  -16.348398/
      DATA X6s/
     1   -32.608820,  -31.382756,  -30.515126,  -29.295866,  -27.769793,
     2   -26.773814,  -25.728819,  -24.560932,  -23.750086,  -23.133811,
     3   -22.640288,  -21.883631,  -21.318035,  -20.871913,  -20.506426,
     4   -20.198858,  -19.936428,  -19.706400,  -19.322760,  -18.877373,
     5   -18.342274,  -17.669792,  -16.995256,  -16.680122,  -16.457336,
     6   -16.312694,  -16.256489,  -16.214113,  -16.178612/
      DATA X6p/
     1   -37.098169,  -35.519950,  -34.402525,  -32.831070,  -30.861699,
     2   -29.573885,  -28.219694,  -26.701459,  -25.643044,  -24.836230,
     3   -24.188105,  -23.191275,  -22.443490,  -21.852666,  -21.369042,
     4   -20.962634,  -20.616374,  -20.314553,  -19.814673,  -19.242970,
     5   -18.575541,  -17.775947,  -17.020568,  -16.681448,  -16.445735,
     6   -16.294606,  -16.235710,  -16.191866,  -16.154983/
      DATA X6d/
     1   -42.024362,  -40.094064,  -38.726686,  -36.803137,  -34.390124,
     2   -32.809866,  -31.146180,  -29.276029,  -27.968300,  -26.968324,
     3   -26.162701,  -24.918051,  -23.979662,  -23.234506,  -22.621799,
     4   -22.105162,  -21.663212,  -21.277514,  -20.637026,  -19.903484,
     5   -19.050185,  -18.044511,  -17.129904,  -16.735338,  -16.467566,
     6   -16.298269,  -16.232977,  -16.184230,  -16.143922/
      DATA X6f/
     1   -47.267412,  -44.984913,  -43.367636,  -41.091842,  -38.235239,
     2   -36.362731,  -34.389528,  -32.167518,  -30.610443,  -29.417223,
     3   -28.453971,  -26.961283,  -25.831491,  -24.930907,  -24.187725,
     4   -23.559075,  -23.019383,  -22.547066,  -21.759545,  -20.852145,
     5   -19.789541,  -18.530522,  -17.390884,  -16.906727,  -16.582667,
     6   -16.380139,  -16.302886,  -16.245236,  -16.197380/
      DATA X6g/
     1   -52.845039,  -50.210247,  -48.343069,  -45.715131,  -42.414728,
     2   -40.250164,  -37.967149,  -35.393156,  -33.586496,  -32.199833,
     3   -31.078643,  -29.337458,  -27.969702,  -26.958401,  -26.083595,
     4   -25.341555,  -24.702345,  -24.141808,  -23.203287,  -22.115356,
     5   -20.830007,  -19.288694,  -17.874057,  -17.268729,  -16.863465,
     6   -16.610369,  -16.513883,  -16.442010,  -16.382570/
      DATA X6h/
     1   -58.850334,  -55.863542,  -53.746437,  -50.766409,  -47.022317,
     2   -44.565391,  -41.972509,  -39.046704,  -36.990356,  -35.410261,
     3   -34.131188,  -32.140740,  -30.626018,  -29.411767,  -28.404701,
     4   -27.548439,  -26.808936,  -26.159088,  -25.067378,  -23.795088,
     5   -22.279431,  -20.436907,  -18.711058,  -17.957760,  -17.446882,
     6   -17.124901,  -17.001376,  -16.909196,  -16.832806/
      DATA FREQ7/
     1    19.516939,   19.164715,   18.914882,   18.562661,   18.119021,
     2    17.826825,   17.517027,   17.164912,   16.915233,   16.721612,
     3    16.563450,   16.314234,   16.121209,   15.963850,   15.831103,
     4    15.716257,   15.615723,   15.525712,   15.371128,   15.184212,
     5    14.948958,   14.635891,   14.298034,   14.127792,   13.999929,
     6    13.912303,   13.876929,   13.849764,   13.826742/
      DATA X7/
     1   -34.499784,  -33.273731,  -32.406047,  -31.186614,  -29.659879,
     2   -28.662758,  -27.615624,  -26.442410,  -25.624138,  -24.998790,
     3   -24.494343,  -23.711394,  -23.114332,  -22.633333,  -22.230699,
     4   -21.884181,  -21.582185,  -21.312152,  -20.849982,  -20.292819,
     5   -19.593097,  -18.663739,  -17.663648,  -17.161477,  -16.785637,
     6   -16.528798,  -16.425342,  -16.345983,  -16.278790/
      DATA FREQ8/
     1    19.516939,   19.164714,   18.914881,   18.562659,   18.119016,
     2    17.826815,   17.517006,   17.164865,   16.915150,   16.721482,
     3    16.563263,   16.313903,   16.120692,   15.963107,   15.830094,
     4    15.714942,   15.614066,   15.523672,   15.368212,   15.179720,
     5    14.941207,   14.619801,   14.262209,   14.073663,   13.925602,
     6    13.819464,   13.775217,   13.740590,   13.710759/
      DATA X8/
     1   -34.789743,  -33.563690,  -32.696004,  -31.476568,  -29.949823,
     2   -28.952576,  -27.905521,  -26.732230,  -25.913849,  -25.288312,
     3   -24.783697,  -24.000359,  -23.402741,  -22.921064,  -22.517235,
     4   -22.169801,  -21.866776,  -21.595595,  -21.130798,  -20.568503,
     5   -19.858590,  -18.903358,  -17.843146,  -17.285660,  -16.849210,
     6   -16.537235,  -16.407454,  -16.306014,  -16.218699/
      DATA FREQ9/
     1    19.516939,   19.164714,   18.914881,   18.562657,   18.119012,
     2    17.826808,   17.516992,   17.164833,   16.915093,   16.721394,
     3    16.563135,   16.313676,   16.120337,   15.962597,   15.829401,
     4    15.714039,   15.612925,   15.522267,   15.366202,   15.176613,
     5    14.935812,   14.608414,   14.235819,   14.032225,   13.866132,
     6    13.741981,   13.688539,   13.645876,   13.608454/
      DATA X9/
     1   -35.045505,  -33.819451,  -32.951765,  -31.732326,  -30.205575,
     2   -29.208318,  -28.161241,  -26.987832,  -26.169441,  -25.543807,
     3   -25.039029,  -24.255440,  -23.657439,  -23.175297,  -22.770919,
     4   -22.422852,  -22.118723,  -21.846749,  -21.380133,  -20.814545,
     5   -20.097359,  -19.123314,  -18.017622,  -17.414518,  -16.923750,
     6   -16.558183,  -16.401026,  -16.275647,  -16.165911/
      DATA FREQ10/
     1    19.516939,   19.164714,   18.914880,   18.562657,   18.119009,
     2    17.826803,   17.516982,   17.164810,   16.915052,   16.721330,
     3    16.563043,   16.313513,   16.120083,   15.962231,   15.828904,
     4    15.713391,   15.612108,   15.521260,   15.364758,   15.174377,
     5    14.931912,   14.600083,   14.215909,   13.999955,   13.817969,
     6    13.676626,   13.613849,   13.562692,   13.516939/
      DATA X10/
     1   -35.274293,  -34.048238,  -33.180551,  -31.961111,  -30.434355,
     2   -29.437090,  -28.389998,  -27.216550,  -26.398051,  -25.772354,
     3   -25.267495,  -24.483312,  -23.885464,  -23.402587,  -22.997820,
     4   -22.649302,  -22.344664,  -22.072514,  -21.604193,  -21.035827,
     5   -20.313639,  -19.326284,  -18.184568,  -17.544349,  -17.005732,
     6   -16.588554,  -16.403642,  -16.253350,  -16.118795/
      DATA FREQ11/
     1    19.516939,   19.164713,   18.914880,   18.562656,   18.119008,
     2    17.826799,   17.516974,   17.164793,   16.915022,   16.721283,
     3    16.562976,   16.313392,   16.119895,   15.961961,   15.828537,
     4    15.712911,   15.611502,   15.520513,   15.363687,   15.172715,
     5    14.929003,   14.593814,   14.200566,   13.974434,   13.778545,
     6    13.621032,   13.548931,   13.488931,   13.434153/
      DATA X11/
     1   -35.481256,  -34.255201,  -33.387514,  -32.168073,  -30.641313,
     2   -29.644043,  -28.596939,  -27.423463,  -26.604924,  -25.979176,
     3   -25.474255,  -24.689915,  -24.091864,  -23.608739,  -23.203681,
     4   -22.854826,  -22.549810,  -22.276842,  -21.807547,  -21.237407,
     5   -20.511071,  -19.513620,  -18.342150,  -17.667949,  -17.093121,
     6   -16.627232,  -16.414294,  -16.237373,  -16.076228/
      DATA FREQ12/
     1    19.516939,   19.164713,   18.914880,   18.562655,   18.119006,
     2    17.826796,   17.516969,   17.164780,   16.914999,   16.721247,
     3    16.562924,   16.313301,   16.119752,   15.961755,   15.828257,
     4    15.712546,   15.611041,   15.519944,   15.362870,   15.171447,
     5    14.926778,   14.588984,   14.188523,   13.953966,   13.745966,
     6    13.573403,   13.492115,   13.423028,   13.358576/
      DATA X12/
     1   -35.670198,  -34.444144,  -33.576456,  -32.357014,  -30.830251,
     2   -29.832977,  -28.785864,  -27.612367,  -26.793798,  -26.168012,
     3   -25.663043,  -24.878583,  -24.280378,  -23.797065,  -23.391784,
     4   -23.042673,  -22.737368,  -22.464078,  -21.994040,  -21.422148,
     5   -20.692935,  -19.687256,  -18.494545,  -17.795069,  -17.183891,
     6   -16.673156,  -16.431990,  -16.227310,  -16.037494/
      DATA FREQ13/
     1    19.516939,   19.164713,   18.914880,   18.562655,   18.119005,
     2    17.826794,   17.516964,   17.164770,   16.914981,   16.721219,
     3    16.562884,   16.313230,   16.119641,   15.961595,   15.828039,
     4    15.712262,   15.610681,   15.519501,   15.362233,   15.170457,
     5    14.925038,   14.585188,   14.178914,   13.937343,   13.718804,
     6    13.532347,   13.442104,   13.363780,   13.289052/
      DATA X13/
     1   -35.844009,  -34.617954,  -33.750266,  -32.530823,  -31.004058,
     2   -30.006781,  -28.959661,  -27.786148,  -26.967555,  -26.341739,
     3   -25.836687,  -25.051753,  -24.453445,  -23.969994,  -23.564544,
     4   -23.215236,  -22.909707,  -22.636559,  -22.165546,  -21.592592,
     5   -20.861125,  -19.849269,  -18.639111,  -17.918166,  -17.276217,
     6   -16.722786,  -16.454970,  -16.222218,  -16.001878/
      DATA FREQ14/
     1    19.516939,   19.164713,   18.914879,   18.562655,   18.119004,
     2    17.826792,   17.516961,   17.164762,   16.914967,   16.721197,
     3    16.562852,   16.313173,   16.119552,   15.961468,   15.827866,
     4    15.712036,   15.610396,   15.519149,   15.361728,   15.169670,
     5    14.923652,   14.582152,   14.171135,   13.923684,   13.695974,
     6    13.496762,   13.397869,   13.310243,   13.224682/
      DATA X14/
     1   -36.004932,  -34.778877,  -33.911189,  -32.691746,  -31.164979,
     2   -30.167699,  -29.120574,  -27.947047,  -27.128436,  -26.502596,
     3   -25.997515,  -25.212506,  -24.614103,  -24.130536,  -23.724949,
     4   -23.375482,  -23.069774,  -22.796032,  -22.324557,  -21.750758,
     5   -21.017491,  -20.000677,  -18.776282,  -18.037692,  -17.368650,
     6   -16.776515,  -16.482568,  -16.221551,  -15.968930/
      DATA FREQ15/
     1    19.516939,   19.164713,   18.914879,   18.562654,   18.119003,
     2    17.826791,   17.516958,   17.164756,   16.914956,   16.721179,
     3    16.562826,   16.313127,   16.119481,   15.961365,   15.827726,
     4    15.711854,   15.610166,   15.518864,   15.361319,   15.169034,
     5    14.922532,   14.579688,   14.164756,   13.912343,   13.676639,
     6    13.465764,   13.358576,   13.261657,   13.164756/
      DATA X15/
     1   -36.154748,  -34.928693,  -34.061005,  -32.841561,  -31.314793,
     2   -30.317511,  -29.270382,  -28.096844,  -27.278218,  -26.652358,
     3   -26.147254,  -25.362186,  -24.763705,  -24.280044,  -23.874346,
     4   -23.524751,  -23.218899,  -22.944996,  -22.473148,  -21.898667,
     5   -21.163944,  -20.143099,  -18.906962,  -18.152646,  -17.460462,
     6   -16.832855,  -16.513888,  -16.224591,  -15.938340/
       DATA EKARSAS/10000.,4444.,2500.,1111.,400.,204.1,100.,44.44,
     1 25.,16.,11.11,6.25,4.,2.778,2.041,1.562,1.235,1.,0.6944,0.4444,
     2 0.25,0.1111,0.04,0.02041,0.01,0.004444,0.0025,0.001111,0./
      FREQLG=LOG10(FREQ/ZEFF2)
      XKARSAS=0.
      IF(L.GE.N.OR.N.GT.6)THEN
      IF(N.GT.15)GO TO 5
      IF(FREQLG.LT.FREQN(29,N))RETURN
      DO 1 I=2,29
      IF(FREQLG.GT.FREQN(I,N))GO TO 2
    1 CONTINUE
    2 X=(FREQLG-FREQN(I,N))/(FREQN(I-1,N)-FREQN(I,N))*
     1(XN(I-1,N)-XN(I,N))+XN(I,N)
      XKARSAS=EXP(X*2.30258509299405E0)/ZEFF2
      RETURN
      ENDIF
      IF(FREQLG.LT.FREQN(29,N))RETURN
      DO 3 I=2,29
      IF(FREQLG.GT.FREQN(I,N))GO TO 4
    3 CONTINUE
    4 X=(FREQLG-FREQN(I,N))/(FREQN(I-1,N)-FREQN(I,N))*
     1(XL(I-1,L+1,N)-XL(I,L+1,N))+XL(I,L+1,N)
      XKARSAS=EXP(X*2.30258509299405E0)/ZEFF2
      RETURN
    5 FREQN15(29)=LOG10(109677.576*2.99792458E10/N**2)
      IF(FREQLG.LT.FREQN15(29))RETURN
      DO 6 I=2,28
      FREQN15(I)=LOG10((EKARSAS(I)+1./N**2)*109677.576*2.99792458E10)
      IF(FREQLG.GT.FREQN15(I))GO TO 7
    6 CONTINUE
      I=29
    7 X=(FREQLG-FREQN15(I))/(FREQN15(I-1)-FREQN15(I))*
     1(XN(I-1,15)-XN(I,15))+XN(I,15)
      XKARSAS=EXP(X*2.30258509299405E0)/ZEFF2
      RETURN
      END
      FUNCTION COULX(N,FREQ,Z)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      DIMENSION A(6),B(6),C(6)
      DATA A/.9916,1.105,1.101,1.101,1.102,1.0986/
      DATA B/2.719E13,-2.375E14,-9.863E13,-5.765E13,-3.909E13,-2.704E13/
      DATA C/-2.268E30,4.077E28,1.035E28,4.593E27,2.371E27,1.229E27/
      IF(FREQ.LT.Z*Z*3.28805E15/DFLOAT(N*N))GO TO 1
      COULX=2.815E29/FREQ/FREQ/FREQ/DFLOAT(N**5)*Z**4
      IF(N.GT.6)RETURN
      IF(N.EQ.1)THEN
      COULX=COULX*COULBF1S(FREQ,Z)
      RETURN
      ENDIF
      COULX=COULX*(A(N)+(B(N)+C(N)*(Z*Z/FREQ))*(Z*Z/FREQ))
      RETURN
    1 COULX=0.
      RETURN
      END
      FUNCTION COULBF1S(FREQ,Z)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      DIMENSION GAUNT1S(151)
      DATA GAUNT1S/
     1 0.7973,0.8094,0.8212,0.8328,0.8439,0.8548,0.8653,0.8754,0.8852,
     2 0.8946,0.9035,0.9120,0.9201,0.9278,0.9351,0.9420,0.9484,0.9544,
     3 0.9601,0.9653,0.9702,0.9745,0.9785,0.9820,0.9852,0.9879,0.9903,
     4 0.9922,0.9938,0.9949,0.9957,0.9960,0.9960,0.9957,0.9949,0.9938,
     5 0.9923,0.9905,0.9884,0.9859,0.9832,0.9801,0.9767,0.9730,0.9688,
     6 0.9645,0.9598,0.9550,0.9499,0.9445,0.9389,0.9330,0.9269,0.9206,
     7 0.9140,0.9071,0.9001,0.8930,0.8856,0.8781,0.8705,0.8627,0.8546,
     8 0.8464,0.8381,0.8298,0.8213,0.8128,0.8042,0.7954,0.7866,0.7777,
     9 0.7685,0.7593,0.7502,0.7410,0.7318,0.7226,0.7134,0.7042,0.6951,
     A 0.6859,0.6767,0.6675,0.6584,0.6492,0.6401,0.6310,0.6219,0.6129,
     1 0.6039,0.5948,0.5859,0.5769,0.5680,0.5590,0.5502,0.5413,0.5324,
     2 0.5236,0.5148,0.5063,0.4979,0.4896,0.4814,0.4733,0.4652,0.4572,
     3 0.4493,0.4415,0.4337,0.4261,0.4185,0.4110,0.4035,0.3962,0.3889,
     4 0.3818,0.3749,0.3680,0.3611,0.3544,0.3478,0.3413,0.3348,0.3285,
     5 0.3222,0.3160,0.3099,0.3039,0.2980,0.2923,0.2866,0.2810,0.2755,
     6 0.2701,0.2648,0.2595,0.2544,0.2493,0.2443,0.2394,0.2345,0.2298,
     7 0.2251,0.2205,0.2160,0.2115,0.2072,0.2029,0.1987/
      COULBF1S=0.
      IF(FREQ/Z**2.LT.3.28805E15)RETURN
      ELOG=LOG10(FREQ/Z**2/3.28805E15)
      I=ELOG/.02
      I=MAX(MIN(I+1,150),1)
      COULBF1S=GAUNT1S(I)+
     1(GAUNT1S(I+1)-GAUNT1S(I))/.02*(ELOG-(I-1)*.02)
      RETURN
      END
      FUNCTION COULFF(J,NZ)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      DIMENSION Z4LOG(6),A(11,12)
      DATA Z4LOG/0.,1.20412,1.90849,2.40824,2.79588,3.11261/
      DATA A/
     15.53,5.49,5.46,5.43,5.40,5.25,5.00,4.69,4.48,4.16,3.85,
     24.91,4.87,4.84,4.80,4.77,4.63,4.40,4.13,3.87,3.52,3.27,
     34.29,4.25,4.22,4.18,4.15,4.02,3.80,3.57,3.27,2.98,2.70,
     43.64,3.61,3.59,3.56,3.54,3.41,3.22,2.97,2.70,2.45,2.20,
     53.00,2.98,2.97,2.95,2.94,2.81,2.65,2.44,2.21,2.01,1.81,
     62.41,2.41,2.41,2.41,2.41,2.32,2.19,2.02,1.84,1.67,1.50,
     71.87,1.89,1.91,1.93,1.95,1.90,1.80,1.68,1.52,1.41,1.30,
     81.33,1.39,1.44,1.49,1.55,1.56,1.51,1.42,1.33,1.25,1.17,
     90.90,0.95,1.00,1.08,1.17,1.30,1.32,1.30,1.20,1.15,1.11,
     A0.55,0.58,0.62,0.70,0.85,1.01,1.15,1.18,1.15,1.11,1.08,
     B0.33,0.36,0.39,0.46,0.59,0.76,0.97,1.09,1.13,1.10,1.08,
     C0.19,0.21,0.24,0.28,0.38,0.53,0.76,0.96,1.08,1.09,1.09/
C     ERROR CORRECTED 13APR88
C     A0.45,0.48,0.52,0.60,0.75,0.91,1.15,1.18,1.15,1.11,1.08,
C
C     GAMLOG=DLOG10(158000*Z*Z/T)*2
      GAMLOG=10.39638-TLOG(J)/1.15129+Z4LOG(NZ)
      IGAM=MAX0(MIN0( INT(GAMLOG+7.),10),1)
C     HVKTLG=DLOG10(HVKT)*2
      HVKTLG=(FREQLG-TLOG(J))/1.15129-20.63764
      IHVKT=MAX0(MIN0( INT(HVKTLG+9.),11),1)
      P=GAMLOG-DFLOAT(IGAM-7)
      Q=HVKTLG-DFLOAT(IHVKT-9)
      COULFF=(1.-P)*((1.-Q)*A(IGAM,IHVKT)+Q*A(IGAM,IHVKT+1))+
     1P*((1.-Q)*A(IGAM+1,IHVKT)+Q*A(IGAM+1,IHVKT+1))
      RETURN
      END
      SUBROUTINE H2PLOP
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /DEPART/BHYD(kw,6),BMIN(kw),NLTEON
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /IONS/XNFPH(kw,2),XNFPHE(kw,3),XNFH(kw,2),XNFHE(kw,3)
      COMMON /OPS/D1(kw),AH2P(kw),D2(kw,23)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      IF(FREQ.GT.3.28805E15)RETURN
      FR=-3.0233E3+(3.7797E2+(-1.82496E1+(3.9207E-1-3.1672E-3*FREQLG)*
     1FREQLG)*FREQLG)*FREQLG
      ES=-7.342E-3+(-2.409E-15+(1.028E-30+(-4.230E-46+(1.224E-61-
     1 1.351E-77*FREQ)*FREQ)*FREQ)*FREQ)*FREQ
      DO 10 J=1,NRHOX
   10 AH2P(J)=EXP(-ES/TKEV(J)+FR)*XNFPH(J,1)*2.*BHYD(J,1)*XNFPH(J,2)/
     1RHO(J)*STIM(J)
      RETURN
      END
      SUBROUTINE HMINOP
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /DEPART/BHYD(kw,6),BMIN(kw),NLTEON
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /IONS/XNFPH(kw,2),XNFPHE(kw,3),XNFH(kw,2),XNFHE(kw,3)
      COMMON /OPS/D1(kw,2),AHMIN(kw),D2(kw,18),SHMIN(kw),D3(kw,3)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      DIMENSION WBF(85),BF(85),FFLOG(22,11),FF(11,22)
      DIMENSION FFBEG(11,11),FFEND(11,11),FFTT(11),WFFLOG(22)
      DIMENSION THETA(kw),FFTHETA(kw),THETAFF(11),WAVEK(22)
      EQUIVALENCE (FF(1,1),FFBEG(1,1)),(FF(1,12),FFEND(1,1))
C     FROM MATHISEN (1984), AFTER WISHART(1979) AND BROAD AND REINHARDT (1976)
      DATA WBF/  18.00,  19.60,  21.40,  23.60,  26.40,  29.80,  34.30,
     1   40.40,  49.10,  62.60, 111.30, 112.10, 112.67, 112.95, 113.05,
     2  113.10, 113.20, 113.23, 113.50, 114.40, 121.00, 139.00, 164.00,
     3  175.00, 200.00, 225.00, 250.00, 275.00, 300.00, 325.00, 350.00,
     4  375.00, 400.00, 425.00, 450.00, 475.00, 500.00, 525.00, 550.00,
     5  575.00, 600.00, 625.00, 650.00, 675.00, 700.00, 725.00, 750.00,
     6  775.00, 800.00, 825.00, 850.00, 875.00, 900.00, 925.00, 950.00,
     7  975.00,1000.00,1025.00,1050.00,1075.00,1100.00,1125.00,1150.00,
     8 1175.00,1200.00,1225.00,1250.00,1275.00,1300.00,1325.00,1350.00,
     9 1375.00,1400.00,1425.00,1450.00,1475.00,1500.00,1525.00,1550.00,
     A 1575.00,1600.00,1610.00,1620.00,1630.00,1643.91/
      DATA BF/   0.067,  0.088,  0.117,  0.155,  0.206,  0.283,  0.414,
     1   0.703,   1.24,   2.33,  11.60,  13.90,  24.30,  66.70,  95.00,
     2   56.60,  20.00,  14.60,   8.50,   7.10,   5.43,   5.91,   7.29,
     3   7.918,  9.453,  11.08,  12.75,  14.46,  16.19,  17.92,  19.65,
     4   21.35,  23.02,  24.65,  26.24,  27.77,  29.23,  30.62,  31.94,
     5   33.17,  34.32,  35.37,  36.32,  37.17,  37.91,  38.54,  39.07,
     6   39.48,  39.77,  39.95,  40.01,  39.95,  39.77,  39.48,  39.06,
     7   38.53,  37.89,  37.13,  36.25,  35.28,  34.19,  33.01,  31.72,
     8   30.34,  28.87,  27.33,  25.71,  24.02,  22.26,  20.46,  18.62,
     9   16.74,  14.85,  12.95,  11.07,  9.211,  7.407,  5.677,  4.052,
     A   2.575,  1.302, 0.8697, 0.4974, 0.1989,    0. /
C    Bell and Berrington J.Phys.B,vol. 20, 801-806,1987.
      DATA WAVEK/.50,.40,.35,.30,.25,.20,.18,.16,.14,.12,.10,.09,.08,
     1 .07,.06,.05,.04,.03,.02,.01,.008,.006/
      DATA THETAFF/
     1  0.5,  0.6, 0.8,  1.0,  1.2,  1.4,  1.6,  1.8,  2.0,  2.8,  3.6/
      DATA FFBEG/
     1.0178,.0222,.0308,.0402,.0498,.0596,.0695,.0795,.0896, .131, .172,   1823
     2.0228,.0280,.0388,.0499,.0614,.0732,.0851,.0972, .110, .160, .211,   2278
     3.0277,.0342,.0476,.0615,.0760,.0908, .105, .121, .136, .199, .262,   2604
     4.0364,.0447,.0616,.0789,.0966, .114, .132, .150, .169, .243, .318,   3038
     5.0520,.0633,.0859, .108, .131, .154, .178, .201, .225, .321, .418,   3645
     6.0791,.0959, .129, .161, .194, .227, .260, .293, .327, .463, .602,   4557
     7.0965, .117, .157, .195, .234, .272, .311, .351, .390, .549, .711,   5063
     8 .121, .146, .195, .241, .288, .334, .381, .428, .475, .667, .861,   5696
     9 .154, .188, .249, .309, .367, .424, .482, .539, .597, .830, 1.07,   6510
     A .208, .250, .332, .409, .484, .557, .630, .702, .774, 1.06, 1.36,   7595
     B .293, .354, .468, .576, .677, .777, .874, .969, 1.06, 1.45, 1.83/   9113
      DATA FFEND/
     1 .358, .432, .572, .702, .825, .943, 1.06, 1.17, 1.28, 1.73, 2.17,  10126
     2 .448, .539, .711, .871, 1.02, 1.16, 1.29, 1.43, 1.57, 2.09, 2.60,  11392
     3 .579, .699, .924, 1.13, 1.33, 1.51, 1.69, 1.86, 2.02, 2.67, 3.31,  13019
     4 .781, .940, 1.24, 1.52, 1.78, 2.02, 2.26, 2.48, 2.69, 3.52, 4.31,  15189
     5 1.11, 1.34, 1.77, 2.17, 2.53, 2.87, 3.20, 3.51, 3.80, 4.92, 5.97,  18227
     6 1.73, 2.08, 2.74, 3.37, 3.90, 4.50, 5.01, 5.50, 5.95, 7.59, 9.06,  22784
     7 3.04, 3.65, 4.80, 5.86, 6.86, 7.79, 8.67, 9.50, 10.3, 13.2, 15.6,  30378
     8 6.79, 8.16, 10.7, 13.1, 15.3, 17.4, 19.4, 21.2, 23.0, 29.5, 35.0,  45567
     9 27.0, 32.4, 42.6, 51.9, 60.7, 68.9, 76.8, 84.2, 91.4, 117., 140.,  91134
     A 42.3, 50.6, 66.4, 80.8, 94.5, 107., 120., 131., 142., 183., 219., 113918
     B 75.1, 90.0, 118., 144., 168., 191., 212., 234., 253., 325., 388./ 151890
      DIMENSION XHMIN(kw)
      DATA ITEMP1,ISTART/0,0/
      IF(ISTART.EQ.0)THEN
      ISTART=1
      DO 2 IWAVE=1,22
C     91.134 NUMBER TAKEN FROM BELL AND BERRINGTON
      WFFLOG(IWAVE)=DLOG(91.134D0/WAVEK(IWAVE))
      DO 2 ITHETA=1,11
    2 FFLOG(IWAVE,ITHETA)=DLOG(FF(ITHETA,IWAVE)*1.E-26)
      ENDIF
      IF(ITEMP.EQ.ITEMP1)GO TO 20
      ITEMP1=ITEMP
      DO 11 J=1,NRHOX
      THETA(J)=5040./T(J)
C     .754209 HOTOP AND LINEBERGER J.PHYS.CHEM.REF.DATA VOL 14,731-752,1985.
   11 XHMIN(J)=EXP(.754209/TKEV(J))/(2.*2.4148E15*T(J)*SQRT(T(J)))*
     1BMIN(J)*BHYD(J,1)*XNFPH(J,1)*XNE(J)
   20 WAVE=2.99792458E17/FREQ
      WAVELOG=DLOG(WAVE)
      DO 21 ITHETA=1,11
      CALL LINTER(WFFLOG,FFLOG(1,ITHETA),22,WAVELOG,FFTLOG,1)
   21 FFTT(ITHETA)=EXP(FFTLOG)/THETAFF(ITHETA)*5040.*1.380658E-16
      HMINBF=0.
      IF(FREQ.GT.1.82365E14)MAXWAVE=MAP1(WBF,BF,85,WAVE,HMINBF,1)
C     MAXT=MAP1(THETAFF,FFTT,11,THETA,FFTHETA,NRHOX)
      DO 31 J=1,NRHOX
      CALL LINTER(THETAFF,FFTT,11,THETA(J),FFTHETA(J),1)
      HMINFF=FFTHETA(J)*XNFPH(J,1)*2.*BHYD(J,1)*XNE(J)/RHO(J)
      H=HMINBF*1.E-18*(1.-EHVKT(J)/BMIN(J))*XHMIN(J)/RHO(J)
      AHMIN(J)=H+HMINFF
   31 SHMIN(J)=(H*BNU(J)*STIM(J)/(BMIN(J)-EHVKT(J))+HMINFF*BNU(J))/
     1AHMIN(J)
      RETURN
      END
      SUBROUTINE LINTER(XOLD,YOLD,NOLD,XNEW,YNEW,NNEW)
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION XOLD(1),YOLD(1),XNEW(1),YNEW(1)
C     XOLD AND XNEW INCREASING
      IOLD=2
      DO 2 INEW=1,NNEW
    1 IF(XNEW(INEW).LT.XOLD(IOLD))GO TO 2
      IF(IOLD.EQ.NOLD)GO TO 2
      IOLD=IOLD+1
      GO TO 1
    2 YNEW(INEW)=YOLD(IOLD-1)+(YOLD(IOLD)-YOLD(IOLD-1))/
     1(XOLD(IOLD)-XOLD(IOLD-1))*(XNEW(INEW)-XOLD(IOLD-1))
      RETURN
      END
      SUBROUTINE HRAYOP
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /DEPART/BHYD(kw,6),BMIN(kw),NLTEON
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /IONS/XNFPH(kw,2),XNFPHE(kw,3),XNFH(kw,2),XNFHE(kw,3)
      COMMON /OPS/D1(kw,3),SIGH(kw),D2(kw,21)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      WAVE=2.997925E18/DMIN1(FREQ,2.463D15)
      WW=WAVE**2
      SIG=(5.799E-13+1.422E-6/WW+2.784/(WW*WW))/(WW*WW)
      DO 2 J=1,NRHOX
    2 SIGH(J)=SIG*XNFPH(J,1)*2.*BHYD(J,1)/RHO(J)
      RETURN
      END
      SUBROUTINE HE1OP
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     REQUIRES FUNCTIONS COULX AND COULFF
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /IONS/XNFPH(kw,2),XNFPHE(kw,3),XNFH(kw,2),XNFHE(kw,3)
      COMMON /OPS/D1(kw,4),AHE1(kw),D2(kw,20)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      DIMENSION CHI(10),BOLT(kw,10),EXLIM(kw),HEFREQ(10),TRANS(10),G(10)
      DIMENSION TRANS1S(10),TRANSN(27),BOLTN(kw,27)
      DIMENSION BOLTEX(kw),FREET(kw),AHE1FREE(kw),AHE1BOUND(kw)
      DATA G/1.,3.,1.,9.,3.,3.,1.,9.,20.,3./
      DATA HEFREQ/5.945209E15,1.152844E15,.9603331E15,.8761076E15,
     1 .8147104E15,.4519048E15,.4030971E15,.3821191E15,.3660215E15,
     2 .3627891E15/
      DATA CHI/0.,19.819,20.615,20.964,21.217,22.718,22.920,23.006,
     1 23.073,23.086/
      DATA ITEMP1/0/
      IF(ITEMP.EQ.ITEMP1)GO TO 10
      ITEMP1=ITEMP
      RYD=109722.273*2.99792458E10
      DO 5 J=1,NRHOX
      DO 4 N=1,10
    4 BOLT(J,N)=EXP(-CHI(N)/TKEV(J))*G(N)*XNFPHE(J,1)/RHO(J)
      DO 304 N=4,27
  304 BOLTN(J,N)=EXP(-24.587*(1.-1./N**2)/TKEV(J))*4.*N**2*
     1XNFPHE(J,1)/RHO(J)
      FREET(J)=XNE(J)*XNFHE(J,2)/RHO(J)/SQRT(T(J))
      XR=XNFPHE(J,1)*(4./2./13.595)*TKEV(J)/RHO(J)
      BOLTEX(J)=EXP(-23.730/TKEV(J))*XR
    5 EXLIM(J)=EXP(-24.587/TKEV(J))*XR
   10 FREQ3=FREQ**3
      CFREE=3.6919E8/FREQ3
      C=2.815E29/FREQ3
      DO 15 IMIN=1,10
      IF(HEFREQ(IMIN).LE.FREQ)GO TO 16
   15 CONTINUE
      IMIN=0
      GO TO 40
   16 GO TO (21,22,23,24,25,26,27,28,29,30),IMIN
   21 TRANS(1)=CROSSHE(FREQ)
   22 TRANS(2)=HE12s3S(FREQ)
   23 TRANS(3)=HE12s1S(FREQ)
   24 TRANS(4)=HE12p3P(FREQ)
   25 TRANS(5)=HE12p1P(FREQ)
C     1s3s 3S
   26 TRANS(6)=XKARSAS(FREQ,1.236439D0,3,0)
c     1s3s 1S
   27 TRANS(7)=XKARSAS(FREQ,1.102898D0,3,0)
c     1s3p 3P
   28 TRANS(8)=XKARSAS(FREQ,1.045499D0,3,1)
c     1s3d 3D+1D
   29 TRANS(9)=XKARSAS(FREQ,1.001427D0,3,2)
c     1s3p 1P
   30 TRANS(10)=XKARSAS(FREQ,.9926D0,3,1)
c     HeII n=2
   31 ELIM=527490.06
      FREQHE=(ELIM-171135.000)*2.99792458E10
  776 FORMAT(1P10E13.6)
      IF(FREQ.LT.FREQHE)GO TO 32
      ZEFF2=FREQHE/RYD
      TRANS(5)=TRANS(5)+XKARSAS(FREQ,ZEFF2,1,0)
      FREQHE=(ELIM-169087.)*2.99792458E10
      IF(FREQ.LT.FREQHE)GO TO 32
      ZEFF2=FREQHE/RYD
      TRANS(4)=TRANS(4)+XKARSAS(FREQ,ZEFF2,1,0)
      FREQHE=(ELIM-166277.546)*2.99792458E10
      IF(FREQ.LT.FREQHE)GO TO 32
      ZEFF2=FREQHE/RYD
      TRANS(3)=TRANS(3)+XKARSAS(FREQ,ZEFF2,1,0)
      FREQHE=(ELIM-159856.069)*2.99792458E10
      IF(FREQ.LT.FREQHE)GO TO 32
      ZEFF2=FREQHE/RYD
      TRANS(2)=TRANS(2)+XKARSAS(FREQ,ZEFF2,1,0)
C     HeII n=3
   32 ELIM=588451.59
      FREQHE=(ELIM-186209.471)*2.99792458E10
      IF(FREQ.LT.FREQHE)GO TO 40
      ZEFF2=FREQHE/RYD
      TRANS(10)=TRANS(10)+XKARSAS(FREQ,ZEFF2,1,0)
      FREQHE=(ELIM-186101.)*2.99792458E10
      IF(FREQ.LT.FREQHE)GO TO 40
      ZEFF2=FREQHE/RYD
      TRANS(9)=TRANS(9)+XKARSAS(FREQ,ZEFF2,1,0)
      FREQHE=(ELIM-185564.)*2.99792458E10
      IF(FREQ.LT.FREQHE)GO TO 40
      ZEFF2=FREQHE/RYD
      TRANS(8)=TRANS(8)+XKARSAS(FREQ,ZEFF2,1,0)
      FREQHE=(ELIM-184864.)*2.99792458E10
      IF(FREQ.LT.FREQHE)GO TO 40
      ZEFF2=FREQHE/RYD
      TRANS(7)=TRANS(7)+XKARSAS(FREQ,ZEFF2,1,0)
      FREQHE=(ELIM-183236.)*2.99792458E10
      IF(FREQ.LT.FREQHE)GO TO 40
      ZEFF2=FREQHE/RYD
      TRANS(6)=TRANS(6)+XKARSAS(FREQ,ZEFF2,1,0)
      IF(FREQ.LT.1.25408E+16)GO TO 40
      DO 34 N=4,27
      ZEFF2=4.-3./N**2
   34 TRANSN(N)=XKARSAS(FREQ,ZEFF2,1,0)
   40 DO 45 J=1,NRHOX
      EX=BOLTEX(J)
      IF(FREQ.LT.2.055E14)EX=EXLIM(J)/EHVKT(J)
      HE1=(EX-EXLIM(J))*C
      IF(IMIN.EQ.0)GO TO 44
      DO 41 N=IMIN,10
   41 HE1=HE1+TRANS(N)*BOLT(J,N)
      IF(FREQ.LT.1.25408E+16)GO TO 44
      DO 42 N=4,27
   42 HE1=HE1+TRANSN(N)*BOLTN(J,N)
   44 AHE1BOUND(J)=HE1*STIM(J)
      AHE1FREE(J)=(COULFF(J,1)*FREET(J)*CFREE)*STIM(J)
   45 AHE1(J)=(HE1+COULFF(J,1)*FREET(J)*CFREE)*STIM(J)
C      PRINT 777,AHE1BOUND,AHE1FREE
  777 FORMAT(1P10E12.4)
      RETURN
      END
      FUNCTION CROSSHE(FREQ)
C     Marr, G.V. and West, J.B. Atomic Data and Nuclear Data Tables,
c     vol 18, 497-508, 1976.
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      DIMENSION W(kw),X505(92),X50(16),X20(11),X10(21)
      DATA X505/
     1 7.58, 7.46, 7.33, 7.19, 7.06, 6.94, 6.81, 6.68, 6.55, 6.43,
     2 6.30, 6.18, 6.05, 5.93, 5.81, 5.69, 5.57, 5.45, 5.33, 5.21,
     3 5.10, 4.98, 4.87, 4.76, 4.64, 4.53, 4.42, 4.31, 4.20, 4.09,
     4 4.00, 3.88, 3.78, 3.68, 3.57, 3.47, 3.37, 3.27, 3.18, 3.08,
     5 2.98, 2.89, 2.80, 2.70, 2.61, 2.52, 2.44, 2.35, 2.26, 2.18,
     6 2.10, 2.02, 1.94, 1.86, 1.78, 1.70, 1.63, 1.55, 1.48, 1.41,
     7 1.34, 1.28, 1.21, 1.14, 1.08, 1.02, .961, .903, .847, .792,
     8 .738, .687, .637, .588, .542, .497, .454, .412, .373, .335,
     9 .299, .265, .233, .202, .174, .147, .123, .100,.0795,.0609,
     A.0443,.0315/
      DATA X50/.0315,.0282,.0250,.0220,.0193,.0168,.0145,.0124,.0105,
     1.00885,.00736,.00604,.00489,.00389,.00303,.00231/
      DATA X20/.00231,.00199,.00171,.00145,.00122,.00101,.000832,
     1 .000673,.000535,.000417,.000318/
      DATA X10/.000318,.000274,.000235,.000200,.000168,.000139,.000115,
     1 .000093,.000074,.000057,.000044,.000032,.000023,.000016,.000010,
     2.000006,.000003,.000001,.0000006,.0000003,0./
      CROSSHE=0.
      IF(FREQ.LT.5.945209E15)RETURN
      WAVE=2.99792458E18/FREQ
      IF(WAVE.GT.50.)THEN
      I=93.-(WAVE-50.)/5.
      I=MIN(92,MAX(2,I))
      CROSSHE=((WAVE-(92-I)*5-50)/5.*(X505(I-1)-X505(I))+X505(I))*1.E-18
      RETURN
      ENDIF
      IF(WAVE.GT.20.)THEN
      I=17.-(WAVE-20.)/2.
      I=MIN(16,MAX(2,I))
      CROSSHE=((WAVE-(16-I)*2-20)/2.*(X50(I-1)-X50(I))+X50(I))*1.E-18
      RETURN
      ENDIF
      IF(WAVE.GT.10.)THEN
      I=12.-(WAVE-10.)/1.
      I=MIN(11,MAX(2,I))
      CROSSHE=((WAVE-(11-I)*1-10)/1.*(X20(I-1)-X20(I))+X20(I))*1.E-18
      RETURN
      ENDIF
      I=22.-WAVE/.5
      I=MIN(21,MAX(2,I))
      CROSSHE=((WAVE-(21-I)*.5)/.5*(X10(I-1)-X10(I))+X10(I))*1.E-18
      RETURN
      END
      FUNCTION HE111S(FREQ)
C     FOLLOWING MATHISEN
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      DIMENSION W(64),X(64)
      DATA W/
     1 504.3, 501.5, 498.7, 493.3, 488.1, 480.3, 477.8, 454.0, 443.0,
     2 395.0, 356.4, 348.2, 324.6, 302.0, 298.1, 275.6, 260.6, 256.2,
     3 239.4, 224.6,  220.,  215,   210.,  205.,  200.,  195.,  190.,
     4  185.,  180.,  175.,  170.,  165.,  160.,  155.,  150.,  145.,
     5  135.,  130.,  125.,  120.,  115.,  110.,  105.,  100.,   95.,
     6   90.,   85.,   80.,   75.,   70.,   65.,   60.,   55.,   50.,
     7   45.,   40.,   35.,   30.,   25.,   20.,   15.,   10.,  5.,0./
      DATA X/
     1 7.346, 7.317, 7.259, 7.143, 7.030, 6.857, 6.800, 6.284, 6.041,
     2 4.977, 4.138, 3.961, 3.474, 3.025, 2.945, 2.522, 2.259, 2.179,
     3 1.901, 1.684, 1.61 , 1.53 , 1.45 , 1.38 , 1.30 , 1.22 , 1.14 ,
     4 1.08 , 1.02 , 0.961, 0.903, 0.847, 0.792, 0.738, 0.687, 0.637,
     5 0.542, 0.497, 0.454, 0.412, 0.373, 0.335, 0.299, 0.265, 0.233,
     6 0.202, 0.174, 0.147, 0.124, 0.103,0.0840,0.0676,0.0535,0.0414,
     7.0311,.0266,.0158,.0104,.00637,.00349,.00161,.00054,.000083,0./
      HE111S=0.
      IF(FREQ.LT.5.945209E15)RETURN
      WAVE=2.99792458E18/FREQ
      DO 3 I=2,64
      IF(WAVE.GT.W(I))GO TO 4
    3 CONTINUE
    4 HE111S=((WAVE-W(I))/(W(I-1)-W(I))*(X(I-1)-X(I))+X(I))*1.E-18
      RETURN
      END
      FUNCTION HE12S1S(FREQ)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      DIMENSION FREQ1S(16),X1S(16)
      DATA FREQ1S/
     1    15.947182,   15.913654,   15.877320,   15.837666,   15.794025,
     2    15.745503,   15.690869,   15.628361,   15.555317,   15.467455,
     3    15.357189,   15.289399,   15.251073,   15.209035,   15.162487,
     4    14.982421/
      DATA X1S/
     1   -19.635557,  -19.159345,  -18.958474,  -18.809535,  -18.676481,
     2   -18.546006,  -18.410962,  -18.264821,  -18.100205,  -17.909165,
     3   -17.684370,  -17.557867,  -17.490360,  -17.417876,  -17.349386,
     4   -17.084441/
      HE12S1S=0.
      IF(FREQ.LT.32033.214*2.99792458E10)RETURN
      IF(FREQ.GT.2.4*109722.267*2.99792458E10)GO TO 3
      FREQLG=LOG10(FREQ)
      DO 1 I=2,16
      IF(FREQLG.GT.FREQ1S(I))GO TO 2
    1 CONTINUE
    2 X=(FREQLG-FREQ1S(I))/(FREQ1S(I-1)-FREQ1S(I))*
     1(X1S(I-1)-X1S(I))+X1S(I)
      HE12S1S=EXP(X*2.30258509299405E0)
      RETURN
    3 WAVENO=FREQ/2.99792458E10
      EK=(WAVENO-32033.214)/109722.267
      EPS=2.*(EK-2.612316)/.00322
      HE12S1S=.008175*(484940./WAVENO)**2.71*8.067E-18*
     1(EPS+76.21)**2/(1.+EPS**2)
      RETURN
      END
      FUNCTION HE12S3S(FREQ)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      DIMENSION FREQ3S(16),X3S(16)
      DATA FREQ3S/
     1    15.956523,   15.923736,   15.888271,   15.849649,   15.807255,
     2    15.760271,   15.707580,   15.647601,   15.577992,   15.495055,
     3    15.392451,   15.330345,   15.295609,   15.257851,   15.216496,
     4    15.061770/
      DATA X3S/
     1   -18.426022,  -18.610700,  -18.593051,  -18.543304,  -18.465513,
     2   -18.378707,  -18.278574,  -18.164329,  -18.033346,  -17.882435,
     3   -17.705542,  -17.605584,  -17.553459,  -17.500667,  -17.451318,
     4   -17.266686/
      HE12S3S=0.
      IF(FREQ.LT.38454.691*2.99792458E10)RETURN
      IF(FREQ.GT.2.4*109722.267*2.99792458E10)GO TO 3
      FREQLG=LOG10(FREQ)
      DO 1 I=2,16
      IF(FREQLG.GT.FREQ3S(I))GO TO 2
    1 CONTINUE
    2 X=(FREQLG-FREQ3S(I))/(FREQ3S(I-1)-FREQ3S(I))*
     1(X3S(I-1)-X3S(I))+X3S(I)
      HE12S3S=EXP(X*2.30258509299405E0)
      RETURN
    3 WAVENO=FREQ/2.99792458E10
      EK=(WAVENO-38454.691)/109722.267
      EPS=2.*(EK-2.47898)/.000780
      HE12S3S=.01521*(470310./WAVENO)**3.12*8.067E-18*
     1(EPS-122.4)**2/(1.+EPS**2)
      RETURN
      END
      FUNCTION HE12P1P(FREQ)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      DIMENSION FREQ1P(16),X1P(16)
      DATA FREQ1P/
     1    15.939981,   15.905870,   15.868850,   15.828377,   15.783742,
     2    15.733988,   15.677787,   15.613218,   15.537343,   15.445346,
     3    15.328474,   15.255641,   15.214064,   15.168081,   15.116647,
     4    14.911002/
      DATA X1P/
     1   -18.798876,  -19.685922,  -20.011664,  -20.143030,  -20.091354,
     2   -19.908333,  -19.656788,  -19.367745,  -19.043016,  -18.674484,
     3   -18.240861,  -17.989700,  -17.852015,  -17.702677,  -17.525347,
     4   -16.816344/
      HE12P1P=0.
      IF(FREQ.LT.27175.76*2.99792458E10)RETURN
      IF(FREQ.GT.2.4*109722.267*2.99792458E10)GO TO 3
      FREQLG=LOG10(FREQ)
      DO 1 I=2,16
      IF(FREQLG.GT.FREQ1P(I))GO TO 2
    1 CONTINUE
    2 X=(FREQLG-FREQ1P(I))/(FREQ1P(I-1)-FREQ1P(I))*
     1(X1P(I-1)-X1P(I))+X1P(I)
      HE12P1P=EXP(X*2.30258509299405E0)
      RETURN
    3 WAVENO=FREQ/2.99792458E10
      EK=(WAVENO-27175.76)/109722.267
      EPS1S=2.*(EK-2.446534)/.01037
      EPS1D=2.*(EK-2.59427)/.00538
      HE12S1P=.0009487*(466750./WAVENO)**3.69*8.067E-18*
     1((EPS1S-29.30)**2/(1.+EPS1S**2)+(EPS1D+172.4)**2/(1.+EPS1D**2))
      RETURN
      END
      FUNCTION HE12P3P(FREQ)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      DIMENSION FREQ3P(16),X3P(16)
      DATA FREQ3P/
     1    15.943031,   15.909169,   15.872441,   15.832318,   15.788107,
     2    15.738880,   15.683351,   15.619667,   15.545012,   15.454805,
     3    15.340813,   15.270195,   15.230054,   15.185821,   15.136567,
     4    14.942557/
      DATA X3P/
     1   -19.791021,  -19.697886,  -19.591421,  -19.471855,  -19.337053,
     2   -19.183958,  -19.009750,  -18.807990,  -18.570571,  -18.288361,
     3   -17.943476,  -17.738737,  -17.624154,  -17.497163,  -17.403183,
     4   -17.032999/
      HE12P3P=0.
      IF(FREQ.LT.29223.753*2.99792458E10)RETURN
      FREQLG=LOG10(FREQ)
      DO 1 I=2,16
      IF(FREQLG.GT.FREQ3P(I))GO TO 2
    1 CONTINUE
    2 X=(FREQLG-FREQ3P(I))/(FREQ3P(I-1)-FREQ3P(I))*
     1(X3P(I-1)-X3P(I))+X3P(I)
      HE12P3P=EXP(X*2.30258509299405E0)
      RETURN
      END
      SUBROUTINE HE2OP
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     REQUIRES FUNCTIONS COULX AND COULFF
C     FREQUENCIES ARE 4X HYDROGEN,CHI ARE FOR ION POT=54.403
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /IONS/XNFPH(kw,2),XNFPHE(kw,3),XNFH(kw,2),XNFHE(kw,3)
      COMMON /OPS/D1(kw,5),AHE2(kw),D2(kw,19)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      DIMENSION CONT(9),BOLT(kw,9),EXLIM(kw),FREET(kw),BOLTEX(kw)
      DIMENSION AHE2BOUND(kw),AHE2FREE(kw)
      DATA ITEMP1/0/
      IF(ITEMP.EQ.ITEMP1)GO TO 20
      ITEMP1=ITEMP
      DO 15 J=1,NRHOX
      DO 14 N=1,9
   14 BOLT(J,N)=EXP(-(54.403-54.403/DFLOAT(N*N))/TKEV(J))*2.*
     1DFLOAT(N*N)*XNFPHE(J,2)/RHO(J)
      FREET(J)=XNE(J)*XNFHE(J,3)/RHO(J)/SQRT(T(J))
      XR=XNFPHE(J,2)*(2./2./13.595)*TKEV(J)/RHO(J)
      BOLTEX(J)=EXP(-53.859/TKEV(J))*XR
   15 EXLIM(J)=EXP(-54.403/TKEV(J))*XR
   20 DO 21 N=1,9
C   21 CONT(N)=COULX(N,FREQ,2.D0)
   21 CONT(N)=XKARSAS(FREQ,4.D0,N,N)
      FREQ3=FREQ**3
      CFREE=3.6919E8/FREQ3*4.
      C=2.815E29*2.*2./FREQ3
      DO 35 J=1,NRHOX
      EX=BOLTEX(J)
      IF(FREQ.LT.1.31522E14)EX=EXLIM(J)/EHVKT(J)
      HE2=(EX-EXLIM(J))*C
      DO 31 N=1,9
   31 HE2=HE2+CONT(N)*BOLT(J,N)
      AHE2BOUND(J)=HE2*STIM(J)
      AHE2FREE(J)=(COULFF(J,2)*CFREE*FREET(J))*STIM(J)
   35 AHE2(J)=(HE2+COULFF(J,2)*CFREE*FREET(J))*STIM(J)
C      PRINT 777,AHE2BOUND,AHE2FREE
  777 FORMAT(1P10E12.4)
      RETURN
      END
      SUBROUTINE HEMIOP
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /IONS/XNFPH(kw,2),XNFPHE(kw,3),XNFH(kw,2),XNFHE(kw,3)
      COMMON /OPS/D1(kw,6),AHEMIN(kw),D2(kw,18)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      A=3.397E-46+(-5.216E-31+7.039E-15/FREQ)/FREQ
      B=-4.116E-42+(1.067E-26+8.135E-11/FREQ)/FREQ
      C=5.081E-37+(-8.724E-23-5.659E-8/FREQ)/FREQ
      DO 3 J=1,NRHOX
    3 AHEMIN(J)=(A*T(J)+B+C/T(J))*XNE(J)*XNFPHE(J,1)/RHO(J)
      RETURN
      END
      SUBROUTINE HERAOP
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /IONS/XNFPH(kw,2),XNFPHE(kw,3),XNFH(kw,2),XNFHE(kw,3)
      COMMON /OPS/D1(kw,7),SIGHE(kw),D2(kw,17)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      WAVE=2.997925E18/DMIN1(FREQ,5.15D15)
      WW=WAVE**2
      SIG=5.484E-14/WW/WW*(1.+(2.44E5+5.94E10/(WW-2.90E5))/WW)**2
      DO 2 J=1,NRHOX
    2 SIGHE(J)=SIG*XNFPHE(J,1)/RHO(J)
      RETURN
      END
      SUBROUTINE COOLOP
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     SI1,MG1,AL1,C1,FE1
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /OPS/D1(kw,8),ACOOL(kw),D2(kw,16)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      COMMON /XNFP/XNFPC(kw,4),XNFPN(kw,5),XNFPO(kw,6),XNFPNE(kw,6),
     1             XNFPAL(kw,1),XNFPMG(kw,2),XNFPSI(kw,2),XNFPCA(kw,2),
     2             XNFPFE(kw,1),XNFPCH(kw),XNFPOH(kw)
      REAL*8 MG1OP
      IF(FREQ.GT.3.28805E15)RETURN
      DO 20 J=1,NRHOX
   20 ACOOL(J)=(C1OP(J)*XNFPC(J,1)+MG1OP(J)*XNFPMG(J,1)+
     1AL1OP(J)*XNFPAL(J,1)+SI1OP(J)*XNFPSI(J,1)+FE1OP(J)*XNFPFE(J,1)+
     2CHOP(J)*XNFPCH(J)+OHOP(J)*XNFPOH(J))*STIM(J)/RHO(J)
      RETURN
      END
      FUNCTION C1OP(J)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     CROSS-SECTION TIMES THE PARTITION FUNCTION
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      DIMENSION C1240(kw),C1444(kw)
      DATA FREQ1,ITEMP1/0.,0/
      IF(ITEMP.EQ.ITEMP1)GO TO 30
      ITEMP1=ITEMP
      DO 20 K=1,NRHOX
      C1240(K)=5.*EXP(-1.264/TKEV(K))
   20 C1444(K)=EXP(-2.683/TKEV(K))
   30 IF(FREQ.EQ.FREQ1)GO TO 40
      X1444=0.
      X1240=0.
      X1100=0.
      IF(FREQ.GE.2.7254E15)X1100=
     1SEATON(2.7254D15,1.219D-17,2.D0,3.317D0)
      IF(FREQ.GE.2.4196E15)X1240=
     1SEATON(2.4196D15,1.03D-17,1.5D0,2.789D0)
      IF(FREQ.GE.2.0761E15)X1444=
     1SEATON(2.0761D15,9.59D-18,1.5D0,3.501D0)
      FREQ1=FREQ
   40 C1OP=X1100*9.+X1240*C1240(J)+X1444*C1444(J)
      RETURN
      END
      FUNCTION SEATON(FREQ0,XSECT,POWER,A)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      SEATON=XSECT*(A+(1.-A)*(FREQ0/FREQ))*
     1SQRT((FREQ0/FREQ)**( INT(2.*POWER+.01)))
      RETURN
      END
      FUNCTION MG1OP(J)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     CROSS-SECTION TIMES THE PARTITION FUNCTION
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      REAL*8 MG1OP
      DIMENSION FLOG(9),FREQMG(7),PEACH(7,15),X(7),TLG(7),DT(kw),NT(kw)
      DATA PEACH/
C        4000     5000     6000     7000     8000     9000    10000     WAVE(A)
     1 -42.474, -42.350, -42.109, -41.795, -41.467, -41.159, -40.883,   1500
     2 -41.808, -41.735, -41.582, -41.363, -41.115, -40.866, -40.631,   1550
     3 -41.273, -41.223, -41.114, -40.951, -40.755, -40.549, -40.347,   1621
     4 -45.583, -44.008, -42.957, -42.205, -41.639, -41.198, -40.841,   1622
     5 -44.324, -42.747, -41.694, -40.939, -40.370, -39.925, -39.566,   2513
     6 -50.969, -48.388, -46.630, -45.344, -44.355, -43.568, -42.924,   2514
     7 -50.633, -48.026, -46.220, -44.859, -43.803, -42.957, -42.264,   3756
     8 -53.028, -49.643, -47.367, -45.729, -44.491, -43.520, -42.736,   3757
     9 -51.785, -48.352, -46.050, -44.393, -43.140, -42.157, -41.363,   6549
     T -52.285, -48.797, -46.453, -44.765, -43.486, -42.480, -41.668,   6550
     1 -52.028, -48.540, -46.196, -44.507, -43.227, -42.222, -41.408,   7234
     2 -52.384, -48.876, -46.513, -44.806, -43.509, -42.488, -41.660,   7235
     3 -52.363, -48.856, -46.493, -44.786, -43.489, -42.467, -41.639,   7291
     4 -54.704, -50.772, -48.107, -46.176, -44.707, -43.549, -42.611,   7292
     5 -54.359, -50.349, -47.643, -45.685, -44.198, -43.027, -42.418/   9000
      DATA FREQMG/1.9341452E15,1.8488510E15,1.1925797E15,7.9804046E14,
     1 4.5772110E14,4.1440977E14,4.1113514E14/
      DATA FLOG/35.23123,35.19844,35.15334,34.71490,34.31318,33.75728,
     1 33.65788,33.64994,33.43947/
      DATA TLG/8.29405,8.51719,8.69951,8.85367,8.98720,9.10498,9.21034/
      DATA FREQ1,ITEMP1/0.,0/
      IF(ITEMP.EQ.ITEMP1)GO TO 20
      ITEMP1=ITEMP
      DO 11 K=1,NRHOX
      N=MAX0(MIN0(6, INT(T(K)/1000.)-3),1)
      NT(K)=N
   11 DT(K)=(TLOG(K)-TLG(N))/(TLG(N+1)-TLG(N))
      GO TO 21
   20 IF(FREQ.EQ.FREQ1)GO TO 30
   21 FREQ1=FREQ
      DO 22 N=1,7
      IF(FREQ.GT.FREQMG(N))GO TO 23
   22 CONTINUE
      N=8
   23 D=(FREQLG-FLOG(N))/(FLOG(N+1)-FLOG(N))
      IF(N.GT.2)N=2*N-2
      D1=1.-D
      DO 24 IT=1,7
   24 X(IT)=PEACH(IT,N+1)*D+PEACH(IT,N)*D1
   30 N=NT(J)
      MG1OP=EXP(X(N)*(1.-DT(J))+X(N+1)*DT(J))
      RETURN
      END
      FUNCTION AL1OP(J)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     CROSS-SECTION TIMES THE PARTITION FUNCTION
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      AL1OP=0.
      IF(FREQ.GE.1.443E15)AL1OP=6.5E-17*(1.443E15/FREQ)**5*6.
      RETURN
      END
      FUNCTION SI1OP(J)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     CROSS-SECTION TIMES THE PARTITION FUNCTION
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      DIMENSION FLOG(11),FREQSI(9),X(9),TLG(9),DT(kw),NT(kw)
      DIMENSION PEACH(9,19)
      DATA PEACH/
C       4000   5000   6000   7000   8000   9000   10000  11000  12000   WAVE(A)
     1 38.136,38.138,38.140,38.141,38.143,38.144,38.144,38.145,38.145,  1200
     2 37.834,37.839,37.843,37.847,37.850,37.853,37.855,37.857,37.858,  1400
     3 37.898,37.898,37.897,37.897,37.897,37.896,37.895,37.895,37.894,  1519
     4 40.737,40.319,40.047,39.855,39.714,39.604,39.517,39.445,39.385,  1520
     5 40.581,40.164,39.893,39.702,39.561,39.452,39.366,39.295,39.235,  1676
     6 45.521,44.456,43.753,43.254,42.878,42.580,42.332,42.119,41.930,  1677
     7 45.520,44.455,43.752,43.251,42.871,42.569,42.315,42.094,41.896,  1978
     8 55.068,51.783,49.553,47.942,46.723,45.768,44.997,44.360,43.823,  1979
     9 53.868,50.369,48.031,46.355,45.092,44.104,43.308,42.652,42.100,  5379
     T 54.133,50.597,48.233,46.539,45.261,44.262,43.456,42.790,42.230,  5380
     1 54.051,50.514,48.150,46.454,45.176,44.175,43.368,42.702,42.141,  5624
     2 54.442,50.854,48.455,46.733,45.433,44.415,43.592,42.912,42.340,  5625
     3 54.320,50.722,48.313,46.583,45.277,44.251,43.423,42.738,42.160,  6260
     4 55.691,51.965,49.444,47.615,46.221,45.119,44.223,43.478,42.848,  6261
     5 55.661,51.933,49.412,47.582,46.188,45.085,44.189,43.445,42.813,  6349
     6 55.973,52.193,49.630,47.769,46.349,45.226,44.314,43.555,42.913,  6350
     7 55.922,52.141,49.577,47.715,46.295,45.172,44.259,43.500,42.858,  6491
     8 56.828,52.821,50.110,48.146,46.654,45.477,44.522,43.730,43.061,  6492
     9 56.657,52.653,49.944,47.983,46.491,45.315,44.360,43.569,42.901/  6900
C     3P,1D,1S,1D,3D,3F,1D,3P
      DATA FREQSI/2.1413750E15,1.9723165E15,1.7879689E15,1.5152920E15,
     1 5.5723927E14,5.3295914E14,4.7886458E14,4.7216422E14,4.6185133E14/
      DATA FLOG/35.45438,35.30022,35.21799,35.11986,34.95438,33.95402,
     1 33.90947,33.80244,33.78835,33.76626,33.70518/
      DATA TLG/8.29405,8.51719,8.69951,8.85367,8.98720,9.10498,9.21034,
     1 9.30565,9.39266/
      DATA FREQ1,ITEMP1/0.,0/
      IF(ITEMP.EQ.ITEMP1)GO TO 20
      ITEMP1=ITEMP
      DO 11 K=1,NRHOX
      N=MAX0(MIN0(8, INT(T(K)/1000.)-3),1)
      NT(K)=N
   11 DT(K)=(TLOG(K)-TLG(N))/(TLG(N+1)-TLG(N))
      GO TO 21
   20 IF(FREQ.EQ.FREQ1)GO TO 30
   21 FREQ1=FREQ
      DO 22 N=1,9
      IF(FREQ.GT.FREQSI(N))GO TO 23
   22 CONTINUE
      N=10
   23 D=(FREQLG-FLOG(N))/(FLOG(N+1)-FLOG(N))
      IF(N.GT.2)N=2*N-2
      D1=1.-D
      DO 24 IT=1,9
   24 X(IT)=PEACH(IT,N+1)*D+PEACH(IT,N)*D1
   30 N=NT(J)
      SI1OP=EXP(-(X(N)*(1.-DT(J))+X(N+1)*DT(J)))*9.
      RETURN
      END
      FUNCTION FE1OP(J)
C     CROSS-SECTION TIMES PARTITION FUNCTION
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      DIMENSION BOLT(48,kw),G(48),E(48),WNO(48),XSECT(48)
      DATA G/25.,35.,21.,15.,9.,35.,33.,21.,27.,49.,9.,21.,27.,9.,9.,
     1 25.,33.,15.,35.,3.,5.,11.,15.,13.,15.,9.,21.,15.,21.,25.,35.,
     2 9.,5.,45.,27.,21.,15.,21.,15.,25.,21.,35.,5.,15.,45.,35.,55.,25./
      DATA E/500.,7500.,12500.,17500.,19000.,19500.,19500.,21000.,
     1 22000.,23000.,23000.,24000.,24000.,24500.,24500.,26000.,26500.,
     2 26500.,27000.,27500.,28500.,29000.,29500.,29500.,29500.,30000.,
     3 31500.,31500.,33500.,33500.,34000.,34500.,34500.,35000.,35500.,
     4 37000.,37000.,37000.,38500.,40000.,40000.,41000.,41000.,43000.,
     5 43000.,43000.,43000.,44000./
      DATA WNO/63500.,58500.,53500.,59500.,45000.,44500.,44500.,43000.,
     1 58000.,41000.,54000.,40000.,40000.,57500.,55500.,38000.,57500.,
     2 57500.,37000.,54500.,53500.,55000.,34500.,34500.,34500.,34000.,
     3 32500.,32500.,32500.,32500.,32000.,29500.,29500.,31000.,30500.,
     4 29000.,27000.,54000.,27500.,24000.,47000.,23000.,44000.,42000.,
     5 42000.,21000.,42000.,42000./
      DATA ITEMP1/0/,FREQ1/0./
      IF(ITEMP.EQ.ITEMP1)GO TO 20
      ITEMP1=ITEMP
      DO 10 K=1,NRHOX
      DO 10 I=1,48
   10 BOLT(I,K)=G(I)*EXP(-E(I)*2.99792458E10*HKT(K))
   20 IF(FREQ.EQ.FREQ1)GO TO 30
      FREQ1=FREQ
      WAVENO=FREQ/2.99792458E10
      IF(WAVENO.LT.21000.)GO TO 30
      DO 25 I=1,48
      XSECT(I)=0.
      IF(WNO(I).LT.WAVENO)
     1XSECT(I)= 3.E-18/(1.+((WNO(I)+3000.-WAVENO)/WNO(I)/.1)**4)
   25 CONTINUE
   30 FE1OP=0.
      IF(WAVENO.LT.21000.)RETURN
      DO 35 I=1,48
   35 FE1OP=FE1OP+XSECT(I)*BOLT(I,J)
      RETURN
      END
      FUNCTION CHOP(J)
C     CROSS-SECTION TIMES PARTITION FUNCTION
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      DIMENSION CROSSCH(15,105),PARTCH(41),CROSSCHT(15)
      DIMENSION C1(150),C2(150),C3(150),C4(150),C5(150)
      DIMENSION C6(150),C7(150),C8(150),C9(150),C10(150)
      DIMENSION C11(75)
      EQUIVALENCE (CROSSCH(1, 1),C1(1)),(CROSSCH(1,11),C2(1))
      EQUIVALENCE (CROSSCH(1,21),C3(1)),(CROSSCH(1,31),C4(1))
      EQUIVALENCE (CROSSCH(1,41),C5(1)),(CROSSCH(1,51),C6(1))
      EQUIVALENCE (CROSSCH(1,61),C7(1)),(CROSSCH(1,71),C8(1))
      EQUIVALENCE (CROSSCH(1,81),C9(1)),(CROSSCH(1,91),C10(1))
      EQUIVALENCE (CROSSCH(1,101),C11(1))
      DATA C1/-38.000,-38.000,-38.000,-38.000,-38.000,-38.000,-38.000,   0.1
     1-38.000,-38.000,-38.000,-38.000,-38.000,-38.000,-38.000,-38.000,   0.1
     2        -32.727,-31.151,-30.133,-29.432,-28.925,-28.547,-28.257,   0.2
     2-28.030,-27.848,-27.701,-27.580,-27.479,-27.395,-27.322,-27.261,   0.2
     3        -31.588,-30.011,-28.993,-28.290,-27.784,-27.405,-27.115,   0.3
     3-26.887,-26.705,-26.558,-26.437,-26.336,-26.251,-26.179,-26.117,   0.3
     4        -30.407,-28.830,-27.811,-27.108,-26.601,-26.223,-25.932,   0.4
     4-25.705,-25.523,-25.376,-25.255,-25.154,-25.069,-24.997,-24.935,   0.4
     5        -29.513,-27.937,-26.920,-26.218,-25.712,-25.334,-25.043,   0.5
     5-24.816,-24.635,-24.487,-24.366,-24.266,-24.181,-24.109,-24.047,   0.5
     6        -28.910,-27.341,-26.327,-25.628,-25.123,-24.746,-24.457,   0.6
     6-24.230,-24.049,-23.902,-23.782,-23.681,-23.597,-23.525,-23.464,   0.6
     7        -28.517,-26.961,-25.955,-25.261,-24.760,-24.385,-24.098,   0.7
     7-23.873,-23.694,-23.548,-23.429,-23.329,-23.245,-23.174,-23.113,   0.7
     8        -28.213,-26.675,-25.680,-24.993,-24.497,-24.127,-23.843,   0.8
     8-23.620,-23.443,-23.299,-23.181,-23.082,-22.999,-22.929,-22.869,   0.8
     9        -27.942,-26.427,-25.446,-24.769,-24.280,-23.915,-23.635,   0.9
     9-23.416,-23.241,-23.100,-22.983,-22.887,-22.805,-22.736,-22.677,   0.9
     A        -27.706,-26.210,-25.241,-24.572,-24.088,-23.728,-23.451,   1.0
     A-23.235,-23.063,-22.923,-22.808,-22.713,-22.633,-22.565,-22.507/   1.0
      DATA C2/-27.475,-26.000,-25.043,-24.382,-23.905,-23.548,-23.275,   1.1
     1-23.062,-22.891,-22.753,-22.640,-22.546,-22.467,-22.400,-22.343,   1.1
     2        -27.221,-25.783,-24.844,-24.193,-23.723,-23.372,-23.102,   1.2
     2-22.892,-22.724,-22.588,-22.476,-22.384,-22.306,-22.240,-22.184,   1.2
     3        -26.863,-25.506,-24.607,-23.979,-23.523,-23.182,-22.919,   1.3
     3-22.714,-22.550,-22.417,-22.309,-22.218,-22.142,-22.078,-22.023,   1.3
     4        -26.685,-25.347,-24.457,-23.835,-23.382,-23.044,-22.784,   1.4
     4-22.580,-22.418,-22.286,-22.178,-22.089,-22.014,-21.950,-21.896,   1.4
     5        -26.085,-24.903,-24.105,-23.538,-23.120,-22.805,-22.561,   1.5
     5-22.370,-22.217,-22.093,-21.991,-21.906,-21.835,-21.775,-21.723,   1.5
     6        -25.902,-24.727,-23.936,-23.376,-22.964,-22.654,-22.415,   1.6
     6-22.227,-22.076,-21.955,-21.855,-21.772,-21.702,-21.644,-21.593,   1.6
     7        -25.215,-24.196,-23.510,-23.019,-22.655,-22.378,-22.163,   1.7
     7-21.992,-21.855,-21.744,-21.653,-21.577,-21.513,-21.459,-21.412,   1.7
     8        -24.914,-23.937,-23.284,-22.820,-22.475,-22.212,-22.007,   1.8
     8-21.845,-21.715,-21.609,-21.522,-21.449,-21.388,-21.336,-21.292,   1.8
     9        -24.519,-23.637,-23.039,-22.606,-22.281,-22.030,-21.834,   1.9
     9-21.678,-21.552,-21.450,-21.365,-21.295,-21.236,-21.185,-21.142,   1.9
     A        -24.086,-23.222,-22.650,-22.246,-21.948,-21.722,-21.546,   2.0
     A-21.407,-21.296,-21.205,-21.131,-21.070,-21.018,-20.974,-20.937/   2.0
      DATA C3/-23.850,-23.018,-22.472,-22.088,-21.805,-21.590,-21.422,   2.1
     1-21.289,-21.182,-21.095,-21.024,-20.964,-20.914,-20.872,-20.835,   2.1
     2        -23.136,-22.445,-21.994,-21.676,-21.440,-21.259,-21.117,   2.2
     2-21.004,-20.912,-20.837,-20.775,-20.723,-20.679,-20.642,-20.611,   2.2
     3        -23.199,-22.433,-21.927,-21.573,-21.314,-21.119,-20.969,   2.3
     3-20.851,-20.758,-20.682,-20.621,-20.571,-20.529,-20.493,-20.463,   2.3
     4        -22.696,-22.020,-21.585,-21.286,-21.071,-20.912,-20.791,   2.4
     4-20.697,-20.622,-20.563,-20.514,-20.475,-20.442,-20.414,-20.391,   2.4
     5        -22.119,-21.557,-21.194,-20.943,-20.761,-20.624,-20.518,   2.5
     5-20.434,-20.367,-20.313,-20.268,-20.231,-20.201,-20.175,-20.153,   2.5
     6        -21.855,-21.300,-20.931,-20.673,-20.485,-20.344,-20.235,   2.6
     6-20.151,-20.084,-20.031,-19.988,-19.953,-19.924,-19.900,-19.880,   2.6
     7        -21.126,-20.673,-20.382,-20.184,-20.044,-19.943,-19.868,   2.7
     7-19.811,-19.769,-19.736,-19.710,-19.690,-19.674,-19.662,-19.652,   2.7
     8        -20.502,-20.150,-19.922,-19.766,-19.657,-19.578,-19.520,   2.8
     8-19.478,-19.446,-19.422,-19.404,-19.390,-19.379,-19.371,-19.365,   2.8
     9        -20.030,-19.724,-19.530,-19.399,-19.309,-19.245,-19.199,   2.9
     9-19.166,-19.142,-19.125,-19.112,-19.103,-19.096,-19.091,-19.088,   2.9
     A        -19.640,-19.364,-19.189,-19.074,-18.996,-18.943,-18.906,   3.0
     A-18.881,-18.863,-18.852,-18.844,-18.839,-18.837,-18.836,-18.836/   3.0
      DATA C4/-19.333,-19.092,-18.939,-18.838,-18.770,-18.725,-18.695,   3.1
     1-18.675,-18.662,-18.655,-18.651,-18.649,-18.649,-18.651,-18.653,   3.1
     2        -19.070,-18.880,-18.756,-18.674,-18.621,-18.585,-18.562,   3.2
     2-18.548,-18.540,-18.536,-18.536,-18.537,-18.539,-18.542,-18.546,   3.2
     3        -18.851,-18.708,-18.617,-18.558,-18.521,-18.498,-18.484,   3.3
     3-18.477,-18.475,-18.476,-18.478,-18.482,-18.487,-18.493,-18.498,   3.3
     4        -18.709,-18.599,-18.533,-18.494,-18.471,-18.459,-18.454,   3.4
     4-18.454,-18.457,-18.462,-18.469,-18.476,-18.483,-18.490,-18.498,   3.4
     5        -18.656,-18.572,-18.524,-18.497,-18.485,-18.480,-18.482,   3.5
     5-18.486,-18.493,-18.501,-18.510,-18.519,-18.527,-18.536,-18.544,   3.5
     6        -18.670,-18.613,-18.582,-18.566,-18.561,-18.562,-18.568,   3.6
     6-18.575,-18.583,-18.592,-18.601,-18.610,-18.619,-18.627,-18.635,   3.6
     7        -18.728,-18.700,-18.687,-18.683,-18.685,-18.691,-18.698,   3.7
     7-18.706,-18.715,-18.723,-18.731,-18.739,-18.745,-18.752,-18.758,   3.7
     8        -18.839,-18.835,-18.836,-18.842,-18.849,-18.857,-18.865,   3.8
     8-18.872,-18.878,-18.883,-18.888,-18.892,-18.895,-18.898,-18.900,   3.8
     9        -19.034,-19.041,-19.049,-19.057,-19.064,-19.069,-19.071,   3.9
     9-19.071,-19.070,-19.068,-19.065,-19.061,-19.058,-19.054,-19.051,   3.9
     A        -19.372,-19.378,-19.382,-19.380,-19.372,-19.359,-19.341,   4.0
     A-19.321,-19.300,-19.280,-19.261,-19.243,-19.227,-19.212,-19.199/   4.0
      DATA C5/-19.780,-19.777,-19.763,-19.732,-19.686,-19.631,-19.573,   4.1
     1-19.517,-19.465,-19.419,-19.379,-19.344,-19.314,-19.288,-19.265,   4.1
     2        -20.151,-20.133,-20.087,-20.009,-19.911,-19.810,-19.715,   4.2
     2-19.631,-19.559,-19.497,-19.446,-19.402,-19.365,-19.333,-19.306,   4.2
     3        -20.525,-20.454,-20.312,-20.138,-19.970,-19.825,-19.705,   4.3
     3-19.607,-19.528,-19.464,-19.411,-19.367,-19.330,-19.300,-19.274,   4.3
     4        -20.869,-20.655,-20.366,-20.104,-19.894,-19.731,-19.604,   4.4
     4-19.505,-19.426,-19.363,-19.312,-19.271,-19.236,-19.208,-19.184,   4.4
     5        -21.179,-20.768,-20.380,-20.081,-19.856,-19.686,-19.556,   4.5
     5-19.454,-19.375,-19.311,-19.260,-19.218,-19.184,-19.155,-19.131,   4.5
     6        -21.167,-20.601,-20.206,-19.925,-19.719,-19.565,-19.447,   4.6
     6-19.355,-19.283,-19.226,-19.180,-19.143,-19.112,-19.087,-19.066,   4.6
     7        -20.918,-20.348,-19.976,-19.720,-19.536,-19.401,-19.299,   4.7
     7-19.220,-19.159,-19.112,-19.073,-19.043,-19.018,-18.998,-18.981,   4.7
     8        -20.753,-20.204,-19.847,-19.602,-19.427,-19.299,-19.203,   4.8
     8-19.129,-19.072,-19.028,-18.993,-18.965,-18.942,-18.924,-18.909,   4.8
     9        -20.456,-19.987,-19.677,-19.460,-19.302,-19.186,-19.098,   4.9
     9-19.030,-18.978,-18.937,-18.904,-18.878,-18.857,-18.841,-18.827,   4.9
     A        -20.154,-19.734,-19.461,-19.272,-19.136,-19.035,-18.960,   5.0
     A-18.902,-18.858,-18.824,-18.797,-18.775,-18.759,-18.745,-18.735/   5.0
      DATA C6/-19.941,-19.544,-19.288,-19.114,-18.992,-18.903,-18.837,   5.1
     1-18.788,-18.751,-18.723,-18.701,-18.684,-18.671,-18.661,-18.654,   5.1
     2        -19.657,-19.321,-19.104,-18.956,-18.853,-18.779,-18.724,   5.2
     2-18.684,-18.655,-18.632,-18.615,-18.602,-18.592,-18.585,-18.579,   5.2
     3        -19.388,-19.109,-18.930,-18.810,-18.725,-18.664,-18.620,   5.3
     3-18.586,-18.562,-18.543,-18.529,-18.518,-18.510,-18.503,-18.498,   5.3
     4        -19.201,-18.953,-18.794,-18.686,-18.611,-18.556,-18.515,   5.4
     4-18.485,-18.462,-18.446,-18.433,-18.423,-18.416,-18.410,-18.406,   5.4
     5        -18.923,-18.719,-18.588,-18.500,-18.439,-18.396,-18.365,   5.5
     5-18.344,-18.328,-18.318,-18.311,-18.307,-18.304,-18.303,-18.302,   5.5
     6        -18.614,-18.458,-18.361,-18.298,-18.258,-18.232,-18.216,   5.6
     6-18.206,-18.202,-18.201,-18.202,-18.205,-18.208,-18.213,-18.218,   5.6
     7        -18.419,-18.295,-18.222,-18.178,-18.153,-18.139,-18.132,   5.7
     7-18.131,-18.133,-18.138,-18.143,-18.150,-18.157,-18.164,-18.172,   5.7
     8        -18.296,-18.201,-18.148,-18.118,-18.101,-18.094,-18.091,   5.8
     8-18.093,-18.096,-18.101,-18.107,-18.113,-18.120,-18.126,-18.132,   5.8
     9        -18.021,-17.992,-17.977,-17.970,-17.967,-17.968,-17.970,   5.9
     9-17.974,-17.978,-17.983,-17.989,-17.994,-18.000,-18.005,-18.011,   5.9
     A        -17.694,-17.686,-17.686,-17.691,-17.698,-17.708,-17.718,   6.0
     A-17.729,-17.740,-17.750,-17.761,-17.771,-17.781,-17.790,-17.798/   6.0
      DATA C7/-17.374,-17.384,-17.400,-17.420,-17.440,-17.462,-17.483,   6.1
     1-17.503,-17.523,-17.541,-17.558,-17.575,-17.590,-17.603,-17.616,   6.1
     2        -17.169,-17.199,-17.230,-17.262,-17.293,-17.323,-17.351,   6.2
     2-17.378,-17.404,-17.427,-17.449,-17.469,-17.488,-17.505,-17.520,   6.2
     3        -17.151,-17.184,-17.217,-17.250,-17.282,-17.313,-17.342,   6.3
     3-17.369,-17.395,-17.418,-17.440,-17.461,-17.480,-17.497,-17.513,   6.3
     4        -17.230,-17.260,-17.290,-17.320,-17.348,-17.375,-17.401,   6.4
     4-17.425,-17.448,-17.469,-17.489,-17.508,-17.525,-17.541,-17.556,   6.4
     5        -17.379,-17.403,-17.425,-17.446,-17.467,-17.486,-17.505,   6.5
     5-17.524,-17.541,-17.558,-17.574,-17.588,-17.602,-17.615,-17.627,   6.5
     6        -17.596,-17.604,-17.609,-17.612,-17.616,-17.622,-17.628,   6.6
     6-17.636,-17.644,-17.652,-17.661,-17.670,-17.679,-17.687,-17.695,   6.6
     7        -17.846,-17.823,-17.795,-17.770,-17.750,-17.735,-17.725,   6.7
     7-17.719,-17.716,-17.715,-17.716,-17.719,-17.722,-17.726,-17.730,   6.7
     8        -18.089,-18.015,-17.942,-17.882,-17.836,-17.802,-17.777,   6.8
     8-17.760,-17.748,-17.740,-17.736,-17.734,-17.733,-17.734,-17.736,   6.8
     9        -18.299,-18.156,-18.038,-17.947,-17.881,-17.833,-17.798,   6.9
     9-17.774,-17.757,-17.745,-17.738,-17.733,-17.730,-17.729,-17.729,   6.9
     A        -18.441,-18.243,-18.096,-17.991,-17.915,-17.860,-17.821,   7.0
     A-17.792,-17.772,-17.757,-17.746,-17.738,-17.733,-17.730,-17.728/   7.0
      DATA C8/-18.474,-18.262,-18.111,-18.004,-17.926,-17.869,-17.826,   7.1
     1-17.795,-17.771,-17.753,-17.740,-17.730,-17.722,-17.717,-17.713,   7.1
     2        -18.387,-18.191,-18.053,-17.952,-17.878,-17.823,-17.782,   7.2
     2-17.752,-17.729,-17.711,-17.698,-17.689,-17.681,-17.676,-17.672,   7.2
     3        -18.161,-17.990,-17.874,-17.793,-17.736,-17.696,-17.668,   7.3
     3-17.648,-17.634,-17.625,-17.619,-17.616,-17.614,-17.614,-17.615,   7.3
     4        -17.908,-17.774,-17.690,-17.637,-17.604,-17.583,-17.572,   7.4
     4-17.567,-17.566,-17.568,-17.571,-17.576,-17.581,-17.587,-17.593,   7.4
     5        -17.681,-17.589,-17.540,-17.515,-17.506,-17.505,-17.511,   7.5
     5-17.520,-17.530,-17.542,-17.554,-17.566,-17.578,-17.589,-17.600,   7.5
     6        -17.647,-17.606,-17.584,-17.575,-17.573,-17.576,-17.582,   7.6
     6-17.589,-17.597,-17.605,-17.614,-17.623,-17.631,-17.639,-17.646,   7.6
     7        -17.300,-17.291,-17.291,-17.297,-17.307,-17.319,-17.333,   7.7
     7-17.347,-17.361,-17.375,-17.389,-17.402,-17.415,-17.427,-17.438,   7.7
     8        -16.786,-16.802,-16.825,-16.853,-16.883,-16.914,-16.944,   7.8
     8-16.974,-17.003,-17.030,-17.055,-17.079,-17.101,-17.122,-17.141,   7.8
     9        -16.489,-16.533,-16.579,-16.625,-16.670,-16.713,-16.754,   7.9
     9-16.793,-16.830,-16.864,-16.896,-16.925,-16.952,-16.977,-17.000,   7.9
     A        -16.694,-16.724,-16.756,-16.789,-16.823,-16.856,-16.888,   8.0
     A-16.919,-16.949,-16.976,-17.002,-17.026,-17.048,-17.069,-17.088/   8.0
      DATA C9/-16.935,-16.951,-16.971,-16.993,-17.016,-17.040,-17.064,   8.1
     1-17.088,-17.111,-17.132,-17.153,-17.172,-17.190,-17.206,-17.222,   8.1
     2        -17.200,-17.208,-17.220,-17.235,-17.251,-17.269,-17.286,   8.2
     2-17.304,-17.322,-17.338,-17.354,-17.369,-17.384,-17.397,-17.409,   8.2
     3        -17.597,-17.591,-17.589,-17.590,-17.594,-17.600,-17.608,   8.3
     3-17.617,-17.626,-17.635,-17.645,-17.654,-17.662,-17.671,-17.679,   8.3
     4        -18.166,-18.134,-18.107,-18.085,-18.068,-18.056,-18.047,   8.4
     4-18.041,-18.038,-18.036,-18.035,-18.035,-18.036,-18.038,-18.039,   8.4
     5        -19.000,-18.917,-18.838,-18.770,-18.714,-18.669,-18.632,   8.5
     5-18.603,-18.579,-18.560,-18.545,-18.532,-18.522,-18.514,-18.507,   8.5
     6        -20.313,-19.982,-19.754,-19.592,-19.472,-19.380,-19.309,   8.6
     6-19.253,-19.208,-19.172,-19.143,-19.119,-19.099,-19.083,-19.069,   8.6
     7        -19.751,-19.611,-19.520,-19.461,-19.423,-19.398,-19.382,   8.7
     7-19.372,-19.366,-19.364,-19.363,-19.364,-19.366,-19.368,-19.371,   8.7
     8        -19.581,-19.431,-19.337,-19.277,-19.240,-19.218,-19.207,   8.8
     8-19.202,-19.203,-19.207,-19.212,-19.220,-19.228,-19.236,-19.245,   8.8
     9        -19.685,-19.506,-19.389,-19.311,-19.258,-19.222,-19.199,   8.9
     9-19.184,-19.175,-19.170,-19.168,-19.169,-19.171,-19.174,-19.177,   8.9
     A        -19.977,-19.756,-19.606,-19.501,-19.425,-19.370,-19.330,   9.0
     A-19.300,-19.278,-19.262,-19.250,-19.241,-19.235,-19.230,-19.227/   9.0
      DATAC10/-20.445,-20.158,-19.958,-19.815,-19.711,-19.633,-19.574,   9.1
     1-19.528,-19.493,-19.465,-19.442,-19.425,-19.410,-19.398,-19.389,   9.1
     2        -20.980,-20.625,-20.391,-20.229,-20.110,-20.020,-19.949,   9.2
     2-19.892,-19.846,-19.807,-19.775,-19.748,-19.724,-19.704,-19.687,   9.2
     3        -21.404,-21.023,-20.771,-20.594,-20.461,-20.358,-20.274,   9.3
     3-20.205,-20.148,-20.099,-20.058,-20.022,-19.991,-19.965,-19.942,   9.3
     4        -21.309,-20.970,-20.753,-20.603,-20.495,-20.412,-20.348,   9.4
     4-20.295,-20.252,-20.215,-20.185,-20.158,-20.135,-20.115,-20.098,   9.4
     5        -21.221,-20.906,-20.707,-20.574,-20.480,-20.412,-20.361,   9.5
     5-20.322,-20.292,-20.268,-20.249,-20.233,-20.221,-20.210,-20.201,   9.5
     6        -21.441,-21.097,-20.878,-20.728,-20.623,-20.546,-20.489,   9.6
     6-20.446,-20.413,-20.387,-20.368,-20.352,-20.340,-20.330,-20.322,   9.6
     7        -21.668,-21.305,-21.071,-20.911,-20.797,-20.713,-20.650,   9.7
     7-20.602,-20.565,-20.536,-20.514,-20.496,-20.481,-20.470,-20.460,   9.7
     8        -21.926,-21.556,-21.316,-21.150,-21.031,-20.942,-20.874,   9.8
     8-20.822,-20.782,-20.750,-20.724,-20.704,-20.687,-20.674,-20.663,   9.8
     9        -22.319,-21.937,-21.686,-21.510,-21.380,-21.282,-21.206,   9.9
     9-21.147,-21.099,-21.061,-21.031,-21.006,-20.985,-20.968,-20.954,   9.9
     A        -22.969,-22.561,-22.288,-22.092,-21.945,-21.832,-21.743,  10.0
     A-21.672,-21.616,-21.570,-21.533,-21.503,-21.477,-21.457,-21.439/  10.0
      DATAC11/-24.001,-23.527,-23.199,-22.957,-22.772,-22.629,-22.516,  10.1
     1-22.427,-22.355,-22.297,-22.250,-22.212,-22.180,-22.153,-22.131,  10.1
     2        -24.233,-23.774,-23.477,-23.273,-23.128,-23.022,-22.943,  10.2
     2-22.883,-22.837,-22.802,-22.774,-22.752,-22.735,-22.721,-22.710,  10.2
     3        -24.550,-23.913,-23.521,-23.266,-23.094,-22.976,-22.893,  10.3
     3-22.836,-22.796,-22.768,-22.750,-22.737,-22.730,-22.726,-22.725,  10.3
     4        -24.301,-23.665,-23.274,-23.019,-22.848,-22.730,-22.648,  10.4
     4-22.591,-22.552,-22.525,-22.507,-22.495,-22.489,-22.485,-22.485,  10.4
     5        -24.519,-23.883,-23.491,-23.237,-23.065,-22.948,-22.866,  10.5
     5-22.809,-22.770,-22.743,-22.724,-22.713,-22.706,-22.703,-22.702/  10.5
      DATA PARTCH/
     1     203.741,  249.643,  299.341,  353.477,  412.607,  477.237,
     2     547.817,  624.786,  708.543,  799.463,  897.912, 1004.227,
     3    1118.738, 1241.761, 1373.588, 1514.481, 1664.677, 1824.394,
     4    1993.801, 2173.050, 2362.234, 2561.424, 2770.674, 2989.930,
     5    3219.204, 3458.378, 3707.355, 3966.005, 4234.155, 4511.604,
     6    4798.135, 5093.554, 5397.593, 5709.948, 6030.401, 6358.646,
     7    6694.379, 7037.313, 7387.147, 7743.579, 8106.313/
      DATA FREQ1/0./
   10 CHOP=0.
      IF(FREQ.EQ.FREQ1)GO TO 30
      FREQ1=FREQ
      WAVENO=FREQ/2.99792458E10
      EVOLT=WAVENO/8065.479
      N=EVOLT*10.
      EN=FLOAT(N)*.1
      IF(N.LT.20)RETURN
      IF(N.GE.105)RETURN
      DO 21 IT=1,15
   21 CROSSCHT(IT)=(CROSSCH(IT,N)+(CROSSCH(IT,N+1)-CROSSCH(IT,N))*
     1(EVOLT-EN)/.1)
C      PRINT 26,CROSSCHT
C   26 FORMAT(3H0CH,15F8.3)
   30 IF(T(J).GE.9000.)RETURN
      IF(N.LT.20)RETURN
      IF(N.GE.105)RETURN
      IT=(T(J)-1000.)/200.+1.
      IT=MAX0(IT,1)
      TN=FLOAT(IT)*200.+800.
      PART=PARTCH(IT)+(PARTCH(IT+1)-PARTCH(IT))*(T(J)-TN)/200.
      IT=(T(J)-2000.)/500.+1.
      IT=MAX0(IT,1)
      TN=FLOAT(IT)*500.+1500.
      CHOP=EXP((CROSSCHT(IT)+(CROSSCHT(IT+1)-CROSSCHT(IT))*
     1(T(J)-TN)/500.)*2.30258509299405E0)*PART
      RETURN
      END
      FUNCTION OHOP(J)
C     CROSS-SECTION TIMES PARTITION FUNCTION
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      DIMENSION CROSSOH(15,130),PARTOH(41),CROSSOHT(15)
      DIMENSION C1(150),C2(150),C3(150),C4(150),C5(150)
      DIMENSION C6(150),C7(150),C8(150),C9(150),C10(150)
      DIMENSION C11(150),C12(150),C13(150)
      EQUIVALENCE (CROSSOH(1, 1),C1(1)),(CROSSOH(1,11),C2(1))
      EQUIVALENCE (CROSSOH(1,21),C3(1)),(CROSSOH(1,31),C4(1))
      EQUIVALENCE (CROSSOH(1,41),C5(1)),(CROSSOH(1,51),C6(1))
      EQUIVALENCE (CROSSOH(1,61),C7(1)),(CROSSOH(1,71),C8(1))
      EQUIVALENCE (CROSSOH(1,81),C9(1)),(CROSSOH(1,91),C10(1))
      EQUIVALENCE (CROSSOH(1,101),C11(1))
      EQUIVALENCE (CROSSOH(1,111),C12(1))
      EQUIVALENCE (CROSSOH(1,121),C13(1))
      DATA C1/-30.855,-29.121,-27.976,-27.166,-26.566,-26.106,-25.742,   2.1
     1-25.448,-25.207,-25.006,-24.836,-24.691,-24.566,-24.457,-24.363,   2.1
     2        -30.494,-28.760,-27.615,-26.806,-26.206,-25.745,-25.381,   2.2
     2-25.088,-24.846,-24.645,-24.475,-24.330,-24.205,-24.097,-24.002,   2.2
     3        -30.157,-28.425,-27.280,-26.472,-25.872,-25.411,-25.048,   2.3
     3-24.754,-24.513,-24.312,-24.142,-23.997,-23.872,-23.764,-23.669,   2.3
     4        -29.848,-28.117,-26.974,-26.165,-25.566,-25.105,-24.742,   2.4
     4-24.448,-24.207,-24.006,-23.836,-23.692,-23.567,-23.458,-23.364,   2.4
     5        -29.567,-27.837,-26.693,-25.885,-25.286,-24.826,-24.462,   2.5
     5-24.169,-23.928,-23.727,-23.557,-23.412,-23.287,-23.179,-23.084,   2.5
     6        -29.307,-27.578,-26.436,-25.628,-25.029,-24.569,-24.205,   2.6
     6-23.912,-23.671,-23.470,-23.300,-23.155,-23.031,-22.922,-22.828,   2.6
     7        -29.068,-27.341,-26.199,-25.391,-24.792,-24.332,-23.969,   2.7
     7-23.676,-23.435,-23.234,-23.064,-22.920,-22.795,-22.687,-22.592,   2.7
     8        -28.820,-27.115,-25.978,-25.172,-24.574,-24.115,-23.752,   2.8
     8-23.459,-23.218,-23.017,-22.848,-22.703,-22.579,-22.470,-22.376,   2.8
     9        -28.540,-26.891,-25.768,-24.968,-24.372,-23.914,-23.552,   2.9
     9-23.259,-23.019,-22.818,-22.649,-22.504,-22.380,-22.272,-22.177,   2.9
     A        -28.275,-26.681,-25.574,-24.779,-24.186,-23.729,-23.368,   3.0
     A-23.076,-22.836,-22.636,-22.467,-22.322,-22.198,-22.090,-21.996/   3.0
      DATA C2/-27.993,-26.470,-25.388,-24.602,-24.014,-23.560,-23.200,   3.1
     1-22.909,-22.669,-22.470,-22.301,-22.157,-22.033,-21.925,-21.831,   3.1
     2        -27.698,-26.252,-25.204,-24.433,-23.851,-23.401,-23.043,   3.2
     2-22.754,-22.515,-22.316,-22.148,-22.005,-21.881,-21.773,-21.679,   3.2
     3        -27.398,-26.026,-25.019,-24.267,-23.696,-23.251,-22.896,   3.3
     3-22.609,-22.372,-22.174,-22.007,-21.864,-21.741,-21.634,-21.540,   3.3
     4        -27.100,-25.791,-24.828,-24.102,-23.543,-23.106,-22.756,   3.4
     4-22.472,-22.238,-22.041,-21.875,-21.733,-21.611,-21.504,-21.411,   3.4
     5        -26.807,-25.549,-24.631,-23.933,-23.391,-22.964,-22.621,   3.5
     5-22.341,-22.109,-21.915,-21.751,-21.610,-21.488,-21.383,-21.290,   3.5
     6        -26.531,-25.310,-24.431,-23.761,-23.238,-22.823,-22.488,   3.6
     6-22.214,-21.986,-21.795,-21.633,-21.494,-21.374,-21.269,-21.178,   3.6
     7        -26.239,-25.066,-24.225,-23.585,-23.082,-22.681,-22.356,   3.7
     7-22.089,-21.866,-21.679,-21.520,-21.383,-21.265,-21.162,-21.072,   3.7
     8        -25.945,-24.824,-24.017,-23.405,-22.923,-22.538,-22.223,   3.8
     8-21.964,-21.748,-21.565,-21.410,-21.276,-21.160,-21.059,-20.970,   3.8
     9        -25.663,-24.587,-23.810,-23.222,-22.761,-22.391,-22.088,   3.9
     9-21.838,-21.629,-21.452,-21.300,-21.170,-21.057,-20.958,-20.872,   3.9
     A        -25.372,-24.350,-23.603,-23.038,-22.596,-22.241,-21.950,   4.0
     A-21.710,-21.508,-21.337,-21.190,-21.064,-20.954,-20.858,-20.774/   4.0
      DATA C3/-25.076,-24.111,-23.396,-22.853,-22.429,-22.088,-21.809,   4.1
     1-21.578,-21.384,-21.220,-21.078,-20.957,-20.851,-20.758,-20.676,   4.1
     2        -24.779,-23.870,-23.189,-22.669,-22.261,-21.934,-21.667,   4.2
     2-21.445,-21.259,-21.101,-20.965,-20.848,-20.746,-20.656,-20.578,   4.2
     3        -24.486,-23.629,-22.983,-22.486,-22.095,-21.781,-21.524,   4.3
     3-21.311,-21.132,-20.980,-20.850,-20.737,-20.639,-20.553,-20.478,   4.3
     4        -24.183,-23.382,-22.774,-22.302,-21.928,-21.627,-21.381,   4.4
     4-21.177,-21.005,-20.859,-20.734,-20.625,-20.531,-20.449,-20.376,   4.4
     5        -23.867,-23.127,-22.561,-22.116,-21.761,-21.474,-21.238,   4.5
     5-21.043,-20.878,-20.738,-20.617,-20.513,-20.423,-20.344,-20.274,   4.5
     6        -23.538,-22.862,-22.340,-21.926,-21.592,-21.320,-21.096,   4.6
     6-20.909,-20.751,-20.617,-20.502,-20.402,-20.315,-20.239,-20.172,   4.6
     7        -23.234,-22.604,-22.120,-21.734,-21.422,-21.166,-20.953,   4.7
     7-20.776,-20.625,-20.497,-20.387,-20.291,-20.208,-20.135,-20.071,   4.7
     8        -22.934,-22.347,-21.898,-21.541,-21.250,-21.010,-20.811,   4.8
     8-20.643,-20.500,-20.378,-20.273,-20.182,-20.102,-20.033,-19.971,   4.8
     9        -22.637,-22.092,-21.676,-21.345,-21.075,-20.853,-20.666,   4.9
     9-20.508,-20.374,-20.259,-20.159,-20.073,-19.997,-19.931,-19.872,   4.9
     A        -22.337,-21.835,-21.452,-21.147,-20.899,-20.693,-20.520,   5.0
     A-20.373,-20.247,-20.139,-20.046,-19.964,-19.892,-19.830,-19.774/   5.0
      DATA C4/-22.049,-21.584,-21.230,-20.950,-20.721,-20.531,-20.372,   5.1
     1-20.236,-20.119,-20.019,-19.931,-19.855,-19.788,-19.729,-19.676,   5.1
     2        -21.768,-21.337,-21.011,-20.754,-20.544,-20.370,-20.223,   5.2
     2-20.098,-19.991,-19.898,-19.817,-19.746,-19.683,-19.628,-19.579,   5.2
     3        -21.494,-21.096,-20.796,-20.559,-20.367,-20.208,-20.074,   5.3
     3-19.960,-19.861,-19.776,-19.701,-19.636,-19.578,-19.527,-19.482,   5.3
     4        -21.233,-20.861,-20.585,-20.368,-20.193,-20.048,-19.926,   5.4
     4-19.821,-19.732,-19.654,-19.586,-19.526,-19.473,-19.426,-19.384,   5.4
     5        -20.983,-20.635,-20.380,-20.181,-20.021,-19.889,-19.778,   5.5
     5-19.683,-19.602,-19.531,-19.469,-19.415,-19.367,-19.324,-19.286,   5.5
     6        -20.743,-20.418,-20.182,-19.999,-19.853,-19.733,-19.633,   5.6
     6-19.547,-19.474,-19.410,-19.354,-19.305,-19.261,-19.223,-19.189,   5.6
     7        -20.515,-20.210,-19.991,-19.824,-19.690,-19.581,-19.490,   5.7
     7-19.413,-19.347,-19.290,-19.240,-19.196,-19.157,-19.122,-19.092,   5.7
     8        -20.297,-20.011,-19.808,-19.654,-19.532,-19.434,-19.352,   5.8
     8-19.282,-19.223,-19.172,-19.127,-19.088,-19.054,-19.023,-18.996,   5.8
     9        -20.090,-19.822,-19.633,-19.491,-19.381,-19.291,-19.218,   5.9
     9-19.156,-19.103,-19.057,-19.018,-18.983,-18.952,-18.925,-18.901,   5.9
     A        -19.893,-19.642,-19.467,-19.337,-19.236,-19.155,-19.089,   6.0
     A-19.034,-18.987,-18.946,-18.912,-18.881,-18.854,-18.831,-18.810/   6.0
      DATA C5/-19.705,-19.472,-19.309,-19.190,-19.098,-19.025,-18.966,   6.1
     1-18.917,-18.876,-18.840,-18.810,-18.783,-18.760,-18.739,-18.721,   6.1
     2        -19.527,-19.310,-19.161,-19.051,-18.968,-18.903,-18.851,   6.2
     2-18.807,-18.771,-18.740,-18.713,-18.690,-18.670,-18.653,-18.637,   6.2
     3        -19.357,-19.159,-19.022,-18.922,-18.847,-18.789,-18.743,   6.3
     3-18.704,-18.673,-18.646,-18.623,-18.603,-18.586,-18.571,-18.558,   6.3
     4        -19.195,-19.016,-18.892,-18.803,-18.736,-18.684,-18.643,   6.4
     4-18.610,-18.583,-18.560,-18.540,-18.523,-18.509,-18.496,-18.485,   6.4
     5        -19.042,-18.883,-18.772,-18.693,-18.634,-18.589,-18.553,   6.5
     5-18.525,-18.501,-18.481,-18.465,-18.451,-18.438,-18.428,-18.419,   6.5
     6        -18.894,-18.758,-18.662,-18.593,-18.542,-18.503,-18.473,   6.6
     6-18.448,-18.428,-18.412,-18.398,-18.386,-18.376,-18.367,-18.359,   6.6
     7        -18.752,-18.639,-18.559,-18.501,-18.458,-18.426,-18.400,   6.7
     7-18.380,-18.363,-18.350,-18.338,-18.328,-18.320,-18.313,-18.306,   6.7
     8        -18.611,-18.523,-18.460,-18.415,-18.381,-18.355,-18.334,   6.8
     8-18.318,-18.304,-18.293,-18.284,-18.276,-18.269,-18.263,-18.258,   6.8
     9        -18.471,-18.408,-18.362,-18.329,-18.304,-18.285,-18.269,   6.9
     9-18.257,-18.247,-18.238,-18.231,-18.224,-18.219,-18.214,-18.210,   6.9
     A        -18.330,-18.290,-18.261,-18.239,-18.223,-18.211,-18.201,   7.0
     A-18.192,-18.185,-18.179,-18.174,-18.169,-18.165,-18.162,-18.159/   7.0
      DATA C6/-18.190,-18.168,-18.154,-18.143,-18.135,-18.129,-18.124,   7.1
     1-18.120,-18.116,-18.112,-18.109,-18.106,-18.104,-18.102,-18.100,   7.1
     2        -18.055,-18.047,-18.043,-18.042,-18.040,-18.039,-18.039,   7.2
     2-18.038,-18.037,-18.036,-18.035,-18.034,-18.033,-18.033,-18.032,   7.2
     3        -17.929,-17.931,-17.935,-17.939,-17.943,-17.946,-17.948,   7.3
     3-17.950,-17.952,-17.953,-17.955,-17.956,-17.957,-17.958,-17.959,   7.3
     4        -17.818,-17.826,-17.834,-17.842,-17.849,-17.855,-17.860,   7.4
     4-17.865,-17.869,-17.872,-17.875,-17.878,-17.881,-17.883,-17.886,   7.4
     5        -17.724,-17.736,-17.747,-17.758,-17.767,-17.775,-17.782,   7.5
     5-17.788,-17.793,-17.798,-17.803,-17.807,-17.811,-17.815,-17.819,   7.5
     6        -17.651,-17.665,-17.678,-17.690,-17.701,-17.710,-17.718,   7.6
     6-17.725,-17.732,-17.738,-17.744,-17.749,-17.755,-17.760,-17.765,   7.6
     7        -17.601,-17.615,-17.629,-17.642,-17.653,-17.663,-17.672,   7.7
     7-17.680,-17.688,-17.695,-17.701,-17.708,-17.714,-17.720,-17.726,   7.7
     8        -17.572,-17.587,-17.602,-17.614,-17.626,-17.636,-17.645,   7.8
     8-17.654,-17.662,-17.670,-17.677,-17.684,-17.691,-17.698,-17.704,   7.8
     9        -17.565,-17.581,-17.595,-17.607,-17.619,-17.629,-17.638,   7.9
     9-17.647,-17.656,-17.664,-17.671,-17.679,-17.686,-17.693,-17.700,   7.9
     A        -17.580,-17.594,-17.608,-17.620,-17.630,-17.640,-17.650,   8.0
     A-17.658,-17.667,-17.675,-17.682,-17.690,-17.697,-17.704,-17.711/   8.0
      DATA C7/-17.613,-17.626,-17.639,-17.649,-17.659,-17.669,-17.677,   8.1
     1-17.686,-17.694,-17.701,-17.709,-17.716,-17.723,-17.730,-17.737,   8.1
     2        -17.663,-17.675,-17.685,-17.695,-17.703,-17.711,-17.719,   8.2
     2-17.727,-17.734,-17.741,-17.748,-17.755,-17.761,-17.768,-17.774,   8.2
     3        -17.728,-17.737,-17.745,-17.752,-17.759,-17.766,-17.772,   8.3
     3-17.778,-17.785,-17.791,-17.797,-17.803,-17.808,-17.814,-17.820,   8.3
     4        -17.803,-17.809,-17.814,-17.818,-17.823,-17.828,-17.832,   8.4
     4-17.837,-17.842,-17.847,-17.852,-17.856,-17.861,-17.866,-17.871,   8.4
     5        -17.884,-17.886,-17.888,-17.889,-17.891,-17.893,-17.896,   8.5
     5-17.899,-17.902,-17.905,-17.908,-17.912,-17.915,-17.919,-17.922,   8.5
     6        -17.966,-17.964,-17.961,-17.959,-17.958,-17.958,-17.958,   8.6
     6-17.959,-17.960,-17.961,-17.963,-17.964,-17.966,-17.968,-17.970,   8.6
     7        -18.040,-18.034,-18.028,-18.023,-18.019,-18.016,-18.013,   8.7
     7-18.012,-18.010,-18.010,-18.009,-18.009,-18.009,-18.009,-18.010,   8.7
     8        -18.096,-18.087,-18.078,-18.071,-18.065,-18.059,-18.055,   8.8
     8-18.051,-18.047,-18.045,-18.042,-18.040,-18.039,-18.037,-18.036,   8.8
     9        -18.125,-18.115,-18.105,-18.097,-18.089,-18.082,-18.076,   8.9
     9-18.070,-18.065,-18.061,-18.057,-18.053,-18.051,-18.048,-18.046,   8.9
     A        -18.120,-18.112,-18.103,-18.095,-18.087,-18.079,-18.072,   9.0
     A-18.066,-18.060,-18.055,-18.050,-18.046,-18.042,-18.039,-18.036/   9.0
      DATA C8/-18.083,-18.078,-18.071,-18.064,-18.057,-18.050,-18.044,   9.1
     1-18.037,-18.032,-18.026,-18.022,-18.017,-18.014,-18.010,-18.007,   9.1
     2        -18.025,-18.022,-18.017,-18.012,-18.006,-18.000,-17.994,   9.2
     2-17.989,-17.984,-17.979,-17.975,-17.971,-17.968,-17.965,-17.963,   9.2
     3        -17.957,-17.955,-17.952,-17.948,-17.943,-17.938,-17.934,   9.3
     3-17.929,-17.925,-17.922,-17.918,-17.916,-17.913,-17.911,-17.910,   9.3
     4        -17.890,-17.889,-17.886,-17.882,-17.879,-17.875,-17.871,   9.4
     4-17.867,-17.864,-17.862,-17.860,-17.858,-17.857,-17.856,-17.855,   9.4
     5        -17.831,-17.829,-17.826,-17.822,-17.819,-17.815,-17.812,   9.5
     5-17.810,-17.807,-17.806,-17.804,-17.803,-17.803,-17.803,-17.803,   9.5
     6        -17.786,-17.782,-17.777,-17.773,-17.769,-17.766,-17.763,   9.6
     6-17.761,-17.759,-17.758,-17.757,-17.757,-17.757,-17.758,-17.759,   9.6
     7        -17.753,-17.747,-17.741,-17.735,-17.731,-17.727,-17.724,   9.7
     7-17.722,-17.721,-17.720,-17.720,-17.720,-17.721,-17.722,-17.724,   9.7
     8        -17.733,-17.724,-17.716,-17.709,-17.703,-17.699,-17.696,   9.8
     8-17.694,-17.693,-17.692,-17.692,-17.693,-17.694,-17.695,-17.697,   9.8
     9        -17.723,-17.711,-17.700,-17.691,-17.685,-17.680,-17.676,   9.9
     9-17.674,-17.673,-17.672,-17.673,-17.673,-17.675,-17.676,-17.678,   9.9
     A        -17.718,-17.702,-17.689,-17.679,-17.672,-17.667,-17.663,  10.0
     A-17.660,-17.659,-17.659,-17.659,-17.660,-17.661,-17.663,-17.665/  10.0
      DATA C9/-17.713,-17.695,-17.681,-17.670,-17.662,-17.656,-17.653,  10.1
     1-17.650,-17.649,-17.649,-17.649,-17.650,-17.651,-17.653,-17.655,  10.1
     2        -17.705,-17.686,-17.671,-17.660,-17.652,-17.647,-17.643,  10.2
     2-17.641,-17.640,-17.640,-17.640,-17.641,-17.643,-17.645,-17.647,  10.2
     3        -17.690,-17.671,-17.657,-17.647,-17.640,-17.635,-17.632,  10.3
     3-17.630,-17.630,-17.630,-17.631,-17.632,-17.634,-17.636,-17.639,  10.3
     4        -17.667,-17.649,-17.637,-17.629,-17.623,-17.619,-17.618,  10.4
     4-17.617,-17.617,-17.618,-17.619,-17.621,-17.623,-17.626,-17.628,  10.4
     5        -17.635,-17.621,-17.611,-17.605,-17.601,-17.600,-17.599,  10.5
     5-17.599,-17.601,-17.602,-17.604,-17.607,-17.609,-17.612,-17.615,  10.5
     6        -17.596,-17.585,-17.579,-17.576,-17.575,-17.575,-17.576,  10.6
     6-17.578,-17.580,-17.582,-17.585,-17.588,-17.591,-17.595,-17.598,  10.6
     7        -17.550,-17.544,-17.542,-17.542,-17.544,-17.546,-17.548,  10.7
     7-17.552,-17.555,-17.558,-17.562,-17.566,-17.570,-17.573,-17.577,  10.7
     8        -17.501,-17.500,-17.501,-17.504,-17.508,-17.513,-17.517,  10.8
     8-17.521,-17.526,-17.530,-17.535,-17.539,-17.544,-17.548,-17.553,  10.8
     9        -17.449,-17.452,-17.457,-17.463,-17.470,-17.476,-17.482,  10.9
     9-17.488,-17.493,-17.499,-17.504,-17.509,-17.514,-17.519,-17.524,  10.9
     A        -17.396,-17.403,-17.412,-17.420,-17.429,-17.437,-17.444,  11.0
     A-17.451,-17.458,-17.464,-17.470,-17.476,-17.481,-17.487,-17.492/  11.0
      DATAC10/-17.344,-17.355,-17.366,-17.377,-17.387,-17.396,-17.405,  11.1
     1-17.413,-17.420,-17.427,-17.434,-17.440,-17.446,-17.452,-17.458,  11.1
     2        -17.295,-17.307,-17.321,-17.333,-17.345,-17.355,-17.365,  11.2
     2-17.373,-17.382,-17.389,-17.397,-17.404,-17.410,-17.417,-17.423,  11.2
     3        -17.249,-17.264,-17.278,-17.292,-17.304,-17.316,-17.326,  11.3
     3-17.335,-17.344,-17.352,-17.360,-17.368,-17.375,-17.382,-17.389,  11.3
     4        -17.209,-17.225,-17.241,-17.255,-17.268,-17.280,-17.291,  11.4
     4-17.301,-17.310,-17.319,-17.327,-17.335,-17.343,-17.350,-17.357,  11.4
     5        -17.177,-17.194,-17.210,-17.225,-17.239,-17.251,-17.262,  11.5
     5-17.272,-17.282,-17.291,-17.300,-17.308,-17.316,-17.324,-17.331,  11.5
     6        -17.154,-17.172,-17.189,-17.204,-17.218,-17.230,-17.242,  11.6
     6-17.252,-17.262,-17.272,-17.280,-17.289,-17.298,-17.306,-17.314,  11.6
     7        -17.144,-17.162,-17.179,-17.194,-17.208,-17.220,-17.232,  11.7
     7-17.242,-17.253,-17.262,-17.271,-17.280,-17.289,-17.297,-17.306,  11.7
     8        -17.146,-17.164,-17.181,-17.196,-17.210,-17.222,-17.234,  11.8
     8-17.245,-17.255,-17.265,-17.274,-17.283,-17.292,-17.301,-17.309,  11.8
     9        -17.163,-17.180,-17.197,-17.212,-17.225,-17.237,-17.249,  11.9
     9-17.260,-17.270,-17.280,-17.289,-17.298,-17.307,-17.316,-17.325,  11.9
     A        -17.193,-17.211,-17.227,-17.241,-17.254,-17.266,-17.277,  12.0
     A-17.288,-17.298,-17.308,-17.317,-17.327,-17.336,-17.345,-17.353/  12.0
      DATAC11/-17.239,-17.256,-17.271,-17.284,-17.297,-17.309,-17.320,  12.1
     1-17.330,-17.340,-17.350,-17.359,-17.369,-17.378,-17.387,-17.395,  12.1
     2        -17.299,-17.315,-17.329,-17.342,-17.354,-17.365,-17.376,  12.2
     2-17.386,-17.396,-17.405,-17.415,-17.424,-17.433,-17.442,-17.451,  12.2
     3        -17.373,-17.388,-17.402,-17.414,-17.425,-17.436,-17.446,  12.3
     3-17.456,-17.466,-17.475,-17.484,-17.493,-17.502,-17.511,-17.520,  12.3
     4        -17.462,-17.476,-17.489,-17.500,-17.511,-17.521,-17.531,  12.4
     4-17.541,-17.550,-17.559,-17.569,-17.578,-17.587,-17.595,-17.604,  12.4
     5        -17.567,-17.581,-17.592,-17.603,-17.613,-17.623,-17.632,  12.5
     5-17.641,-17.651,-17.660,-17.669,-17.678,-17.686,-17.695,-17.704,  12.5
     6        -17.689,-17.701,-17.712,-17.722,-17.732,-17.741,-17.750,  12.6
     6-17.759,-17.768,-17.777,-17.786,-17.795,-17.803,-17.812,-17.821,  12.6
     7        -17.829,-17.840,-17.851,-17.860,-17.869,-17.878,-17.887,  12.7
     7-17.896,-17.904,-17.913,-17.922,-17.930,-17.939,-17.948,-17.956,  12.7
     8        -17.988,-18.000,-18.010,-18.019,-18.028,-18.036,-18.045,  12.8
     8-18.053,-18.062,-18.070,-18.079,-18.087,-18.096,-18.104,-18.112,  12.8
     9        -18.171,-18.183,-18.192,-18.201,-18.210,-18.218,-18.227,  12.9
     9-18.235,-18.243,-18.252,-18.260,-18.268,-18.277,-18.285,-18.293,  12.9
     A        -18.381,-18.393,-18.403,-18.413,-18.422,-18.430,-18.438,  13.0
     A-18.447,-18.455,-18.463,-18.471,-18.479,-18.487,-18.495,-18.503/  13.0
      DATAC12/-18.625,-18.638,-18.650,-18.660,-18.669,-18.678,-18.687,  13.1
     1-18.695,-18.703,-18.711,-18.719,-18.726,-18.734,-18.742,-18.750,  13.1
     2        -18.912,-18.929,-18.943,-18.955,-18.966,-18.975,-18.984,  13.2
     2-18.993,-19.001,-19.008,-19.016,-19.023,-19.031,-19.038,-19.045,  13.2
     3        -19.260,-19.283,-19.303,-19.320,-19.333,-19.345,-19.355,  13.3
     3-19.364,-19.372,-19.380,-19.387,-19.394,-19.400,-19.407,-19.413,  13.3
     4        -19.704,-19.740,-19.771,-19.796,-19.816,-19.832,-19.845,  13.4
     4-19.855,-19.863,-19.870,-19.876,-19.882,-19.887,-19.892,-19.897,  13.4
     5        -20.339,-20.386,-20.424,-20.454,-20.476,-20.492,-20.502,  13.5
     5-20.509,-20.513,-20.516,-20.518,-20.520,-20.521,-20.523,-20.524,  13.5
     6        -21.052,-21.075,-21.093,-21.105,-21.114,-21.120,-21.123,  13.6
     6-21.125,-21.126,-21.127,-21.128,-21.130,-21.131,-21.133,-21.135,  13.6
     7        -21.174,-21.203,-21.230,-21.255,-21.278,-21.299,-21.320,  13.7
     7-21.339,-21.357,-21.375,-21.392,-21.408,-21.424,-21.439,-21.454,  13.7
     8        -21.285,-21.317,-21.346,-21.372,-21.395,-21.416,-21.435,  13.8
     8-21.452,-21.468,-21.483,-21.497,-21.511,-21.524,-21.536,-21.548,  13.8
     9        -21.396,-21.429,-21.459,-21.486,-21.511,-21.532,-21.551,  13.9
     9-21.569,-21.585,-21.600,-21.614,-21.627,-21.640,-21.652,-21.663,  13.9
     A        -21.516,-21.549,-21.580,-21.609,-21.635,-21.658,-21.678,  14.0
     A-21.696,-21.713,-21.728,-21.742,-21.755,-21.767,-21.779,-21.790/  14.0
      DATAC13/-21.651,-21.681,-21.711,-21.738,-21.763,-21.785,-21.804,  14.1
     1-21.821,-21.837,-21.851,-21.864,-21.876,-21.887,-21.898,-21.908,  14.1
     2        -21.810,-21.831,-21.853,-21.874,-21.893,-21.910,-21.925,  14.2
     2-21.938,-21.950,-21.961,-21.971,-21.980,-21.989,-21.998,-22.006,  14.2
     3        -22.009,-22.016,-22.026,-22.037,-22.048,-22.058,-22.066,  14.3
     3-22.074,-22.081,-22.088,-22.094,-22.099,-22.105,-22.111,-22.117,  14.3
     4        -22.353,-22.317,-22.296,-22.284,-22.276,-22.270,-22.266,  14.4
     4-22.262,-22.260,-22.258,-22.257,-22.257,-22.257,-22.258,-22.259,  14.4
     5        -22.705,-22.609,-22.552,-22.515,-22.488,-22.468,-22.451,  14.5
     5-22.438,-22.427,-22.418,-22.410,-22.405,-22.400,-22.397,-22.395,  14.5
     6        -22.889,-22.791,-22.731,-22.690,-22.659,-22.634,-22.612,  14.6
     6-22.594,-22.579,-22.566,-22.555,-22.546,-22.539,-22.533,-22.528,  14.6
     7        -23.211,-23.109,-23.041,-22.989,-22.945,-22.906,-22.872,  14.7
     7-22.842,-22.816,-22.793,-22.774,-22.757,-22.743,-22.732,-22.722,  14.7
     8        -25.312,-24.669,-24.250,-23.959,-23.746,-23.587,-23.463,  14.8
     8-23.366,-23.288,-23.225,-23.173,-23.131,-23.095,-23.066,-23.041,  14.8
     9        -25.394,-24.752,-24.333,-24.041,-23.829,-23.669,-23.546,  14.9
     9-23.449,-23.371,-23.308,-23.256,-23.214,-23.178,-23.149,-23.124,  14.9
     A        -25.430,-24.787,-24.369,-24.077,-23.865,-23.705,-23.582,  15.0
     A-23.484,-23.407,-23.344,-23.292,-23.249,-23.214,-23.185,-23.160/  15.0
      DATA PARTOH/
     1   145.979,  178.033,  211.618,  247.053,  284.584,  324.398,
     2   366.639,  411.425,  458.854,  509.012,  561.976,  617.823,
     3   676.626,  738.448,  803.363,  871.437,  942.735, 1017.330,
     4  1095.284, 1176.654, 1261.510, 1349.898, 1441.875, 1537.483,
     5  1636.753, 1739.733, 1846.434, 1956.883, 2071.080, 2189.029,
     6  2310.724, 2436.155, 2565.283, 2698.103, 2834.571, 2974.627,
     7  3118.242, 3265.366, 3415.912, 3569.837, 3727.077/
      DATA FREQ1/0./
   10 OHOP=0.
      IF(FREQ.EQ.FREQ1)GO TO 30
      FREQ1=FREQ
      WAVENO=FREQ/2.99792458E10
      EVOLT=WAVENO/8065.479
      N=EVOLT*10.-20.
      EN=FLOAT(N)*.1+2.
      IF(N.LE.0)RETURN
      IF(N.GE.130)RETURN
      DO 21 IT=1,15
   21 CROSSOHT(IT)=(CROSSOH(IT,N)+(CROSSOH(IT,N+1)-CROSSOH(IT,N))*
     1(EVOLT-EN)/.1)
C      PRINT 26,CROSSOHT
C   26 FORMAT(3H0OH,15F8.3)
   30 IF(T(J).GE.9000.)RETURN
      IF(N.LE.0)RETURN
      IF(N.GE.130)RETURN
      IT=(T(J)-1000.)/200.+1.
      IT=MAX0(IT,1)
      TN=FLOAT(IT)*200.+800.
      PART=PARTOH(IT)+(PARTOH(IT+1)-PARTOH(IT))*(T(J)-TN)/200.
      IT=(T(J)-2000.)/500.+1.
      IT=MAX0(IT,1)
      TN=FLOAT(IT)*500.+1500.
      OHOP=EXP((CROSSOHT(IT)+(CROSSOHT(IT+1)-CROSSOHT(IT))*
     1(T(J)-TN)/500.)*2.30258509299405E0)*PART
      RETURN
      END
      SUBROUTINE LUKEOP
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     SI2,MG2,CA2,N1,O1
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /OPS/D1(kw,9),ALUKE(kw),D2(kw,15)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      COMMON /XNFP/XNFPC(kw,4),XNFPN(kw,5),XNFPO(kw,6),XNFPNE(kw,6),
     1             XNFPAL(kw,1),XNFPMG(kw,2),XNFPSI(kw,2),XNFPCA(kw,2),
     2             XNFPFE(kw,1),XNFPCH(kw),XNFPOH(kw)
      REAL*8 N1OP,MG2OP
      DO 11 J=1,NRHOX
   11 ALUKE(J)=(N1OP(J)*XNFPN(J,1)+O1OP(J)*XNFPO(J,1)+MG2OP(J)*
     1XNFPMG(J,2)+SI2OP(J)*XNFPSI(J,2)+CA2OP(J)*XNFPCA(J,2))*
     2STIM(J)/RHO(J)
      RETURN
      END
      FUNCTION N1OP(J)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     CROSS-SECTION TIMES PARTITION FUNCTION
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      REAL*8 N1OP
      DIMENSION C1130(kw),C1020(kw)
      DATA FREQ1,ITEMP1/0.,0/
      IF(ITEMP.EQ.ITEMP1)GO TO 30
      ITEMP1=ITEMP
      DO 20 K=1,NRHOX
      C1130(K)=6.*EXP(-3.575/TKEV(K))
   20 C1020(K)=10.*EXP(-2.384/TKEV(K))
   30 IF(FREQ.EQ.FREQ1)GO TO 40
      X1130=0.
      X1020=0.
      X853=0.
      IF(FREQ.GE.3.517915E15)X853=
     1SEATON(3.517915D15,1.142D-17,2.D0,4.29D0)
      IF(FREQ.GE.2.941534E15)X1020=
     1SEATON(2.941534D15,4.41D-18,1.5D0,3.85D0)
      IF(FREQ.GE.2.653317E15)X1130=
     1SEATON(2.653317D15,4.2D-18,1.5D0,4.34D0)
      FREQ1=FREQ
   40 N1OP=X853*4.+X1020*C1020(J)+X1130*C1130(J)
      RETURN
      END
      FUNCTION O1OP(J)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     FROM DEANE PETERSON AFTER PEACH
C     CROSS-SECTION TIMES PARTITION FUNCTION
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      DATA FREQ1/0./
      IF(FREQ.EQ.FREQ1)GO TO 1
      X911=0.
      IF(FREQ.GE.3.28805E15)X911=
     1SEATON(3.28805D15,2.94D-18,1.D0,2.66D0)
      FREQ1=FREQ
    1 O1OP=X911*9.
      RETURN
      END
      FUNCTION MG2OP(J)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     CROSS-SECTION TIMES PARTITION FUNCTION
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      REAL MG2OP
      DIMENSION C1169(kw)
      DATA FREQ1,ITEMP1/0.,0/
      IF(ITEMP.EQ.ITEMP1)GO TO 30
      ITEMP1=ITEMP
      DO 20 K=1,NRHOX
   20 C1169(K)=6.*EXP(-4.43/TKEV(K))
   30 IF(FREQ.EQ.FREQ1)GO TO 40
      X1169=0.
      X824=0.
      IF(FREQ.GE.3.635492E15)X824=
     1SEATON(3.635492D15,1.40D-19,4.D0,6.7D0)
      IF(FREQ.GE.2.564306E15)X1169=5.11E-19*(2.564306E15/FREQ)**3
      FREQ1=FREQ
   40 MG2OP=X824*2.+X1169*C1169(J)
      RETURN
      END
      FUNCTION SI2OP(J)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     CROSS-SECTION TIMES THE PARTITION FUNCTION
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      DIMENSION FLOG(9),FREQSI(7),PEACH(6,14),X(6),TLG(6),DT(kw),NT(kw)
      DATA PEACH/
C         10000     12000     14000     16000     18000     20000       WAVE(A)
     1  -43.8941, -43.8941, -43.8941, -43.8941, -43.8941, -43.8941,      500
     2  -42.2444, -42.2444, -42.2444, -42.2444, -42.2444, -42.2444,      600
     3  -40.6054, -40.6054, -40.6054, -40.6054, -40.6054, -40.6054,      759
     4  -54.2389, -52.2906, -50.8799, -49.8033, -48.9485, -48.2490,      760
     5  -50.4108, -48.4892, -47.1090, -46.0672, -45.2510, -44.5933,     1905
     6  -52.0936, -50.0741, -48.5999, -47.4676, -46.5649, -45.8246,     1906
     7  -51.9548, -49.9371, -48.4647, -47.3340, -46.4333, -45.6947,     1975
     8  -54.2407, -51.7319, -49.9178, -48.5395, -47.4529, -46.5709,     1976
     9  -52.7355, -50.2218, -48.4059, -47.0267, -45.9402, -45.0592,     3245
     T  -53.5387, -50.9189, -49.0200, -47.5750, -46.4341, -45.5082,     3246
     1  -53.2417, -50.6234, -48.7252, -47.2810, -46.1410, -45.2153,     3576
     2  -53.5097, -50.8535, -48.9263, -47.4586, -46.2994, -45.3581,     3577
     3  -54.0561, -51.2365, -49.1980, -47.6497, -46.4302, -45.4414,     3900
     4  -53.8469, -51.0256, -48.9860, -47.4368, -46.2162, -45.2266/     4200
      DATA FREQSI/4.9965417E15,3.9466738E15,1.5736321E15,1.5171539E15,
     1 9.2378947E14,8.3825004E14,7.6869872E14/
C     2P,2D,2P,2D,2P
      DATA FLOG/36.32984,36.14752,35.91165,34.99216,34.95561,34.45951,
     1 34.36234,34.27572,34.20161/
      DATA TLG/9.21034,9.39266,9.54681,9.68034,9.79813,9.90349/
      DATA FREQ1,ITEMP1/0.,0/
      IF(ITEMP.EQ.ITEMP1)GO TO 20
      ITEMP1=ITEMP
      DO 11 K=1,NRHOX
      N=MAX0(MIN0(5, INT(T(K)/2000.)-4),1)
      NT(K)=N
   11 DT(K)=(TLOG(K)-TLG(N))/(TLG(N+1)-TLG(N))
      GO TO 21
   20 IF(FREQ.EQ.FREQ1)GO TO 30
   21 FREQ1=FREQ
      DO 22 N=1,7
      IF(FREQ.GT.FREQSI(N))GO TO 23
   22 CONTINUE
      N=8
   23 D=(FREQLG-FLOG(N))/(FLOG(N+1)-FLOG(N))
      IF(N.GT.2)N=2*N-2
      IF(N.EQ.14)N=13
      D1=1.-D
      DO 24 IT=1,6
   24 X(IT)=PEACH(IT,N+1)*D+PEACH(IT,N)*D1
   30 N=NT(J)
      SI2OP=EXP(X(N)*(1.-DT(J))+X(N+1)*DT(J))*6.
      RETURN
      END
      FUNCTION CA2OP(J)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     CROSS-SECTION TIMES THE PARTITION FUNCTION
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      DIMENSION C1218(kw),C1420(kw)
      DATA FREQ1,ITEMP1/0.,0/
      IF(ITEMP.EQ.ITEMP1)GO TO 30
      ITEMP1=ITEMP
      DO 20 K=1,NRHOX
      C1218(K)=10.*EXP(-1.697/TKEV(K))
   20 C1420(K)=6.*EXP(-3.142/TKEV(K))
   30 IF(FREQ.EQ.FREQ1)GO TO 40
      X1420=0.
      X1218=0.
      X1044=0.
      IF(FREQ.GE.2.870454E15)X1044=5.4E-20*(2.870454E15/FREQ)**3
      IF(FREQ.GE.2.460127E15)X1218=1.64E-17*SQRT(2.460127E15/FREQ)
      IF(FREQ.GE.2.110779E15)X1420=
     1SEATON(2.110779D15,4.13D-18,3.D0,.69D0)
      FREQ1=FREQ
   40 CA2OP=X1044*2.+X1218*C1218(J)+X1420*C1420(J)
      RETURN
      END
      SUBROUTINE HOTOP
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /OPS/D1(kw,10),AHOT(kw),D2(kw,14)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      COMMON /XNF/XNFC(kw,6),XNFN(kw,6),XNFO(kw,6),XNFNE(kw,6),
     1            XNFMG(kw,6),XNFSI(kw,6),XNFS(kw,6),XNFFE(kw,5)
C     COMMON /XNFP/XNFPC(kw,4),XNFPN(kw,5),XNFPO(kw,6),XNFPNE(kw,6),
      COMMON /XNFP/XNFP(kw,21),
     1             XNFPAL(kw,1),XNFPMG(kw,2),XNFPSI(kw,2),XNFPCA(kw,2),
     2             XNFPFE(kw,1),XNFPCH(kw),XNFPOH(kw)
      DIMENSION AC2OP(kw),AC3OP(kw),AC4OP(kw)
      DIMENSION AN2OP(kw),AN3OP(kw),AN4OP(kw),AN5OP(kw)
      DIMENSION AO2OP(kw),AO3OP(kw),AO4OP(kw),AO5OP(kw),AO6OP(kw)
      DIMENSION A(420)
      DIMENSION A1(63),A2(63),A3(63),A4(63),A5(63),A6(63),A7(42)
      EQUIVALENCE (A(1),A1(1)),(A(64),A2(1)),(A(127),A3(1))
      EQUIVALENCE (A(190),A4(1)),(A(253),A5(1)),(A(316),A6(1))
      EQUIVALENCE (A(379),A7(1))
      DATA A1/
     1 4.149945E15, 6.90E-18, 1.000, 6.,  6.,  13.71,  2.,              6.01
     2 4.574341E15, 2.50E-18, 1.000, 4.,  2.,  11.96,  2.,              6.01
     3 5.220770E15, 1.08E-17, 1.000, 4., 10.,   9.28,  2.,              6.01
     4 5.222307E15, 5.35E-18, 3.769, 2.,  1.,   0.00, 16.,              10.00
     5 5.892577E15, 4.60E-18, 1.950, 6.,  6.,   0.00,  2.,              6.01
     6 6.177022E15, 3.50E-18, 1.000, 4., 12.,   5.33,  2.,              6.01
     7 6.181062E15, 6.75E-18, 3.101, 5.,  1.,   4.05,  6.,              7.01
     8 6.701879E15, 6.65E-18, 2.789, 5.,  5.,   1.90,  6.,              7.01
     9 7.158382E15, 6.65E-18, 2.860, 6.,  9.,   0.00,  6./              7.01
      DATA A2/
     1 7.284488E15, 3.43E-18, 4.174, 5.,  6.,   5.02, 11.,              8.01
     2 7.693612E15, 3.53E-18, 3.808, 5., 10.,   3.33, 11.,              8.01
     3 7.885955E15, 2.32E-18, 3.110, 5.,  6.,   5.02, 11.,              8.01
     4 8.295079E15, 3.97E-18, 3.033, 5., 10.,   3.33, 11.,              8.01
     5 8.497686E15, 7.32E-18, 3.837, 5.,  4.,   0.00, 11.,              8.01
     6 8.509966E15, 2.00E-18, 1.750, 7.,  3.,  12.69,  3.,              6.02
     7 8.572854E15, 1.68E-18, 3.751, 5.,  6.,   5.02, 11.,              8.01
     8 9.906370E15, 4.16E-18, 2.717, 3.,  6.,   0.00, 17.,              10.01
     9 1.000693E16, 2.40E-18, 1.750, 7.,  9.,   6.50,  3./              6.02
      DATA A3/
     1 1.046078E16, 4.80E-18, 1.000, 4., 10.,  12.53,  7.,              7.02
     2 1.067157E16, 2.71E-18, 2.148, 3.,  6.,   0.00, 17.,              10.01
     3 1.146734E16, 2.06E-18, 1.626, 6.,  6.,   0.00,  7.,              7.02
     4 1.156813E16, 5.20E-19, 2.126, 3.,  6.,   0.00, 17.,              10.01
     5 1.157840E16, 9.10E-19, 4.750, 4.,  1.,   0.00,  3.,              6.02
     6 1.177220E16, 5.30E-18, 1.000, 4., 12.,   7.10,  7.,              7.02
     7 1.198813E16, 3.97E-18, 2.780, 6.,  1.,   5.35, 12.,              8.02
     8 1.325920E16, 3.79E-18, 2.777, 6.,  5.,   2.51, 12.,              8.02
     9 1.327649E16, 3.65E-18, 2.014, 6.,  9.,   0.00, 12./              8.02
      DATA A4/
     1 1.361466E16, 7.00E-18, 1.000, 2.,  5.,   7.48, 12.,              8.02
     2 1.365932E16, 9.30E-19, 1.500, 7.,  6.,   8.00,  4.,              6.03
     3 1.481487E16, 1.10E-18, 1.750, 7.,  3.,  16.20,  8.,              7.03
     4 1.490032E16, 5.49E-18, 3.000, 5.,  1.,   6.91, 18.,              10.02
     5 1.533389E16, 1.80E-18, 2.277, 4.,  9.,   0.00, 18.,              10.02
     6 1.559452E16, 8.70E-19, 3.000, 6.,  2.,   0.00,  4.,              6.03
     7 1.579688E16, 4.17E-18, 2.074, 4.,  5.,   3.20, 18.,              10.02
     8 1.643205E16, 1.39E-18, 2.792, 5.,  5.,   3.20, 18.,              10.02
     9 1.656208E16, 2.50E-18, 2.346, 5.,  9.,   0.00, 18./              10.02
      DATA A5/
     1 1.671401E16, 1.30E-18, 1.750, 7.,  9.,   8.35,  8.,              7.03
     2 1.719725E16, 1.48E-18, 2.225, 5.,  9.,   0.00, 18.,              10.02
     3 1.737839E16, 2.70E-18, 1.000, 4., 10.,  15.74, 13.,              8.03
     4 1.871079E16, 1.27E-18,  .831, 6.,  6.,   0.00, 13.,              8.03
     5 1.873298E16, 9.10E-19, 3.000, 4.,  1.,   0.00,  8.,              7.03
     6 1.903597E16, 2.90E-18, 1.000, 4., 12.,   8.88, 13.,              8.03
     7 2.060738E16, 4.60E-18, 1.000, 3., 12.,  22.84, 19.,              10.03
     8 2.125492E16, 5.90E-19, 1.000, 6.,  6.,   9.99,  9.,              7.04
     9 2.162610E16, 1.69E-18, 1.937, 5.,  6.,   7.71, 19./              10.03
      DATA A6/
     1 2.226127E16, 1.69E-18, 1.841, 5., 10.,   5.08, 19.,              10.03
     2 2.251163E16, 9.30E-19, 2.455, 6.,  6.,   7.71, 19.,              10.03
     3 2.278001E16, 7.90E-19, 1.000, 6.,  9.,  10.20, 14.,              8.04
     4 2.317678E16, 1.65E-18, 2.277, 6., 10.,   5.08, 19.,              10.03
     5 2.348946E16, 3.11E-18, 1.963, 6.,  4.,   0.00, 19.,              10.03
     6 2.351911E16, 7.30E-19, 1.486, 5.,  6.,   7.71, 19.,              10.03
     7 2.366973E16, 5.00E-19, 1.000, 4.,  2.,   0.00,  9.,              7.04
     8 2.507544E16, 6.90E-19, 1.000, 6.,  3.,  19.69, 14.,              8.04
     9 2.754065E16, 7.60E-19, 1.000, 2.,  1.,   0.00, 14./              8.04
      DATA A7/
     1 2.864850E16, 1.54E-18, 2.104, 6.,  1.,   7.92, 20.,              10.04
     2 2.965598E16, 1.53E-18, 2.021, 6.,  5.,   3.76, 20.,              10.04
     3 3.054151E16, 1.40E-18, 1.471, 6.,  9.,   0.00, 20.,              10.04
     4 3.085141E16, 2.80E-18, 1.000, 4.,  5.,  11.01, 20.,              10.04
     5 3.339687E16, 3.60E-19, 1.000, 6.,  2.,   0.00, 15.,              8.05
     6 3.818757E16, 4.90E-19, 1.145, 6.,  6.,   0.00, 21./              10.05
      DATA NUM/60/
C      IF(FREQ.LT.A(1))RETURN
C
C     FREE-FREE
      DO 200 J=1,NRHOX
      FREE=COULFF(J,1)*1.**2*(XNFC(J,2)+XNFN(J,2)+XNFO(J,2)+XNFNE(J,2)+
     1                     XNFMG(J,2)+XNFSI(J,2)+XNFS(J,2)+XNFFE(J,2))+
     2     COULFF(J,2)*2.**2*(XNFC(J,3)+XNFN(J,3)+XNFO(J,3)+XNFNE(J,3)+
     3                     XNFMG(J,3)+XNFSI(J,3)+XNFS(J,3)+XNFFE(J,3))+
     4     COULFF(J,3)*3.**2*(XNFC(J,4)+XNFN(J,4)+XNFO(J,4)+XNFNE(J,4)+
     5                     XNFMG(J,4)+XNFSI(J,4)+XNFS(J,4)+XNFFE(J,4))+
     6     COULFF(J,4)*4.**2*(XNFC(J,5)+XNFN(J,5)+XNFO(J,5)+XNFNE(J,5)+
     7                     XNFMG(J,5)+XNFSI(J,5)+XNFS(J,5)+XNFFE(J,5))+
     8     COULFF(J,5)*5.**2*(XNFC(J,6)+XNFN(J,6)+XNFO(J,6)+XNFNE(J,6)+
     9                       XNFMG(J,6)+XNFSI(J,6)+XNFS(J,6)          )
  200 AHOT(J)=FREE*3.6919E8/FREQ**3*XNE(J)/SQRT(T(J))
C
C
      DO 700 J=1,NRHOX
      AC2OP(J)=0.
      AC3OP(J)=0.
      AC4OP(J)=0.
      AN2OP(J)=0.
      AN3OP(J)=0.
      AN4OP(J)=0.
      AN5OP(J)=0.
      AO2OP(J)=0.
      AO3OP(J)=0.
      AO4OP(J)=0.
      AO5OP(J)=0.
      AO6OP(J)=0.
  700 CONTINUE
      CALL C2OP(AC2OP)
      CALL C3OP(AC3OP)
      CALL C4OP(AC4OP)
      CALL N2OP(AN2OP)
      CALL N3OP(AN3OP)
      CALL N4OP(AN4OP)
      CALL N5OP(AN5OP)
      CALL O2OP(AO2OP)
      CALL O3OP(AO3OP)
      CALL O4OP(AO4OP)
      CALL O5OP(AO5OP)
      CALL O6OP(AO6OP)
      DO 701 J=1,NRHOX
  701 AHOT(J)=AHOT(J)+
     1 AC2OP(J)+AC3OP(J)+AC4OP(J)+
     2 AN2OP(J)+AN3OP(J)+AN4OP(J)+AN5OP(J)+
     3 AO2OP(J)+AO3OP(J)+AO4OP(J)+AO5OP(J)+AO6OP(J)
C
C
      L=-6
      DO 20 I=1,NUM
      L=L+7
      IF(FREQ.LT.A(L))GO TO 20
      XSECT=A(L+1)*(A(L+2)+(A(L)/FREQ)-A(L+2)*(A(L)/FREQ))*
     1 SQRT((A(L)/FREQ)** INT(A(L+3)))
      ID=A(L+6)
      DO 10 J=1,NRHOX
      XX=XSECT*XNFP(J,ID)*A(L+4)
      IF(XX.GT.AHOT(J)/100.)AHOT(J)=AHOT(J)+XX/EXP(A(L+5)/TKEV(J))
   10 CONTINUE
   20 CONTINUE
      DO 30 J=1,NRHOX
   30 AHOT(J)=AHOT(J)*STIM(J)/RHO(J)
      RETURN
      END
      SUBROUTINE C2OP(AC2OP)
      RETURN
      END
      SUBROUTINE C3OP(AC3OP)
      RETURN
      END
      SUBROUTINE C4OP(AC4OP)
      RETURN
      END
      SUBROUTINE N2OP(AN2OP)
      RETURN
      END
      SUBROUTINE N3OP(AN3OP)
      RETURN
      END
      SUBROUTINE N4OP(AN4OP)
      RETURN
      END
      SUBROUTINE N5OP(AN5OP)
      RETURN
      END
      SUBROUTINE O2OP(AO2OP)
      RETURN
      END
      SUBROUTINE O3OP(AO3OP)
      RETURN
      END
      SUBROUTINE O4OP(AO4OP)
      RETURN
      END
      SUBROUTINE O5OP(AO5OP)
      RETURN
      END
      SUBROUTINE O6OP(AO6OP)
      RETURN
      END
      SUBROUTINE ELECOP
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /OPS/D1(kw,11),SIGEL(kw),D2(kw,13)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      DO 1 J=1,NRHOX
    1 SIGEL(J)=.6653E-24*XNE(J)/RHO(J)
      RETURN
      END
      SUBROUTINE H2RAOP
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /DEPART/BHYD(kw,6),BMIN(kw),NLTEON
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /IONS/XNFPH(kw,2),XNFPHE(kw,3),XNFH(kw,2),XNFHE(kw,3)
      COMMON /OPS/D1(kw,12),SIGH2(kw),D2(kw,12)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      DIMENSION XNH2(kw)
      DATA ITEMP1/0/
      IF(ITEMP.EQ.ITEMP1)GO TO 20
      ITEMP1=ITEMP
      DO 11 J=1,NRHOX
   11 XNH2(J)=(XNFPH(J,1)*2.*BHYD(J,1))**2*EXP(4.477/TKEV(J)-4.6628E1+
     1(1.8031E-3+(-5.0239E-7+(8.1424E-11-5.0501E-15*T(J))*T(J))*T(J))*
     2T(J)-1.5*TLOG(J))/RHO(J)
   20 WAVE=2.997925E18/DMIN1(FREQ,2.922D15)
      WW=WAVE**2
      SIG=(8.14E-13+1.28E-6/WW+1.61/(WW*WW))/(WW*WW)
      DO 21 J=1,NRHOX
   21 SIGH2(J)=SIG*XNH2(J)
      RETURN
      END
      SUBROUTINE HLINOP
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
C     REQUIRES STARK AND COULX
      COMMON /DEPART/BHYD(kw,6),BMIN(kw),NLTEON
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /IONS/XNFPH(kw,2),XNFPHE(kw,3),XNFH(kw,2),XNFHE(kw,3)
      COMMON /OPS/D1(kw,13),AHLINE(kw),D2(kw,8),SHLINE(kw),D3(kw,2)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      DIMENSION BOLT(kw,4),MLAST(kw)
      DATA ITEMP1/0/
      IF(ITEMP.EQ.ITEMP1)GO TO 20
      DO 10 J=1,NRHOX
      MLAST(J)=1100./XNE(J)**.133333333
      DO 10 N=1,4
   10 BOLT(J,N)=EXP(-(13.595-13.595/DFLOAT(N*N))/TKEV(J))*2.*
     1DFLOAT(N*N)*BHYD(J,N)*XNFPH(J,1)/RHO(J)
      ITEMP1=ITEMP
   20 N=SQRT(3.28805E15/FREQ)
      IF(N.EQ.0.OR.N.GT.4)RETURN
      GO TO (21,22,30,30),N
   21 IF(FREQ.LT.2.E15)RETURN
      GO TO 30
   22 IF(FREQ.LT.4.44E14)RETURN
   30 MFREQ=SQRT(3.28805E15/(3.28805E15/DFLOAT(N*N)-FREQ))
      DO 50 J=1,NRHOX
      M1=MFREQ
      M2=M1+1
      M1=MAX0(M1,N+1)
      H=0.
      S=0.
      IF(M1.LE.6)GO TO 39
      IF(M1.GT.MLAST(J))GO TO 45
      M1=M1-1
      M2=M2+3
      IF(N.LT.4.OR.M1.GT.8)GO TO 39
      H=STARK(3,4,J)*(1.-EHVKT(J)*BHYD(J,4)/BHYD(J,3))*BOLT(J,3)
      S=H*BNU(J)*STIM(J)/(BHYD(J,3)/BHYD(J,4)-EHVKT(J))
   39 DO 40 M=M1,M2
      BHYDJM=1.
      IF(M.LE.6)BHYDJM=BHYD(J,M)
C     ASSUMING FREQ APROXIMATELY FREQNM
      A=STARK(N,M,J)*(1.-EHVKT(J)*BHYDJM/BHYD(J,N))*BOLT(J,N)
      H=H+A
   40 S=S+A*BNU(J)*STIM(J)/(BHYD(J,N)/BHYDJM-EHVKT(J))
      AHLINE(J)=H
      SHLINE(J)=S/H
      GO TO 50
   45 AHLINE(J)=COULX(N,3.28806E15/DFLOAT(N*N),1.D0)*(1.-EHVKT(J)/
     1BHYD(J,N))*BOLT(J,N)
      SHLINE(J)=BNU(J)*STIM(J)/(BHYD(J,N)-EHVKT(J))
   50 CONTINUE
      RETURN
      END
      FUNCTION STARK(N,M,J)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw)
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP
      DIMENSION F0(kw)
      DIMENSION KNMTAB(5,4),FSTARK(10,4)
      REAL*8 NN,MM,IMPACT,KNM,KNMTAB
      DATA KNMTAB/.000356,.000523,.00109,.00149,.00225,.0125,.0177,.028,
     1.0348,.0493,.124,.171,.223,.261,.342,.683,.866,1.02,1.19,1.46/
      DATA FSTARK/.1387,.07910,.02126,.01394,.006462,.004814,.002779,
     1 .002216,.001443,.001201,.3921,.1193,.03766,.02209,.01139,
     2 .008036,.005007,.003850,.002658,.002151,.6103,.1506,.04931,
     3 .02768,.01485,.01023,.006588,.004996,.003542,.002838,.8163,.1788,
     4 .05985,.03189,.01762,.01196,.007825,.005882,.004233,.003375/
C     IF YOUR RYDBERG IS DIFFERENT YOU MAY GET LINES IN STRANGE PLACES
      DATA RYD/3.28805E15/
      DATA ITEMP1/0/
      EXINT(X)=-DLOG(X)-.57516+(.97996-(.21654-(.033572-(.0029222-
     1 1.05439E-4*X)*X)*X)*X)*X
      IF(ITEMP.EQ.ITEMP1)GO TO 20
      DO 10 K=1,NRHOX
   10 F0(K)=1.25E-9*XNE(K)**.6666667
      ITEMP1=ITEMP
   20 XN=N
      XM=M
      X=XN/XM
      XX=X**2
      NN=N*N
      MM=M*M
      MMINN=M-N
      IF(MMINN.GT.5)GO TO 21
      KNM=KNMTAB(MMINN,N)
      GO TO 22
   21 KNM=5.5E-5*(NN*MM)**2/(MM-NN)
   22 IF(MMINN.GT.10)GO TO 23
      FNM=FSTARK(MMINN,N)
      GO TO 30
   23 FNM=FSTARK(10,N)*((20.*XN+100.)/(XN+10.)/XM/(1.-XX))**3
   30 FREQNM=RYD*(1./NN-1./MM)
      DEL=ABS(FREQ-FREQNM)
      DBETA=2.997925E18/FREQNM**2/F0(J)/KNM
      BETA=DBETA*DEL
      Y1=MM*DEL*HKT(J)/2.
      Y2=(3.14159*3.14159/2./.0265384/2.997925E10)*DEL**2/XNE(J)
      QSTAT=1.5+.5*(Y1**2-1.384)/(Y1**2+1.384)
      IMPACT=0.
      IF(Y1.GT.8..OR.Y1.GE.Y2)GO TO 40
      EXY2=0.
      IF(Y2.LE.8.)EXY2=EXINT(Y2)
      IMPACT=1.438*SQRT(Y1*(1.-XX))*(.4*EXP(-Y1)+EXINT(Y1)-.5*EXY2)
   40 IF(BETA.GT.20.)GO TO 45
      PROF=8./(80.+BETA**3)
      RATIO=QSTAT+IMPACT
      GO TO 50
   45 PROF=1.5/BETA/BETA/SQRT(BETA)
      DIOI=6.28*1.48E-25*(2.*MM*RYD/DEL)*XNE(J)*(SQRT(2.*MM*RYD/DEL)*
     1(1.3*QSTAT+.30*IMPACT)-3.9*RYD*HKT(J))
      RATIO=QSTAT*DMIN1(1.+DIOI,1.25D0)+IMPACT
   50 STARK=.0265384*FNM*PROF*DBETA*RATIO
      RETURN
      END
