************************************************************************
*       december 2000 (modifications by kjb)
*       Somewhat updated data for Fe Kalpha line, a couple of bugs fixed.
*       Better collision strengths for He-like S, Ca, and Fe
*       (and minor modifications for He-like ions for several other 
*       elements).
*************************************************************************
c       february 1995 (modifications by kjb)
c       All variables are now defined through implicit statements
c       to allow compilation in xspec
c       emisc: dimensions of output array c modified to allow
c              for separate continua from different elements. 
c
c       emisl:  Fe-L shell lines for Ne- to Li-like ions set to zero.
c
c       block data:  Error in common block "pion" corrected
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c     emiscl (9-81)
c     calc. x-ray line and continuum emiss.
c     this is the most up-to date version
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	block data xdata
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c     ionization potentials in /pion/
c     line energies in /elin/ (9/81)
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	IMPLICIT REAL (A-H,O-Z)
	common /elin/ec(15),en(15),eo(15),ene(20),emg(22),esi(48),
     1  es(70),eca(71),efe(157),eni(133)
	common /pion/pc(6),pn(7),po(8),pne(10),pmg(12),psi(14),ps(16),
     1  pca(20),pfe(26),pni(28)
c	photon energies for lines in kev
	data ec/.364,.436,.463,.470,.477,.069,.091,.024,.299,.304,.308,
     1  .355,.335,.371,.297/
	data en/.500,.593,.626,.639,.649,.094,.126,.033,.420,.426,.431,
     1  .498,.475,.522,.418/
	data eo/.654,.775,.816,.837,.849,.124,.163,.041,.561,.568,.574,
     1  .666,.638,.698,.559/
	data ene/1.022,1.216,1.278,1.308,1.325,0.190,.262,.062,.905,.914,
     1  .921,1.073,1.038,1.127,.120,.126,.141,.902,.127,.892/
	data emg/1.473,1.747,1.851,1.879,1.908,.273,.375,.104,1.331,
     1  1.343,1.352,1.580,1.537,1.660,.188,.196,.214,1.328,.198,1.314,
     2  .165,1.299/
	data esi/2.007,2.376,2.505,2.567,2.600,0.371,.498,.129,1.840,
     1  1.856,1.865,2.183,2.132,2.292,2.348,.272,.281,.303,.400,.096,
*     1  1.854,1.865,2.183,2.132,2.292,2.348,.272,.281,.303,.400,.096,
     2  1.837,1.829,1.828,.237,.252,.258,.268,.283,.380,.086,1.820,
     3  .226,.227,.217,.245,.249,.218,.261,.318,1.802,.201,.224,.225,
     4  1.785,.203,1.770,.180,1.755/
	data es/2.623,3.108,3.280,3.351,3.397,.485,.657,.172,2.430,2.447,
     1  2.461,2.884,2.825,.450,.420,.436,3.033,3.101,.370,.381,.408,
     a  .506,.512,
     2  .538,.124,.124,.130,.138,.591,2.428,2.417,2.417,.330,.347,.347,
     3  .367,.383,.462,.470,.537,.118,.124,.127,2.408,2.378,2.390,.328,
     4  .292,.340,.344,.372,.446,2.387,2.408,2.355,.302,.316,.316,2.349,
     5  .251,.291,.348,2.348,2.338,.281,2.331,.238,2.315,.204,2.315/
	data eca /4.106,4.882,5.167,5.391,5.536,.795,1.061,.285,3.861,
     1  3.883,3.902,4.583,4.518,.716,.675,.699,4.822,4.932,.611,.629,
     a  .660,
     2  .827,.838,.886,.207,.207,.218,.225,.969,3.864,3.861,3.923,.564,
     3  .579,.574,.608,.636,.756,.765,.800,.191,.200,.204,3.837,3.788,
     4  3.808,.551,.348,.579,.564,.614,.761,3.810,3.807,3.759,.451,.549,
     5  .549,.534,.605,3.782,3.818,3.754,.520,3.742,.477,3.733,.431,
     6  3.711,.393,3.708/
	data efe /6.966,8.251,8.700,8.908,9.021,1.287,1.738,.449,6.637,
     1  6.675,6.700,7.881,7.799,1.235,1.171,1.212,8.295,8.487,1.090,
     w  1.107,
     2  1.148,1.480,1.488,1.533,.379,.379,.386,.397,1.715,6.662,6.636,
     3  6.617,1.000,1.051,1.052,1.082,1.123,1.387,1.399,1.467,.350,.365,
     4  .374,.074,6.628,6.544,6.579,1.000,0.892,1.040,1.033,1.078,1.378,
     5  .074,.095,.100,6.583,6.597,6.554,.954,1.008,1.008,.992,1.069,
     6  1.265,.083,.090,.115,6.542,6.553,6.502,.747,.874,.843,.967,
     7  1.008,.958,.904,1.270,.102,6.502,6.541,6.464,.823,.819,.823,
     8  .918,.918,.816,.898,1.148,1.148,.115,6.467,6.503,6.430,.785,
     9  .857,.925,.805,.765,1.016,.119,6.430,6.467,.727,.739,.802,.812,
     a  .826,.897,.113,.129,.133,.140,.976,1.023,6.434,.162,.187,
     b  .195,.227,.246,.262,.292,.307,.334,.709,.725,.805,6.431,.177,
     c  .175,.189,.209,.223,.235,.827,6.424,.210,.175,.161,.130,6.421,
     d  .207,.200,.177,.174,6.414,.174,6.411,.154,6.404,.143,6.401,
     e  .138,6.400/
	data eni /8.034,9.524,10.06,10.27,10.35,1.494,2.026,.536,7.732,
     1  7.766,7.805,9.184,8.946,1.441,1.367,1.417,9.667,9.891,1.278,
     w  1.302,
     2  1.348,1.550,1.560,1.653,.477,.477,.477,.477,2.033,7.749,7.714,
     3  7.712,1.242,1.242,1.278,1.222,1.640,1.653,1.734,0.413,0.431,
     4  .442,.087,7.654,7.557,7.596,1.192,1.060,1.240,1.229,1.330,1.610,
     5  .080,.102,.108,7.607,7.601,7.506,1.127,1.181,1.181,1.166,1.256,
     6  1.459,.091,.098,.124,7.596,7.669,7.541,1.033,1.127,1.159,1.285,
     7  1.259,1.512,.105,7.528,7.588,7.497,1.170,1.170,1.170,1.355,
     8  1.355,1.393,.129,7.496,7.541,7.461,.984,1.069,1.192,1.279,.131,
     9  7.461,7.462,.884,.900,.969,.981,.998,.998,1.148,1.240,7.462,
     a  .207,.235,.244,.281,.297,.334,.336,.381,.411,.879,7.458,.221,
     b  .221,.208,.272,.272,.294,0.935,7.450,.197,7.447,.225,7.439,
     c  .202,7.435,.179,7.510/
c	ionization potentials in ev
	data pc/11.260,24.383,47.887,64.492,392.08,489.98/
	data pn/14.534,29.601,47.448,77.472,97.89,552.06,667.03/
	data po/13.618,35.117,54.934,77.413,113.90,138.12,739.32,871.39/
	data pne/21.564,41.1  ,63.45,97.11,126.21,157.93,207.26,239.09,
     1  1195.8,1362.2/
	data pmg/7.646,15.035,80.143,109.31,141.27,186.51,224.95,265.92,
     1  328.0,367.4,1761.8,1963./
	data psi/8.151,16.345,33.492,45.141,166.77,205.20,246.49,303.10,
     1  351.1,401.4,476.1,523.,2438.,2673./
	data ps/10.360,23.40,34.83,47.30,72.68,88.05,281.00,328.33,379.0,
     1  447.1,504.6,565.,652.,707.,3224.,3494./
	data pca/6.113,11.871,51.2 ,67.3 ,84.5 ,108.78,128.0,147.6,188.8,
     1  211.3,591.9,657.,727.,818.,895.,974.,1087.,1157.,5129.,5470./
	data pfe/7.870,16.16,30.651,54.8,75.5,100.,128.3,151.12,235.0,
     1  262.0,290.3,331.,361.,392.,457.,489.,1265.,1358.,1456.,1582.,
     2  1689.,1799.,1950.,      2045.,8828.,9278./
	data pni/7.635, 18.168, 35.17, 54.9,75.5,108.,134.,164.,193.,
     1  224.6,321.,352.,384.,430.,464.,499.,571.,608.,1546.,1648.,1756.,
     2  1894.,2011.,2131.,2295.,2399.,10280.,10790./
	end
	subroutine emisc(t,ei,c,freq)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c     emisc calculates the continuum x-ray emissivity of a hot, low
c     density, optically thin gas, including free-free, free-bound,
c     and two-photon emission, in ergs/kev*cm**3*sec. (9/81).
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	IMPLICIT REAL (A-H,O-Z)
	IMPLICIT INTEGER (I-N)
	integer nfreq
	parameter (nfreq=69)
	integer nelem
	parameter(nelem=10)
	integer nion,nionp,nionm
	parameter (nion=157,nionp=nion+2,nionm=nionp-nelem)
	real ei(nionp)
	real t
        real c(nfreq,-1:nelem),freq(nfreq)
        real gau
	integer nz,ielem,iz
	integer nzz(nelem)
        external gau
	external xdata
	common /pion/pion(147)
	dimension e2(20),r2(20),zn(28),f(28)
	data e2/.37,.50,.65,1.02,1.48,2.01,2.62,4.11,6.93,8.03,.30,.43,
     1  .57,.91,1.34,1.85,2.45,3.88,6.67,7.76/
	data zn/2*1.,8*2.,18*3./
	data f/1.,.5,1.,.875,.75,.625,.5,.375,.25,.125,1.,.944,.899,
     1  .833,.778,.722,.667,.611,.556,.5,.444,.389,.333,.278,.222,
     2  .167,.111,.056/
	data nzz/6,7,8,10,12,14,16,20,26,28/

c fix for a potential problem in gfortran which fails to initialize from block
c data unless specifically called.

	call xdinit(xdata)

	yk=-1.16049e7/t
c     rates of excitation of 2s levels in h and he-like ions
c     for two-photon emission
	xxx=7.2e-16/sqrt(t)
	do 50 i=1,20
50	r2(i)=xxx*exp(yk*e2(i))/e2(i)
	do 5000 i=1,nfreq
	e=freq(i)
c
c     free-free emission
c
	bcb=1.6543e-20*exp(yk*e)/sqrt(t)
	iion=1
	zz=1.
	c(i,-1)=c(i,-1)+bcb*gau(zz,t,e)*ei(iion)
	iion=iion+1
	zz=2.
	c(i,0)=c(i,0)+bcb*4.*gau(zz,t,e)*ei(iion)
	do 100 ielem=1,nelem
	nz=nzz(ielem)
	iion=iion+1
	do 100 iz=1,nz
	iion=iion+1
	zz=iz
100	c(i,ielem)=c(i,ielem)+bcb*gau(zz,t,e)*zz**2*ei(iion)
c
c     free-bound emission
c
*	bcb=1.0325e-11*1.719e9/sqrt(t)/t
	bcb=1.6543e-20*1.719e9/sqrt(t)/t
	zz=1.
	iion=1
	ynn=0.
	do 130 k=1,5
	ynn=ynn+1.
	ee=1.3598e-2*zz**2/ynn**2
	if (e.lt.ee) go to 130
	c(i,-1)=c(i,-1)+bcb*ynn*ee**2*exp(yk*(e-ee))*ei(iion)
130	continue
	zz=2.
	iion=iion+1
	ynn=0.
	do 140 k=1,5
	ynn=ynn+1.
	ee=1.3598e-2*zz**2/ynn**2
	if (e.lt.ee) go to 140
	c(i,0)=c(i,0)+bcb*ynn*ee**2*exp(yk*(e-ee))*ei(iion)
140	continue
	do 200 ielem=1,nelem
	nz=nzz(ielem)
	iion=iion+1
	do 200 iz=1,nz
	iion=iion+1
	iionm=iion-2-ielem
	zz=iz
	ee=pion(iionm)*1.0e-3
	j=nz+1-iz
	ynn=zn(j)
	if (e.lt.ee) go to 180
	c(i,ielem)=c(i,ielem)+
     .                 bcb*ynn*f(j)*ee**2*exp(yk*(e-ee))*ei(iion)
180	do 190 k=1,4
	ynn=ynn+1.
	ee=1.3598e-2*zz**2/ynn**2
	if (e.lt.ee) go to 190
	c(i,ielem)=c(i,ielem)+bcb*ynn*ee**2*exp(yk*(e-ee))*ei(iion)
190	continue
200	continue
c
c     two-photon continuum emission
c
	iion=2
	do 400 ielem=1,nelem
	iion=iion+nzz(ielem)+1
	iionm=iion-1
	j=ielem
	xxx=e/e2(j)
	if (xxx.ge.1.) go to 300
	c(i,ielem)=c(i,ielem)+r2(j)*xxx**2*(1.-xxx)*ei(iionm)
300	iionm=iionm-1
	j=ielem+nelem
	xxx=e/e2(j)
	if (xxx.ge.1.) go to 400
	c(i,ielem)=c(i,ielem)+r2(j)*xxx**2*(1.-xxx)*ei(iionm)
400	continue
5000	continue
	return
	end
	function gau(z,t,e)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c     this is free-free gaunt factor as given by kellogg, baldwin,
c     and koch, ap. j. 199, 305,1975, for hydrogenic ion of charge z,
c     at temperature t (k), emitting a photon of energy e (kev).
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	IMPLICIT REAL (A-H,O-Z)
	IMPLICIT INTEGER (I-N)
	dimension a(6,7,3),gam2(6),gam3(6)
	data gam2/.7783,1.2217,2.6234,4.3766,20.,70./
	data gam3/1.,1.7783,3.,5.6234,10.,30./
	data a/1.001,1.004,1.017,1.036,1.056,1.121,1.001,1.005,1.017,
     1  1.046,1.073,1.115,.9991,1.005,1.03,1.055,1.102,1.176,.997,1.005,
     2  1.035,1.069,1.134,1.186,.9962,1.004,1.042,1.1,1.193,1.306,.9874,
     3  .9962,1.047,1.156,1.327,1.485,.9681,.9755,.8363,1.208,1.525,
     4  1.965,.3029,.1616,.04757,.013,.0049,-.0032,.4905,.2155,.08357,
     5  .02041,.00739,.00029,.654,.2833,.08057,.03257,.00759,-.00151,
     6  1.029,.391,.1266,.05149,.01274,.00324,.9569,.4891,.1764,.05914,
     7  .01407,-.00024,1.236,.7579,.326,.1077,.028,.00548,1.327,1.017,
     8  1.398,.205,.0605,.00187,-1.323,-.254,-.01571,-.001,-.000184,
     9  .00008,-4.762,-.3386,-.03571,-.001786,-.0003,.00001,-6.349,
     1  -.4206,-.02571,-.003429,-.000234,.00005,-13.231,-.59,-.04571,
     1  -.005714,-.000445,-.00004,-7.672,-.6852,-.0643,-.005857,-.00042,
     2  .00004,-7.143,-.9947,-.12,-.01007,-.000851,-.00004,-3.175,
     3  -1.116,-.8414,-.01821,-.001729,.00023/
	gam1=1.57803e5*z**2/t
	gam1=1000.0*gam1
        gau = 1.0
	if (gam1.gt.100.) go to 602
	u=1.160487e7*e/t
	u2=u**2
c     born approximation gaunt factor
	u1=u/2.
	q=u1/3.75
	if (u1.gt.2.) go to 299
	ai=1.+3.5156229*q**2+3.0899424*q**4+1.2067492*q**6
     1  +.2659732*q**8+.0360768*q**10+.0045813*q**12
	ak=-alog(u1/2.)*ai-.57721566+.4227842*(u1/2.)**2
     1  +.23069756*(u1/2.)**4+.0348859*(u1/2.)**6+.00262698*(u1/2.)**8
     2  +.0001075*(u1/2.)**10+.0000074*(u1/2.)**12
	go to 297
  299 ak=1.25331414-.07832358*(2./u1)+.02189568*(2./u1)**2
     1  -.01062446*(2./u1)**3+.00587872*(2./u1)**4-.0025154*(2./u1)**5
     2  +.00053208*(2./u1)**6
	born=.5513*ak/sqrt(u1)
	go to 321
  297 born=.5513*exp(u1)*ak
c     polynomial multiplier
  321 if (gam1.lt.1.) gau=born
	if (gam1.lt.1.) go to 700
	if (u.lt..003) go to 401
	n=6
	if (u.le..03) n=1
	if (u.le..30.and.u.gt..03) n=2
	if (u.le.1..and.u.gt..30) n=3
	if (u.le.5..and.u.gt.1.) n=4
	if (u.le.15..and.u.gt.5.) n=5
	m=6
	if (gam1.le.1.7783) m=1
	if (gam1.le.3..and.gam1.gt.1.7783) m=2
	if (gam1.le.5.6234.and.gam1.gt.3.) m=3
	if (gam1.le.10..and.gam1.gt.5.6234) m=4
	if (gam1.le.30..and.gam1.gt.10.) m=5
	m1=m+1
	g1=(a(n,m,1)+a(n,m,2)*u+a(n,m,3)*u2)*born
	g2=(a(n,m1,1)+a(n,m1,2)*u+a(n,m1,3)*u2)*born
	p=(gam1-gam3(m))/gam2(m)
	gau=(1.-p)*g1+p*g2
	return
  602 gau=1.
	return
  401 gau=born
  700 return
	end
	subroutine emisl(t,ei,xl)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c     emisl calculates the emissivity in x-ray lines of a hot, low
c     density, optically thin gas, in ergs/cm**3*sec.  (9/81)
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	IMPLICIT REAL (A-H,O-Z)
	IMPLICIT INTEGER (I-N)
        integer nlmx, nzmx
        parameter ( nlmx = 15 )
        parameter ( nzmx = 28 )
        integer k(nlmx,nzmx)
        real eer(nlmx,nzmx), ccf(nlmx,nzmx), pp1(nlmx,nzmx),
     .  pp2(nlmx,nzmx),pp3(nlmx,nzmx),pp4(nlmx,nzmx),pp5(nlmx,nzmx)
	integer nelem
	parameter(nelem=10)
	integer nion,nionp,nionm
	parameter (nion=157,nionp=nion+2,nionm=nionp-nelem)
	integer nline
        parameter (nline=566)
	real ei(nionp),xl(nline)
	real t
	real c(7),n(8),o(9),ne(11),mg(13),si(15),s(17),ca(21),
     1  fe(27),ni(29)
	real xlc(15),xln(15),xlo(15),xlne(20),xlmg(22),xlsi(48),
     1   xls(70),xlca(71),xlfe(157),xlni(133)
	common /elin/ec(15),en(15),eo(15),ene(20),emg(22),esi(48),
     1  es(70),eca(71),efe(157),eni(133)
	dimension ic(15),in(15),io(15),ine(20),img(22),isi(48),is(70),
     1  ica(71),ife(157),ini(133)
	dimension omc(15),omn(15),omo(15),omne(20),ommg(22),omsi(48),
     1  oms(70),omca(71),omfe(157),omni(133)
	dimension exc(15),exn(15),exo(15),exne(20),exmg(22),exsi(48),
     1  exs(70),exca(71),exfe(157),exni(133)
	dimension ax(11),bx(11),cx(11),dx(11),br(11)
	dimension tm(20),ds(10),xlsat(10)
	dimension t0(10),t1(10)
	dimension rrx(40),rrec(40),zx(10)
	exi(x)=alog((x+1.)/x)-0.4/(x+1.)**2
**************************************************************************

c     stage of ionization for lines
	data ic/8*6,6*5,4/
	data in/8*7,6*6,5/
	data io/8*8,6*7,6/
	data ine/8*10,6*9,4*8,2*7/
	data img/8*12,6*11,4*10,2*9,2*8/
	data isi/8*14,7*13,8*12,8*11,9*10,4*9,2*8,2*7/
	data is/8*16,10*15,14*14,14*13,9*12,4*11,5*10,2*9,2*8,2*7/
	data ica/8*20,10*19,14*18,14*17,9*16,8*15,2*14,2*13,2*12,2*11/
	data ife/8*26,10*25,14*24,15*23,12*22,12*21,12*20,13*19,9*18,
     1  13*17,13*16,8*15,5*14,5*13,2*12,2*11,2*10,2*9/
	data ini/8*28,10*27,14*26,14*25,12*24,12*23,10*22,10*21,7*20,
     1  9*19,11*18,8*17,2*16,2*15,2*14,2*13/
c      collision strengths for lines
	data omc/11*0.0,.0229,.0110,.0091,.0007/
	data omn/11*0.0,.0166,.0043,.0065,.0010/
	data omo/11*0.0,.0126,.0033,.0049,.0013/
	data omne/11*0.0,.0080,.0020,.0030,.0474,.1212,.1094,.0019,
     1  .4583,.0016/
	data ommg/11*0.0,.0055,.0014,.0021,.0332,.0856,.0772,.0024,
     1  .2942,.0025,.6291,.0021/
	data omsi/11*0.0,.0040,0.,.0015,.0007,.0249,.0644,.0580,.0255,
     1  .0161,.0007,.0010,.0005,.0420,.0460,.0148,.0137,.0426,.0427,
     2  .0161,.0034,.0077,.0006,.0028,.1856,.0654,.0349,.0396,.0187,
     3  .0032,.0204,.2029,.0738,.0052,1.8342,.0016,1.2674,.0007/
	data oms/11*0.0,.0030,0.,.0002,.0001,.0005,.0011,.0005,.0191,
     a  .0960,
     1  .0874,.0025,.0065,.0102,.0018,.0012,.0019,.0017,.0035,.0009,
     2  .0013,.0007,.0330,.0360,.0116,.0111,.0343,.0056,.0069,.0186,
     3  .0080,.0021,.0026,.0006,.0002,.0041,
     4  .0051,.0020,.1339,.0263,.0231,.0136,.0009,.0004,.0032,.0131,
     5  .1396,.0481,.0067,.2227,1.4099,.1096,.0008,.0006,1.5314,
     6  .0009,.7276,.0008,.6969,.0005/
	data omca/11*0.0,.0019,0.,.0001,.0001,.0003,.0007,.0003,.0124,
     a  .0321,
     1  .0290,.0016,.0042,.0065,.0011,.0008,.0013,.0013,.0022,.0015,
     2  .0017,.0011,.0200,.0230,.0071,.0068,.0213,.0035,.0043,.0129,
     3  .0050,.0013,.0015,.0008,.0002,.0064,
     4  .0029,.0012,.0810,.0178,.0098,.0083,.0012,.0006,.0050,.0647,
     5  .0816,.0276,.0705,.0858,.0009,.0006,.0101,1.100,.0010,.5994,
     6  .0012,.4117,.0011,.9252,.0007/
	data omfe/11*0.0,.0011,0.,.0001,.0001,.0002,.0004,.0002,.0072,
     w  .0190,
     1  .0171,.0009,.0025,.0038,.0007,.0004,.0007,.0006,.0013,.0058,
     2  .0022,.0018,.0120,.0130,.0043,.0029,.0130,.0021,.0020,.0078,
     3  .0020,.0006,.0009,.3711,.0049,.0003,.0108,.0014,.0006,.0247,
     4  .0105,.0031,.0047,.0650,
     5  .0289,.1513,.0034,.0007,.0084,.0038,.0444,.0155,.0044,.0161,
     6  .0086,.0934,.0931,.0729,.0023,.0008,.0170,
     7  .0453,.0144,.0406,.1975,.0262,.0577,.0090,.0230,.1884,.0012,
     8  .0007,.0015,.0270,.0173,.0162,.0189,.0786,.0269,.0456,.0189,
     9  .0189,.0629,.0008,.0010,.0002,.0064,.1416,.0195,.0588,.0472,
     a  .0275,.0357,.0004,.0010,.1896,.0673,.0200,.0573,.1622,
     b  .0384,.0652,.0001,.0130,.0035,.0020,.0390,.0009,.0255,.0251,
     c  .0294,.0258,.0416,.0038,.0033,.0042,.0104,.1336,.0490,.1190,
     d  .0010,.0109,.0566,.0146,.0527,.0114,.0830,.0,.0010,.0533,
     e  .0054,.0538,.0423,.0010,.2402,.0138,.1272,.0442,.0010,.0522,
     f  .0010,.0922,.0010,.1435,.0010,.3145,.0010/
	data omni/11*0.0,.0011,0.,.0001,.00004,.0002,.0004,.0002,.0062,
     w  .0164,
     1  .0147,.0009,.0024,.0036,.0006,.0004,.0007,.0006,.0011,.0016,
     2  .0023,.0021,.0110,.0037,.0036,.0111,.0014,.0015,.0066,.0018,
     3  .0005,.0006,.2584,.0010,.0003,.0126,.0011,.0005,.0213,
     4  .0093,.0020,.0040,.0583,.0253,.1298,.0016,.0007,.0097,.0031,
     5  .0379,.0128,.0037,.0137,.0069,.0812,.0791,.0623,.0011,.0008,
     6  .0197,.0338,.0025,.0301,.0731,.0442,.0072,.1685,.0008,.0007,
     7  .0017,.0023,.0014,.0014,.0107,.0533,.0145,.0520,.0005,.0010,
     8  .0002,.0044,.1148,.0151,.0208,.0303,.0002,.0010,.1635,.0580,
     9  .0135,.0215,.1467,.0364,.0014,.0314,.0009,.0228,.0221,.0256,
     a  .0227,.0372,.0036,.0032,.0035,.0091,.0038,.0010,.0090,.0427,
     b  .0120,.0445,.0093,.0663,.2790,.0010,.1335,.0010,.3668,.0010,
     d  .0450,.0010,.0794,.0010/
*        Sulfur
      data ( k(i,16), eer(i,16), ccf(i,16), 
     .   pp1(i,16),pp2(i,16),pp3(i,16),pp4(i,16),pp5(i,16), i=1,4 ) /
     . 3,178.625870,1.14606,
     . 0.27881E-02,0.11198E-02,0.17698E-02,0.10193E-02,0.18234E-02,
     . 1,179.860153,2.43027,
     . 0.21678E-02,0.98088E-03,0.13725E-03,0.81144E-04,0.15378E-03,
     . 1,180.851257,2.37848,
     . 0.60721E-02,0.88781E-02,0.14303E-01,0.15150E-01,0.16932E-01,
     . 1,211.962921,2.49984,
     . 0.11978E-02,0.19097E-02,0.28184E-02,0.27262E-02,0.29167E-02 /
      data ( k(i,16), eer(i,16), ccf(i,16), 
     .   pp1(i,16),pp2(i,16),pp3(i,16),pp4(i,16),pp5(i,16), i=6,7 ) /
     . 1,211.690750,2.00444,
     . 0.54585E-03,0.30477E-03,0.75376E-04,0.78203E-05,0.29327E-04,
     . 2,211.695618,1.28873,
     . 0.43972E-03,0.40346E-03,0.54209E-03,0.59341E-03,0.71354E-03 /
      data ( k(i,16), eer(i,16), ccf(i,16), 
     .   pp1(i,16),pp2(i,16),pp3(i,16),pp4(i,16),pp5(i,16), i=9,15 ) /
     . 1,222.885376,2.72880,
     . 0.34532E-03,0.69683E-03,0.10006E-02,0.98929E-03,0.94197E-03,
     . 1,227.944412,2.72517,
     . 0.16183E-03,0.33399E-03,0.47931E-03,0.46909E-03,0.44197E-03,
     . 3,179.830948,4.99701,
     . 0.70680E-03,0.61031E-03,0.58465E-03,0.68832E-03,0.74951E-03,
     . 3,179.979065,4.99729,
     . 0.33991E-02,0.29953E-02,0.28805E-02,0.33924E-02,0.36988E-02,
     . 3,211.350006,1.21854,
     . 0.44695E-03,0.25744E-03,0.33247E-03,0.28021E-03,0.42896E-03,
     . 3,211.681793,3.64452,
     . 0.17228E-03,0.13942E-03,0.15478E-03,0.16402E-03,0.18680E-03,
     . 3,211.726105,3.57741,
     . 0.84911E-03,0.68178E-03,0.75457E-03,0.79866E-03,0.91036E-03 /
*       Calcium
      data ( k(i,20), eer(i,20), ccf(i,20), 
     .   pp1(i,20),pp2(i,20),pp3(i,20),pp4(i,20),pp5(i,20), i=1,4 ) /
     . 3,283.785980,1.91222,
     . 0.13609E-02,0.69824E-03,0.10364E-02,0.78738E-03,0.11997E-02,
     . 1,285.416290,2.47146,
     . 0.14260E-02,0.69788E-03,0.23549E-03,0.23316E-03,0.30445E-03,
     . 1,286.808289,2.33670,
     . 0.40453E-02,0.55414E-02,0.90723E-02,0.95487E-02,0.10520E-01,
     . 1,336.827759,2.43959,
     . 0.76746E-03,0.11612E-02,0.17419E-02,0.16862E-02,0.17916E-02 /
      data ( k(i,20), eer(i,20), ccf(i,20), 
     .   pp1(i,20),pp2(i,20),pp3(i,20),pp4(i,20),pp5(i,20), i=6,7 ) /
     . 1,336.439606,2.18862,
     . 0.35150E-03,0.18704E-03,0.65775E-04,0.45633E-04,0.55411E-04,
     . 2,336.436584,1.58594,
     . 0.27983E-03,0.27514E-03,0.35568E-03,0.38936E-03,0.44921E-03 /
      data ( k(i,20), eer(i,20), ccf(i,20), 
     .   pp1(i,20),pp2(i,20),pp3(i,20),pp4(i,20),pp5(i,20), i=9,15 ) /
     . 1,354.379700,2.74676,
     . 0.22397E-03,0.44191E-03,0.62893E-03,0.62070E-03,0.59151E-03,
     . 1,362.507690,2.73949,
     . 0.10518E-03,0.21152E-03,0.30109E-03,0.29416E-03,0.27739E-03,
     . 3,285.341400,2.20832,
     . 0.47591E-03,0.40100E-03,0.43012E-03,0.37712E-03,0.47887E-03,
     . 3,285.738220,2.38174,
     . 0.22573E-02,0.19208E-02,0.20608E-02,0.19065E-02,0.23851E-02,
     . 3,335.990173,1.81605,
     . 0.25829E-03,0.16443E-03,0.21231E-03,0.19560E-03,0.27142E-03,
     . 3,336.419678,2.49814,
     . 0.11412E-03,0.92224E-04,0.96290E-04,0.96229E-04,0.11167E-03,
     . 3,336.536102,3.19537,
     . 0.53959E-03,0.44097E-03,0.46725E-03,0.48792E-03,0.55921E-03 /
*       Iron
      data ( k(i,26), eer(i,26), ccf(i,26), 
     .   pp1(i,26),pp2(i,26),pp3(i,26),pp4(i,26),pp5(i,26), i=1,4 ) /
     . 3,487.771057,3.40476,
     . 0.64017E-03,0.45860E-03,0.57712E-03,0.59818E-03,0.72874E-03,
     . 1,490.067932,2.42844,
     . 0.94204E-03,0.59873E-03,0.41794E-03,0.45670E-03,0.56074E-03,
     . 1,492.437073,1.70847,
     . 0.24804E-02,0.26116E-02,0.39278E-02,0.54602E-02,0.56741E-02,
     . 1,579.246826,2.51106,
     . 0.45447E-03,0.62826E-03,0.97939E-03,0.95286E-03,0.94500E-03 /
      data ( k(i,26), eer(i,26), ccf(i,26), 
     .   pp1(i,26),pp2(i,26),pp3(i,26),pp4(i,26),pp5(i,26), i=6,7 ) /
     . 1,578.565430,2.32783,
     . 0.21715E-03,0.13434E-03,0.94429E-04,0.90076E-04,0.97377E-04,
     . 2,578.544434,4.99810,
     . 0.16257E-03,0.19626E-03,0.23289E-03,0.24983E-03,0.27015E-03 /
      data ( k(i,26), eer(i,26), ccf(i,26), 
     .   pp1(i,26),pp2(i,26),pp3(i,26),pp4(i,26),pp5(i,26), i=9,15 ) /
     . 1,609.699524,2.76517,
     . 0.13130E-03,0.24905E-03,0.35048E-03,0.34507E-03,0.32922E-03,
     . 1,623.798584,2.76301,
     . 0.61870E-04,0.11932E-03,0.16764E-03,0.16333E-03,0.15424E-03,
     . 3,489.895996,4.99673,
     . 0.27210E-03,0.23371E-03,0.25601E-03,0.26703E-03,0.29683E-03,
     . 3,491.128723,4.99673,
     . 0.12552E-02,0.11026E-02,0.12312E-02,0.12969E-02,0.14575E-02,
     . 3,577.935852,2.36917,
     . 0.15386E-03,0.98283E-04,0.13046E-03,0.11959E-03,0.15555E-03,
     . 3,578.525269,3.64960,
     . 0.64563E-04,0.53127E-04,0.56650E-04,0.59114E-04,0.66691E-04,
     . 3,578.883667,3.64756,
     . 0.30577E-03,0.25433E-03,0.27887E-03,0.29028E-03,0.33119E-03 /
c     excitation energies for lines in kev
	data exc/.364,.436,.463,.470,.477,.435,.459,.459,.299,.304,.308,
     1  .355,.379,.371,.297/
	data exn/.500,.593,.626,.639,.649,.593,.626,.626,.420,.426,.431,
     1  .498,.532,.522,.418/
	data exo/.654,.775,.816,.837,.849,.774,.816,.816,.561,.568,.574,
     1  .666,.698,.698,.559/
	data exne/1.022,1.216,1.278,1.308,1.325,1.216,1.278,1.278,.905,
     1  .914,.921,1.073,1.150,1.127,.136,.142,.141,.902,.127,.625/
	data exmg/1.473,1.747,1.851,1.879,1.908,1.747,1.851,1.851,1.331,
     1  1.343,1.352,1.580,1.695,1.660,.209,.216,.214,1.328,.198,.920,
     2  .165,.909/
	data exsi/2.007,2.376,2.505,2.567,2.600,2.376,2.505,2.505,1.840,
     1  1.856,1.865,2.183,0.,2.292,2.348,.297,.305,.303,.400,.400,1.837,
     2  2.310,1.261,.278,.292,.267,.289,.283,.380,.374,1.274,.226,
     3  .253,.253,.245,.285,.267,.261,.318,1.261,.201,.224,.225,1.303,
     4  .203,1.770,.180,1.755/
	data exs/2.623,3.108,3.280,3.351,3.397,3.108,3.280,3.280,2.430,
     1  2.447,2.461,2.884,0.,2.880,2.880,2.884,3.033,3.101,.397,.409,
     a  .408,
     2  .535,.541,.538,.535,.538,.542,.538,.591,2.428,3.076,1.692,.378,
     3  .396,.374,.391,.383,.510,.519,.537,.508,.519,.510,2.408,3.018,
     4  1.745,.328,.335,.340,.354,.372,.446,2.387,2.960,1.743,.302,
     5  .316,.316,1.785,.280,.291,.360,2.348,1.730,.281,2.331,.238,
     6  2.726,.204,2.668/
	data exca/4.106,4.882,5.167,5.391,5.536,4.882,5.167,5.167,3.861,
     1  3.883,3.902,4.583,0.,4.578,4.577,4.583,4.822,4.932,.646,.667,
     a  .660,
     2  .861,.873,.886,.861,.886,.873,.886,.969,3.864,4.941,2.746,.646,
     3  .678,.639,.670,.636,.873,.886,.800,.867,.886,.873,3.837,4.867,
     4  2.841,.551,.539,.579,.639,.614,.761,3.810,4.793,2.863,.451,.549,
     5  .549,.560,.667,3.782,4.719,2.924,.520,2.983,.505,3.733,.500,
     6  4.494,.405,4.420/
	data exfe/6.966,8.251,8.700,8.908,9.021,8.251,8.700,8.700,6.637,
     1  6.675,6.700,7.881,0.,7.874,7.872,7.881,8.295,8.487,1.138,1.159,
     2  1.148,1.531,1.535,1.533,1.531,1.533,1.535,1.533,1.715,6.662,
     3  8.580,4.713,1.110,1.124,1.078,1.150,1.123,1.461,1.474,1.467,
     4  1.826,1.474,1.461,.074,6.628,8.482,4.794,1.000,1.130,1.040,
     5  1.150,1.078,1.378,.074,.095,.100,6.583,8.384,4.866,.954,1.008,
     6  1.008,.992,1.069,1.265,.083,.090,.115,6.542,8.286,4.938,1.060,
     7  .874,1.160,.967,1.008,.958,.904,1.270,.102,6.502,8.187,5.042,
     8  .823,.819,.823,.918,.918,1.100,1.210,1.148,1.148,.115,6.467,
     9  8.088,5.066,.785,.862,.925,.872,.785,1.016,.119,6.430,7.979,
     a  .756,.769,.932,.812,.826,.897,.939,.893,.873,.897,.976,
     b  1.023,7.891,.246,.271,.231,.263,.246,.349,.349,.345,.334,.709,
     c  .806,.895,7.838,.262,.235,.197,.253,.253,.235,.827,7.788,.210,
     d  .175,.220,.189,7.737,.271,.200,.245,.174,7.686,.174,7.636,.154,
     e  7.585,.143,7.535,.138,7.486/
	data exni/8.034,9.524,10.06,10.27,10.35,9.524,10.06,10.06,7.732,
     1  7.766,7.805,9.184,0.,9.172,9.172,9.184,9.667,9.891,1.333,1.354,
     2  1.348,1.610,1.610,1.653,1.600,1.653,1.610,1.653,2.033,7.749,
     3  10.02,5.432,1.328,1.274,1.312,1.222,1.727,1.742,1.734,2.157,
     4  1.742,1.727,.087,7.654,9.914,5.545,1.192,1.345,1.240,1.369,
     5  1.330,1.610,.080,.102,.108,7.607,9.808,5.554,1.127,1.181,1.181,
     6  1.166,1.256,1.459,.091,.098,.124,7.596,9.702,5.730,1.138,1.127,
     7  1.278,1.285,1.259,1.512,.105,7.528,9.595,5.848,1.170,1.170,
     8  1.170,1.355,1.355,1.393,.129,7.496,9.488,5.894,.984,1.069,1.192,
     9  1.279,.131,7.461,9.381,.909,.926,.969,.981,.998,.998,1.148,
     a  1.240,9.275,.297,.331,.285,.322,.297,.431,.407,.477,.411,.879,
     b  9.217,.318,.312,.239,.299,.310,.294,.935,9.162,.244,9.108,.250,
     c  9.053,.202,8.998,.179,8.943/
c     parameters for temperature-dependent collision strengths
	data br/1.06,.92,.43,.36,.32,1.04,1.02,1.02,1.00,1.07,1.05/
	data ax/.4478,.1987,.1481,.0762,.0418,.1794,.0514,.0413,.0,.0,.6/
	data bx/-.0048,-.1587,.0224,.0085,.0034,-.1657,-.0515,.0063,.0,
     1  .0,.8/
	data cx/1.314,.2752,.0,.0,.0,.1544,.0517,0.,.267,1.624,0./
	data dx/2.219,.3559,.1257,.0593,.0316,.0420,.0147,.0351,.0,.0,4./
c     parameters of satellite line emission
	data tm/2.8e4,5.2e4,8.8e4,2.0e5,3.7e5,6.2e5,9.8e5,2.2e6,5.2e6,
     1  1.3e7,7.9e5,1.3e6,1.9e6,3.6e6,6.02e6,9.33e6,1.36e7,
     2  2.54e7,5.28e7,6.48e7/
	data ds/.010,.016,.024,.042,.066,.098,.13,.23,.30,.32/
	data rrx/.29,.43,.59,1.0,1.6,2.3,3.1,5.3,10.,11.9,.022,.033,.045,
     1  .076,.12,.16,.22,.36,.64,.75,1.7,2.8,4.2,8.1,13.8,21.3,31.0,
     2  57.6,118.,145.,.82,1.4,2.1,4.1,7.1,11.3,16.7,31.9,67.7,83.5/
	data zx/6.,7.,8.,10.,12.,14.,16.,20.,26.,28./
	data t0/1.02e6,1.38e6,1.81e6,2.82e6,4.06e6,5.57e6,8.01e6,
     1  1.34e7,2.29e7,2.65e7/
	data t1/4.82e3,1.14e4,2.36e4,8.10e4,2.23e5,5.16e5,1.01e6,
     1  2.85e6,9.39e6,1.24e7/
	iion=2
	do 11 i=1,7
	iion=iion+1
11	c(i)=ei(iion)
	do 12 i=1,8
	iion=iion+1
12	n(i)=ei(iion)
	do 13 i=1,9
	iion=iion+1
13	o(i)=ei(iion)
	do 14 i=1,11
	iion=iion+1
14	ne(i)=ei(iion)
	do 15 i=1,13
	iion=iion+1
15	mg(i)=ei(iion)
	do 16 i=1,15
	iion=iion+1
16	si(i)=ei(iion)
	do 17 i=1,17
	iion=iion+1
17	s(i)=ei(iion)
	do 18 i=1,21
	iion=iion+1
18	ca(i)=ei(iion)
	do 19 i=1,27
	iion=iion+1
19	fe(i)=ei(iion)
	do 20 i=1,29
	iion=iion+1
20	ni(i)=ei(iion)
	xxx=1.38245e-14/sqrt(t)
	yk=-1.16049e7/t
	te=t
c
c     xray line emission
c
c     temperature variation of collision strengths included for
c     hydrogen-like and helium-like lines.
c
	do 50 i=1,8
	ee=-yk*exc(i)
	omc(i)=.0250*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exn(i)
	omn(i)=.0187*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exo(i)
	omo(i)=.0145*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exne(i)
	omne(i)=.0094*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exmg(i)
	ommg(i)=.00663*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exsi(i)
	omsi(i)=.00491*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exs(i)
	oms(i)=.00429*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exca(i)
	omca(i)=.00243*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exfe(i)
	omfe(i)=.00145*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exni(i)
	omni(i)=.00125*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
   50 continue
*          This is a temporary fix for more accurate collision strengths
*          for 1s-2p transition in H-like C to Mg ions.
      ione = 1
      zero = 0.0
      one = 1.0
      z = zx(1)
      z2 = z**2
      a = 4.4394/z2
      b = 0.8949/z2
      cc = ( -0.6012 - 3.9710/z - 4.2176/z2 )/z2
      d = ( 2.9300 + 1.7790/z + 4.9347/z2 )/z2
      ee=-yk*exc(1)
      omc(1) = 0.5*strfit(ee,ione,b,cc,d,zero,a,zero,zero,zero,one )
      z = zx(2)
      z2 = z**2
      a = 4.4394/z2
      b = 0.8949/z2
      cc = ( -0.6012 - 3.9710/z - 4.2176/z2 )/z2
      d = ( 2.9300 + 1.7790/z + 4.9347/z2 )/z2
      ee=-yk*exn(1)
      omn(1) = 0.5*strfit(ee,ione,b,cc,d,zero,a,zero,zero,zero,one )
      ee=-yk*exo(1)
      omo(1) = 0.5*strfit(ee,ione,0.00398,-5.66e-4,0.0446,zero,0.073,
     .                  zero,zero,zero,one )
      z = zx(4)
      z2 = z**2
      a = 4.4394/z2
      b = 0.8949/z2
      cc = ( -0.6012 - 3.9710/z - 4.2176/z2 )/z2
      d = ( 2.9300 + 1.7790/z + 4.9347/z2 )/z2
      ee=-yk*exne(1)
      omne(1) = 0.5*strfit(ee,ione,b,cc,d,zero,a,zero,zero,zero,one )
      z = zx(5)
      z2 = z**2
      a = 4.4394/z2
      b = 0.8949/z2
      cc = ( -0.6012 - 3.9710/z - 4.2176/z2 )/z2
      d = ( 2.9300 + 1.7790/z + 4.9347/z2 )/z2
      ee=-yk*exmg(1)
      ommg(1) = 0.5*strfit(ee,ione,b,cc,d,zero,a,zero,zero,zero,one )
	do 60 i=9,11
	ee=-yk*exc(i)
	omc(i)= 0.0337*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exn(i)
	omn(i)=0.0239*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exo(i)
	omo(i)=0.0179*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exne(i)
	omne(i)=0.0112*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exmg(i)
	ommg(i)=.00759*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exsi(i)
	omsi(i)=.00550*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exs(i)
	oms(i)=.004170*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exca(i)
	omca(i)=.00262*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exfe(i)
	omfe(i)=.00153*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
	ee=-yk*exni(i)
	omni(i)=.00131*br(i)*(ax(i)+ee*cx(i)+
     1  (dx(i)+bx(i)*ee-cx(i)*ee**2)*exi(ee))
   60 continue
	omc(9) = upsila(6,1,te)
	omc(10) = upsila(6,2,te)+upsila(6,3,te)+upsila(6,4,te)
	omc(11) = upsila(6,6,te)
        omc(12) = 0.94*upsila(6,7,te)
        omc(14) = 0.92*upsil(1,27.262400,2.66442,0.19571E-02,
     .         0.46619E-02,0.70008E-02,0.69846E-02,0.66234E-02,te)
	omo(9) = upsila(8,1,te)
	omo(10) = upsila(8,2,te)+upsila(8,3,te)+upsila(8,4,te)
	omo(11) = upsila(8,6,te)
        omo(12) = 0.94*upsila(8,7,te)
        omo(14) = 0.92*upsil(1,51.286999,2.68930,0.12185E-02,
     .         0.26993E-02,0.39788E-02,0.39551E-02,0.37567E-02,te)
	omne(9) = upsilb(10,1,te)
	omne(10) = upsilb(10,2,te)+upsilb(10,3,te)+upsilb(10,4,te)
	omne(11) = upsilb(10,6,te)
        omne(12) = 0.94*upsilb(10,12,te)
        omne(14) = 0.92*upsil(1,82.839920,2.70683,0.82362E-03,
     .         0.17572E-02,0.25613E-02,0.25403E-02,0.24153E-02,te)
	ommg(9) = upsila(12,1,te)
	ommg(10) = upsila(12,2,te)+upsila(12,3,te)+upsila(12,4,te)
	ommg(11) = upsila(12,6,te)
        ommg(12) = 0.94*upsil(1,116.077248,2.71942,0.17113E-02,
     .         0.33817E-02,0.48982E-02,0.49726E-02,0.48412E-02,te)
        ommg(14) = 0.92*upsil(1,121.939056,2.71680,0.59160E-03,
     .         0.12320E-02,0.17838E-02,0.17667E-02,0.16809E-02,te)
	omsi(9) = upsilb(14,1,te)
	omsi(10) = upsilb(14,2,te)+upsilb(14,3,te)+upsilb(14,4,te)
	omsi(11) = upsilb(14,6,te)
	omsi(12) = 0.94*upsilb(14,12,te)
	omsi(14) = 0.92*upsil(1,168.231003,2.72494,0.44443E-03,
     .      0.90989E-03,0.13108E-02,0.12969E-02,0.12345E-02,te)
	omsi(15) = 0.91*upsil(1,172.022995,2.71837,0.20799E-03,
     .      0.43571E-03,0.62796E-03,0.61511E-03,0.57929E-03,te)
*            Collision strengths for S, Ca, and Fe (also Ni).
        do 202 i= 1, 4
           j = 8 + i
           oms(j) = upsil(k(i,16), eer(i,16), ccf(i,16), 
     .        pp1(i,16),pp2(i,16),pp3(i,16),pp4(i,16),pp5(i,16),te)
           omca(j) = upsil(k(i,20), eer(i,20), ccf(i,20), 
     .        pp1(i,20),pp2(i,20),pp3(i,20),pp4(i,20),pp5(i,20),te)
           omfe(j) = upsil(k(i,26), eer(i,26), ccf(i,26), 
     .        pp1(i,26),pp2(i,26),pp3(i,26),pp4(i,26),pp5(i,26),te)
 202	continue
        do 204 i= 6, 7
           j = 8 + i
           oms(j) = upsil(k(i,16), eer(i,16), ccf(i,16), 
     .        pp1(i,16),pp2(i,16),pp3(i,16),pp4(i,16),pp5(i,16),te)
           omca(j) = upsil(k(i,20), eer(i,20), ccf(i,20), 
     .        pp1(i,20),pp2(i,20),pp3(i,20),pp4(i,20),pp5(i,20),te)
           omfe(j) = upsil(k(i,26), eer(i,26), ccf(i,26), 
     .        pp1(i,26),pp2(i,26),pp3(i,26),pp4(i,26),pp5(i,26),te)
 204	continue
        do 206 i= 9, 10
           j = 8 + i
           oms(j) = upsil(k(i,16), eer(i,16), ccf(i,16), 
     .        pp1(i,16),pp2(i,16),pp3(i,16),pp4(i,16),pp5(i,16),te)
           omca(j) = upsil(k(i,20), eer(i,20), ccf(i,20), 
     .        pp1(i,20),pp2(i,20),pp3(i,20),pp4(i,20),pp5(i,20),te)
           omfe(j) = upsil(k(i,26), eer(i,26), ccf(i,26), 
     .        pp1(i,26),pp2(i,26),pp3(i,26),pp4(i,26),pp5(i,26),te)
 206	continue
        omni(9) = upsila(28,1,te)
        omni(10) = upsila(28,3,te)
        omni(11) = upsila(28,6,te)
        oms12 = upsil(k(12,16), eer(12,16), ccf(12,16), 
     .     pp1(12,16),pp2(12,16),pp3(12,16),pp4(12,16),pp5(12,16),te) 
        brs2 = oms(10) + 0.31*oms12
	oms(10) = oms(10) + upsil(k(11,16), eer(11,16), ccf(11,16), 
     .     pp1(11,16),pp2(11,16),pp3(11,16),pp4(11,16),pp5(11,16),te) +
     .                                          oms12
        brs2 = brs2/oms(10)
        omca12 = upsil(k(12,20), eer(12,20), ccf(12,20), 
     .     pp1(12,20),pp2(12,20),pp3(12,20),pp4(12,20),pp5(12,20),te) 
        brca2 = omca(10) + 0.60*omca12
	omca(10) = omca(10) + upsil(k(11,20), eer(11,20), ccf(11,20), 
     .     pp1(11,20),pp2(11,20),pp3(11,20),pp4(11,20),pp5(11,20),te) +
     .                                          omca12
        brca2 = brca2/omca(10)
        omfe12 = upsil(k(12,26), eer(12,26), ccf(12,26), 
     .     pp1(12,26),pp2(12,26),pp3(12,26),pp4(12,26),pp5(12,26),te) 
        brfe2 = omfe(10) + 0.82*omfe12
	omfe(10) = omfe(10) + upsil(k(11,26), eer(11,26), ccf(11,26), 
     .     pp1(11,26),pp2(11,26),pp3(11,26),pp4(11,26),pp5(11,26),te) +
     .                                          omfe12
        brfe2 = brfe2/omfe(10)
        omni12 = upsila(28,4,te)
        brni2 = omni(10) + 0.85*omni12
        omni(10) = omni(10) + upsila(28,2,te) + omni12
        brni2 = brni2/omni(10)
        oms(12) = 0.94*oms(12)
        omca(12) = 0.94*omca(12)
        omfe(12) = 0.94*omfe(12)
        oms14 = oms(14)
	oms(14) = oms(14) + upsil(k(14,16), eer(14,16), ccf(14,16), 
     .     pp1(14,16),pp2(14,16),pp3(14,16),pp4(14,16),pp5(14,16),te) +
     .            upsil(k(15,16), eer(15,16), ccf(15,16), 
     .     pp1(15,16),pp2(15,16),pp3(15,16),pp4(15,16),pp5(15,16),te)
        omca14 = omca(14)
	omca(14) = omca(14) + upsil(k(14,20), eer(14,20), ccf(14,20), 
     .     pp1(14,20),pp2(14,20),pp3(14,20),pp4(14,20),pp5(14,20),te) +
     .            upsil(k(15,20), eer(15,20), ccf(15,20), 
     .     pp1(15,20),pp2(15,20),pp3(15,20),pp4(15,20),pp5(15,20),te)
        omfe14 = omfe(14)
	omfe(14) = omfe(14) + upsil(k(14,26), eer(14,26), ccf(14,26), 
     .     pp1(14,26),pp2(14,26),pp3(14,26),pp4(14,26),pp5(14,26),te) +
     .            upsil(k(15,26), eer(15,26), ccf(15,26), 
     .     pp1(15,26),pp2(15,26),pp3(15,26),pp4(15,26),pp5(15,26),te)
        oms(17) = 0.92*oms(17)
        omca(17) = 0.92*omca(17)
        omfe(17) = 0.92*omfe(17)
        oms(18) = 0.91*oms(18)
        omca(18) = 0.91*omca(18)
        omfe(18) = 0.91*omfe(18)
        omfe(31) = 0.0052/(0.4-yk*exfe(31))
        omfe(32) = -0.0025*yk
        omfe(46) = 0.00076/(0.4-yk*exfe(46))
        omfe(47) = -0.0018*yk
        omfe(58) = 0.0011/(0.4-yk*exfe(58))
        omfe(59) = -0.00096*yk
        omfe(70) = 0.00096/(0.4-yk*exfe(70))
        omfe(71) = -0.00043*yk
        omfe(82) = 0.0015/(0.4-yk*exfe(82))
        omfe(83) = -0.0*yk
        omfe(95) = 0.0034/(0.4-yk*exfe(95))
        omfe(96) = -0.000062*yk
        omfe(105) = 0.0034/(0.4-yk*exfe(105))
        omfe(118) = 0.0032/(0.4-yk*exfe(118))
        omfe(131) = 0.0033/(0.4-yk*exfe(131))
        omfe(139) = 0.0033/(0.4-yk*exfe(139))
        omfe(144) = 0.0032/(0.4-yk*exfe(144))
        omfe(149) = 0.0031/(0.4-yk*exfe(149))
        omfe(151) = 0.0031/(0.4-yk*exfe(151))
        omfe(153) = 0.0030/(0.4-yk*exfe(153))
        omfe(155) = 0.0029/(0.4-yk*exfe(155))
        omfe(157) = 0.0029/(0.4-yk*exfe(157))
c
c     line emission calculated separately for each element in order of
c     decreasing ionization
c
	do 100 i=1,15
	j=ic(i)
	xlc(i)=xxx*c(j)*ec(i)*omc(i)*exp(yk*exc(i))
  100 continue
	do 200 i=1,15
	j=in(i)
	xln(i)=xxx*n(j)*en(i)*omn(i)*exp(yk*exn(i))
  200 continue
	do 300 i=1,15
	j=io(i)
	xlo(i)=xxx*o(j)*eo(i)*omo(i)*exp(yk*exo(i))
  300 continue
	do 400 i=1,20
	j=ine(i)
	xlne(i)=xxx*ne(j)*ene(i)*omne(i)*exp(yk*exne(i))
  400 continue
	do 500 i=1,22
	j=img(i)
	xlmg(i)=xxx*mg(j)*emg(i)*ommg(i)*exp(yk*exmg(i))
  500 continue
	do 600 i=1,48
	j=isi(i)
	xlsi(i)=xxx*si(j)*esi(i)*omsi(i)*exp(yk*exsi(i))
  600 continue
	do 700 i=1,70
	j=is(i)
	xls(i)=xxx*s(j)*es(i)*oms(i)*exp(yk*exs(i))
  700 continue
	do 800 i=1,71
	j=ica(i)
	xlca(i)=xxx*ca(j)*eca(i)*omca(i)*exp(yk*exca(i))
  800 continue
	do 900 i=1,156
	j=ife(i)
	xlfe(i)=xxx*fe(j)*efe(i)*omfe(i)*exp(yk*exfe(i))
  900 continue
        xlfe(157) = xxx*(fe(1)+fe(2)+fe(3)+fe(4)+fe(5)+fe(6)+fe(7)+
     .            fe(8)+fe(9))*efe(157)*omfe(157)*exp(yk*exfe(157))
***************************************************************
*          Zero out Fe-L shell lines for Li-, Be-, B-, C-, N-,
*          and O-like ions.
	do 910 i=19,29
	   xlfe(i) = 0.0
 910	continue
	do 920 i=33,44
	   xlfe(i) = 0.0
 920	continue
	do 930 i=48,56
	   xlfe(i) = 0.0
 930	continue
	do 940 i=60,68
	   xlfe(i) = 0.0
 940	continue
	do 950 i=72,80
	   xlfe(i) = 0.0
 950	continue
	do 960 i=84,93
	   xlfe(i) = 0.0
 960	continue
	do 970 i=97,103
	   xlfe(i) = 0.0
 970	continue
	do 980 i=106,117
	   xlfe(i) = 0.0
 980	continue
***************************************************************
	do 1000 i=1,133
	j=ini(i)
	xlni(i)=xxx*ni(j)*eni(i)*omni(i)*exp(yk*exni(i))
 1000 continue
*          correct for cascades for He-like S, Ca, and Fe ions
      xls(16) = 0.064*es(16)/es(12)*xls(12)              
      xlca(16) = 0.064*eca(16)/eca(12)*xlca(12)              
      xlfe(16) = 0.064*efe(16)/efe(12)*xlfe(12)
      brs = 0.15*oms14/oms(14)
      xls(12) = xls(12) + brs*exs(14)/es(14)*xls(14)
      xls(14) = (1.-brs)*xls(14)
      brca = 0.30*omca14/omca(14)
      xlca(12) = xlca(12) + brca*exca(14)/eca(14)*xlca(14)
      xlca(14) = (1.-brca)*xlca(14)
      brfe = 0.60*omfe14/omfe(14)
      xlfe(12) = xlfe(12) + brfe*exfe(14)/efe(14)*xlfe(14)
      xlfe(14) = (1.-brfe)*xlfe(14)
      xls(11) = xls(11) + es(11)/es(15)*xls(15)
      xlca(11) = xlca(11) + eca(11)/eca(15)*xlca(15)
      xlfe(11) = xlfe(11) + efe(11)/efe(15)*xlfe(15)
      xls(9) = xls(9) + (1.-brs2)*es(9)/es(10)*xls(10)
      xlca(9) = xlca(9) + (1.-brca2)*eca(9)/eca(10)*xlca(10)
      xlfe(9) = xlfe(9) + (1.-brfe2)*efe(9)/efe(10)*xlfe(10)
      xlni(9) = xlni(9) + (1.-brni2)*eni(9)/eni(10)*xlni(10)
      xls(10) = brs2*xls(10) + xxx*s(is(10))*es(10)*
     .     upsil(k(13,16), eer(13,16), ccf(13,16), 
     .      pp1(13,16),pp2(13,16),pp3(13,16),pp4(13,16),pp5(13,16),te)*
     .                                exp(yk*0.0136*eer(13,16))
      xlca(10) = brca2*xlca(10) + xxx*ca(ica(10))*eca(10)*
     .     upsil(k(13,20), eer(13,20), ccf(13,20), 
     .      pp1(13,20),pp2(13,20),pp3(13,20),pp4(13,20),pp5(13,20),te)*
     .                                exp(yk*0.0136*eer(13,20))
      xlfe(10) = brfe2*xlfe(10) + xxx*fe(ife(10))*efe(10)*
     .     upsil(k(13,26), eer(13,26), ccf(13,26), 
     .      pp1(13,26),pp2(13,26),pp3(13,26),pp4(13,26),pp5(13,26),te)*
     .                                exp(yk*0.0136*eer(13,26))
      xlni(10) = brni2*xlni(10)
c     contribution of radiative recombination to lines
	xxx=1.6021e-17/t**.7
	do 1050 i=1,10
 1050 rrec(i)=rrx(i)*xxx
	xxx=1.6021e-17/t**.54
	do 1055 i=11,20
 1055 rrec(i)=rrx(i)*xxx
	xxx=1.6021e-17/t**.81
	do 1060 i=21,30
 1060 rrec(i)=rrx(i)*xxx
	xxx=1.6021e-17/t**.87
	do 1065 i=31,40
 1065 rrec(i)=rrx(i)*xxx
c     contribution of dielectronic recombination--direct
	do 1080 i=1,10
	zz=zx(i)**2
	xxx=1.04e-16*zz**2/t**1.5
	ex1=exp(-78900.*(zx(i)+.5)**2/t)
	ex2=exp(-101800.*zz/t)
	ex3=exp(-118400.*zz/t)
	p=33.*(zx(i)-1.)**.6/t**.3
	zz=zz**2
	rrec(i+10)=rrec(i+10)+xxx*(9.*ex1/(1.+7.e-5*zz)+27.*ex2/(1.+
     1  8.e-5*zz)+380.*ex3/((1.+p)*(1.+5.e-3*zx(i)**3)))
	rrec(i+20)=rrec(i+20)+xxx*(1.9*ex1+54.*ex2/(1.+
     1  1.9e-4*zz)+380.*p*ex3/((1.+p)*(1.+5.e-3*zx(i)**3)))
 1080 rrec(i+30)=rrec(i+30)+xxx*(12.*ex1/(1.+6.e-6*zz)+18.*ex2/(1.+
     1  3.e-5*zz)+69.*ex3/(1.+5.e-3*zx(i)**3))
	xlc(1)=xlc(1)+rrec(1)*c(7)*ec(1)
	xln(1)=xln(1)+rrec(2)*n(8)*en(1)
	xlo(1)=xlo(1)+rrec(3)*o(9)*eo(1)
	xlne(1)=xlne(1)+rrec(4)*ne(11)*ene(1)
	xlmg(1)=xlmg(1)+rrec(5)*mg(13)*emg(1)
	xlsi(1)=xlsi(1)+rrec(6)*si(15)*esi(1)
	xls(1)=xls(1)+rrec(7)*s(17)*es(1)
	xlca(1)=xlca(1)+rrec(8)*ca(21)*eca(1)
	xlfe(1)=xlfe(1)+rrec(9)*fe(27)*efe(1)
	xlni(1)=xlni(1)+rrec(10)*ni(29)*eni(1)
	xlc(9)=xlc(9)+rrec(11)*c(6)*ec(9)
	xln(9)=xln(9)+rrec(12)*n(7)*en(9)
	xlo(9)=xlo(9)+rrec(13)*o(8)*eo(9)
	xlne(9)=xlne(9)+rrec(14)*ne(10)*ene(9)
	xlmg(9)=xlmg(9)+rrec(15)*mg(12)*emg(9)
	xlsi(9)=xlsi(9)+rrec(16)*si(14)*esi(9)
	xls9=rrec(17)*s(16)*es(9)
	xlca9=rrec(18)*ca(20)*eca(9)
	xlfe9=rrec(19)*fe(26)*efe(9)
	xlni9=rrec(20)*ni(28)*eni(9)
	xlc(10)=xlc(10)+rrec(21)*c(6)*ec(10)
	xln(10)=xln(10)+rrec(22)*n(7)*en(10)
	xlo(10)=xlo(10)+rrec(23)*o(8)*eo(10)
	xlne(10)=xlne(10)+rrec(24)*ne(10)*ene(10)
	xlmg(10)=xlmg(10)+rrec(25)*mg(12)*emg(10)
	xlsi(10)=xlsi(10)+rrec(26)*si(14)*esi(10)
	xls10=rrec(27)*s(16)*es(10)
	xlca10=rrec(28)*ca(20)*eca(10)
	xlfe10=rrec(29)*fe(26)*efe(10)
	xlni10=rrec(30)*ni(28)*eni(10)
	xlc(11)=xlc(11)+rrec(31)*c(6)*ec(11)
	xln(11)=xln(11)+rrec(32)*n(7)*en(11)
	xlo(11)=xlo(11)+rrec(33)*o(8)*eo(11)
	xlne(11)=xlne(11)+rrec(34)*ne(10)*ene(11)
	xlmg(11)=xlmg(11)+rrec(35)*mg(12)*emg(11)
	xlsi(11)=xlsi(11)+rrec(36)*si(14)*esi(11)
	xls(11)=xls(11)+rrec(37)*s(16)*es(11)
	xlca(11)=xlca(11)+rrec(38)*ca(20)*eca(11)
	xlfe(11)=xlfe(11)+rrec(39)*fe(26)*efe(11)
	xlni(11)=xlni(11)+rrec(40)*ni(28)*eni(11)
c     correction for cascades in triplet states in he-like ions
	xlc(9)=xlc(9)+xlc(10)*ec(9)*(.89+.4*exp(.21*yk*exc(9)))/ec(10)
	xlc(10)=.11*xlc(10)
	xln(9)=xln(9)+xln(10)*en(9)*(.78+.4*exp(.21*yk*exn(9)))/en(10)
	xln(10)=.22*xln(10)
	xlo(9)=xlo(9)+xlo(10)*eo(9)*(.71+.4*exp(.21*yk*exo(9)))/eo(10)
	xlo(10)=.29*xlo(10)
	xlne(9)=xlne(9)+xlne(10)*(.66+.4*exp(.21*yk*ene(9)))
	xlne(10)=.34*xlne(10)
	xlmg(9)=xlmg(9)+(.62+.4*exp(.21*yk*emg(9)))*xlmg(10)
	xlmg(10)=.38*xlmg(10)
	xlsi(9)=xlsi(9)+(.55+.4*exp(.21*yk*esi(9)))*xlsi(10)
	xlsi(10)=.45*xlsi(10)
	xls(9)=xls(9)+xls9+(.44+.4*exp(.21*yk*es(9)))*xls10
	xls(10)=xls(10)+.56*xls10
	xlca(9)=xlca(9)+xlca9+(.23+.4*exp(.21*yk*eca(9)))*xlca10
	xlca(10)=xlca(10)+.77*xlca10
	xlfe(9)=xlfe(9)+xlfe9+(.13+.4*exp(.21*yk*efe(9)))*xlfe10
	xlfe(10)=xlfe(10)+.87*xlfe10
	xlni(9)=xlni(9)+xlni9+(.09+.4*exp(.21*yk*eni(9)))*xlni10
	xlni(10)=xlni(10)+.91*xlni10
c     satellite lines from dielectronic recombination
	xlc(1)=xlc(1)*(1.+tm(1)/t)
	xln(1)=xln(1)*(1.+tm(2)/t)
	xlo(1)=xlo(1)*(1.+tm(3)/t)
	xlne(1)=xlne(1)*(1.+tm(4)/t)
	xlmg(1)=xlmg(1)*(1.+tm(5)/t)
	xlsi(1)=xlsi(1)*(1.+tm(6)/t)
	xls(1)=xls(1)*(1.+tm(7)/t)
	xlca(1)=xlca(1)*(1.+tm(8)/t)
	xlfe(1)=xlfe(1)*(1.+tm(9)/t)
	xlni(1)=xlni(1)*(1.+tm(10)/t)
	do 1220 i=1,8
	j=10+i
	xxx=alog10(t/tm(j))
	xxx=.77*xxx**2-1.76*xxx
	xxx=10.0**xxx
 1220 xlsat(i)=ds(i)*xxx
	i=9
	j=19
	xxx=alog10(t/tm(j))
	xxx=.57*xxx**2-1.661*xxx
	xxx=10.0**xxx
	xlsat(i)=ds(i)*xxx
	i=10
	j=20
	xxx=alog10(t/tm(j))
	xxx=.57*xxx**2-1.661*xxx
	xxx=10.0**xxx
	xlsat(i)=ds(i)*xxx
	xlc(9)=.88*xlc(11)*xlsat(1)+xlc(9)
	xlc(10)=.12*xlc(11)*xlsat(1)+xlc(10)
	xln(9)=.87*xln(11)*xlsat(2)+xln(9)
	xln(10)=.13*xln(11)*xlsat(2)+xln(10)
	xlo(9)=.86*xlo(11)*xlsat(3)+xlo(9)
	xlo(10)=.14*xlo(11)*xlsat(3)+xlo(10)
	xlne(9)=.85*xlne(11)*xlsat(4)+xlne(9)
	xlne(10)=.15*xlne(11)*xlsat(4)+xlne(10)
	xlmg(9)=.84*xlmg(11)*xlsat(5)+xlmg(9)
	xlmg(10)=.16*xlmg(11)*xlsat(5)+xlmg(10)
	xlsi(9)=.84*xlsi(11)*xlsat(6)+xlsi(9)
	xlsi(10)=.16*xlsi(11)*xlsat(6)+xlsi(10)
	xls(9)=.84*xls(11)*xlsat(7)+xls(9)
	xls(10)=.16*xls(11)*xlsat(7)+xls(10)
	xlca(9)=.83*xlca(11)*xlsat(8)+xlca(9)
	xlca(10)=.17*xlca(11)*xlsat(8)+xlca(10)
        tekeV = -1./yk
        xlsat(9) = 1.6021e-09*fe(25)*dcfhe(tekeV,26)
	xlfe(9)=.55*efe(9)*xlsat(9)+xlfe(9)
	xlfe(10)=.45*efe(10)*xlsat(9)+xlfe(10)
	xlni(9)=.55*xlni(11)*xlsat(10)+xlni(9)
	xlni(10)=.45*xlni(11)*xlsat(10)+xlni(10)
	xlc(13)=0.0
	xxx=t0(1)/t
	if (xlc(12).gt.0.0.and.xxx.lt.20.0)
     1   xlc(13)=xlc(12)*(ec(13)/ec(12))*(t1(1)/t)*exp(t0(1)/t)
	xln(13)=0.0
	xxx=t0(2)/t
	if (xln(12).gt.0.0.and.xxx.lt.20.0)
     1   xln(13)=xln(12)*(en(13)/en(12))*(t1(2)/t)*exp(t0(2)/t)
	xlo(13)=0.0
	xxx=t0(3)/t
	if (xlo(12).gt.0.0.and.xxx.lt.20.0)
     1   xlo(13)=xlo(12)*(eo(13)/eo(12))*(t1(3)/t)*exp(t0(3)/t)
	xlne(13)=0.0
	xxx=t0(4)/t
	if (xlne(12).gt.0.0.and.xxx.lt.20.0)
     1   xlne(13)=xlne(12)*(ene(13)/ene(12))*(t1(4)/t)*exp(t0(4)/t)
	xlmg(13)=0.0
	xxx=t0(5)/t
	if (xlmg(12).gt.0.0.and.xxx.lt.20.0)
     1   xlmg(13)=xlmg(12)*(emg(13)/emg(12))*(t1(5)/t)*exp(t0(5)/t)
	xlsi(13)=0.0
	xxx=t0(6)/t
	if (xlsi(12).gt.0.0.and.xxx.lt.20.0)
     1   xlsi(13)=xlsi(12)*(esi(13)/esi(12))*(t1(6)/t)*exp(t0(6)/t)
	xls(13)=0.0
	xxx=t0(7)/t
	if (xls(12).gt.0.0.and.xxx.lt.20.0)
     1   xls(13)=xls(12)*(es(13)/es(12))*(t1(7)/t)*exp(t0(7)/t)
	xlca(13)=0.0
	xxx=t0(8)/t
	if (xlca(12).gt.0.0.and.xxx.lt.20.0)
     1   xlca(13)=xlca(12)*(eca(13)/eca(12))*(t1(8)/t)*exp(t0(8)/t)
	xlfe(13)=0.0
	xxx=t0(9)/t
	if (xlfe(12).gt.0.0.and.xxx.lt.20.0)
     1   xlfe(13)=xlfe(12)*(efe(13)/efe(12))*(t1(9)/t)*exp(t0(9)/t)
	xlni(13)=0.0
	xxx=t0(10)/t
	if (xlni(12).gt.0.0.and.xxx.lt.20.0)
     1   xlni(13)=xlni(12)*(eni(13)/eni(12))*(t1(10)/t)*exp(t0(10)/t)
	iline=0
	do 1310 i=1,15
	iline=iline+1
1310	xl(iline)=xlc(i)
	do 1320 i=1,15
	iline=iline+1
1320	xl(iline)=xln(i)
	do 1330 i=1,15
	iline=iline+1
1330	xl(iline)=xlo(i)
	do 1340 i=1,20
	iline=iline+1
1340	xl(iline)=xlne(i)
	do 1350 i=1,22
	iline=iline+1
1350	xl(iline)=xlmg(i)
	do 1360 i=1,48
	iline=iline+1
1360	xl(iline)=xlsi(i)
	do 1370 i=1,70
	iline=iline+1
1370	xl(iline)=xls(i)
	do 1380 i=1,71
	iline=iline+1
1380	xl(iline)=xlca(i)
	do 1390 i=1,157
	iline=iline+1
1390	xl(iline)=xlfe(i)
	do 1400 i=1,133
	iline=iline+1
1400	xl(iline)=xlni(i)
	return
	end
*
*
*
      real function upsil(k,eij,c,p1,p2,p3,p4,p5,tt)
*
*        Maxwell averaged collision strength, upsilon.
*        Input:
*           k              -  transition type
*           eij            -  transition energy (Ryd.)
*           c              -  abscissa scale parameter
*           p1,p2,p3,p4,p5 -  B-spline knot values
*           tt             -  electron temperature
*        Output:
*           upsil
*
      IMPLICIT REAL (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      parameter ( n = 9 )
      parameter ( ks = 3 )
      parameter ( narr = 1 )
      dimension xx(narr), yy(narr)
      dimension t(n), splc(n)
      data t /0.0,0.0,0.0,0.0,0.5,1.0,1.0,1.0,1.0/
      e=abs(tt/(1.57888e5*eij))
      if( k .eq. 1 .or. k .eq. 4 ) x=log( (e+c)/c )/log(e+c)
      if( k .eq. 2 .or. k .eq. 3 ) x=e/(e+c)
      splc(1)=p1
      splc(2)=p2
      splc(3)=p3
      splc(4)=p4
      splc(5)=p5
      xx(1)=x
      call splev(t,n,splc,ks,xx,yy,narr,ier)
      y=yy(1)
      if( k .eq. 1 ) y=y*log(e+2.71828)
      if( k .eq. 3 ) y=y/(e+1.)
      if( k .eq. 4 ) y=y*log(e+c)
      upsil=y
      return
      end
*
*
*
* ======================================================================
* NIST Guide to Available Math Software.
* Fullsource for module SPLEV from package DIERCKX.
* Retrieved from NETLIB on Wed Jan 18 11:02:48 1995.
* ======================================================================
      subroutine splev(t,n,c,k,x,y,m,ier)
      IMPLICIT REAL (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
c  subroutine splev evaluates in a number of points x(i),i=1,2,...,m
c  a spline s(x) of degree k, given in its b-spline representation.
c
c  calling sequence:
c     call splev(t,n,c,k,x,y,m,ier)
c
c  input parameters:
c    t    : array,length n, which contains the position of the knots.
c    n    : integer, giving the total number of knots of s(x).
c    c    : array,length n, which contains the b-spline coefficients.
c    k    : integer, giving the degree of s(x).
c    x    : array,length m, which contains the points where s(x) must
c           be evaluated.
c    m    : integer, giving the number of points where s(x) must be
c           evaluated.
c
c  output parameter:
c    y    : array,length m, giving the value of s(x) at the different
c           points.
c    ier  : error flag
c      ier = 0 : normal return
c      ier =10 : invalid input data (see restrictions)
c
c  restrictions:
c    m >= 1
c    t(k+1) <= x(i) <= x(i+1) <= t(n-k) , i=1,2,...,m-1.
c
c  other subroutines required: fpbspl.
c
c  references :
c    de boor c  : on calculating with b-splines, j. approximation theory
c                 6 (1972) 50-62.
c    cox m.g.   : the numerical evaluation of b-splines, j. inst. maths
c                 applics 10 (1972) 134-149.
c    dierckx p. : curve and surface fitting with splines, monographs on
c                 numerical analysis, oxford university press, 1993.
c
c  author :
c    p.dierckx
c    dept. computer science, k.u.leuven
c    celestijnenlaan 200a, b-3001 heverlee, belgium.
c    e-mail : Paul.Dierckx@cs.kuleuven.ac.be
c
c  latest update : march 1987
c
c  ..scalar arguments..
      integer n,k,m,ier
c  ..array arguments..
      real t(n),c(n),x(m),y(m)
c  ..local scalars..
      integer i,j,k1,l,ll,l1,nk1
      real arg,sp,tb,te
c  ..local array..
      real h(6)
c  ..
c  before starting computations a data check is made. if the input data
c  are invalid control is immediately repassed to the calling program.
      ier = 10
      if(m-1) 100,30,10
  10  do 20 i=2,m
        if(x(i).lt.x(i-1)) go to 100
  20  continue
  30  ier = 0
c  fetch tb and te, the boundaries of the approximation interval.
      k1 = k+1
      nk1 = n-k1
      tb = t(k1)
      te = t(nk1+1)
      l = k1
      l1 = l+1
c  main loop for the different points.
      do 80 i=1,m
c  fetch a new x-value arg.
        arg = x(i)
        if(arg.lt.tb) arg = tb
        if(arg.gt.te) arg = te
c  search for knot interval t(l) <= arg < t(l+1)
  40    if(arg.lt.t(l1) .or. l.eq.nk1) go to 50
        l = l1
        l1 = l+1
        go to 40
c  evaluate the non-zero b-splines at arg.
  50    call fpbspl(t,n,k,arg,l,h)
c  find the value of s(x) at x=arg.
        sp = 0.
        ll = l-k1
        do 60 j=1,k1
          ll = ll+1
          sp = sp+c(ll)*h(j)
  60    continue
        y(i) = sp
  80  continue
 100  return
      end
*
*
*
      subroutine fpbspl(t,n,k,x,l,h)
      IMPLICIT REAL (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
c  subroutine fpbspl evaluates the (k+1) non-zero b-splines of
c  degree k at t(l) <= x < t(l+1) using the stable recurrence
c  relation of de boor and cox.
c  ..
c  ..scalar arguments..
      real x
      integer n,k,l
c  ..array arguments..
      real t(n),h(6)
c  ..local scalars..
      real f,one
      integer i,j,li,lj
c  ..local arrays..
      real hh(5)
c  ..
      one = 0.1e+01
      h(1) = one
      do 20 j=1,k
        do 10 i=1,j
          hh(i) = h(i)
  10    continue
        h(1) = 0.
        do 20 i=1,j
          li = l+i
          lj = li-j
          f = hh(i)/(t(li)-t(lj))
          h(i) = h(i)+f*(t(li)-x)
          h(i+1) = f*(x-t(lj))
  20  continue
      return
      end
*
*
*
      real function upsilb(nz,nl,temp)
*
*        Maxwell averaged collision strength, upsilon, for
*        He-like ions (Keenan, McCann, and Kingston 1987, Physica
*        Scripta 35,432). These fits should probably be checked at
*        high temperatures.
*        Input:
*           nz             -  nuclear charge
*           nl             -  level number
*           temp           -  electron temperature (K)
*        Output:
*           upsila
*
*
      IMPLICIT REAL (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      parameter ( nlmax = 12, nzmax = 28 )
      real a0(nlmax,nzmax), a1(nlmax,nzmax), a2(nlmax,nzmax)
      data ( a0(i,9), a1(i,9), a2(i,9), i=1,nlmax ) /
     .   6.3137E-2,   -1.5071E-2,   9.0825E-4,
     .   -1.2766E-2,   5.5308E-3,   -5.1462E-4,
     .   -3.8357E-2,   1.6675E-2,   -1.5568E-3,
     .   -6.3901E-2,   2.7676E-2,   -2.5748E-3,
     .   1.0397E-1,   -3.0918E-2,   2.4485E-3,
     .   4.3628E-1,   -1.4814E-1,   1.3128E-2,
     .   5.0868E-3,   -9.4342E-4,   4.2554E-5,
     .   -1.6016E-3,   8.1641E-4,   -7.9779E-5,
     .   -5.0840E-3,   2.5467E-3,   -2.4808E-4,
     .   -5.1567E-3,   3.2564E-3,   -3.3893E-4,
     .   1.3146E-2,   -4.1144E-3,   3.5077E-4,
     .   1.1074E-1,   -3.6707E-2,   3.1574E-3 /
      data ( a0(i,10), a1(i,10), a2(i,10), i=1,nlmax ) /
     .   2.7350E-2,   -5.0095E-3,   1.9501E-4,
     .   -1.2771E-2,   5.1472E-3,   -4.5958E-4,
     .   -3.8120E-2,   1.5441E-2,   -1.3845E-3,
     .   -6.3938E-2,   2.5762E-2,   -2.2998E-3,
     .   6.6122E-2,   -1.9177E-2,   1.5103E-3,
     .   2.6642E-1,   -8.9491E-2,   7.9637E-3,
     .   5.0386E-3,   -9.9098E-4,   4.8211E-5,
     .   -1.9017E-3,   8.4871E-4,   -7.8693E-5,
     .   -5.8899E-3,   2.6110E-3,   -2.4197E-4,
     .   -6.6055E-3,   3.4202E-3,   -3.3492E-4,
     .   8.4656E-3,   -2.5643E-3,   2.1717E-4,
     .   8.5960E-2,   -2.7638E-2,   2.3154E-3 /
      data ( a0(i,11), a1(i,11), a2(i,11), i=1,nlmax ) /
     .   1.0826E-2,   -7.1163E-00,   -8.5510E-5,
     .   1.1143E-2,   4.4483E-3,   -3.8754E-4,
     .   -3.4107E-2,   1.3322E-2,   -1.1640E-3,
     .   -5.7199E-2,   2.2258E-2,   -1.9388E-3,
     .   4.3705E-2,   -1.2397E-2,   9.7685E-4,
     .   1.7728E-1,   -5.9193E-2,   5.3098E-3,
     .   4.1688E-3,   -7.9472E-4,   3.6491E-5,
     .   -1.9805E-3,   8.1708E-4,   -7.2845E-5,
     .   -6.0170E-3,   2.4782E-3,   -2.2103E-4,
     .   -8.2469E-3,   3.6248E-3,   -3.3210E-4,
     .   5.3101E-3,   -1.5661E-3,   1.3407E-4,
     .   6.9313E-2,   -2.1782E-2,   1.7883E-3 /
      data ( a0(i,13), a1(i,13), a2(i,13), i=1,nlmax ) /
     .   3.5212E-4,   1.4932E-3,   -1.9316E-4,
     .   -7.5435E-3,   2.9018E-3,   -2.4788E-4,
     .   -2.2803E-2,   8.7244E-3,   -7.4215E-4,
     .   -3.7660E-2,   1.4493E-2,   -1.2381E-3,
     .   2.1378E-2,   -5.8457E-3,   4.6740E-4,
     .   1.1296E-1,   -3.7138E-2,   3.3099E-3,
     .   1.7383E-3,   -2.0699E-4,   1.2880E-7,
     .   -1.8821E-3,   6.9798E-4,   -5.8404E-5,
     .   -5.5901E-3,   2.0737E-3,   -1.7332E-4,
     .   -1.0956E-2,   3.9053E-3,   -3.1200E-4,
     .   1.6072E-3,   -4.6446E-4,   4.6102E-5,
     .   4.7696E-2,   -1.4608E-2,   1.1715E-3 /
      data ( a0(i,14), a1(i,14), a2(i,14), i=1,nlmax ) /
     .   -1.7102E-4,   1.3701E-3,   -1.6762E-4,
     .   -5.6561E-3,   2.2251E-3,   -1.9082E-4,
     .   -1.7179E-2,   6.6764E-3,   -5.6719E-4,
     .   -2.8169E-2,   1.1094E-2,   -9.5184E-4,
     .   1.6410E-2,   -4.4274E-3,   3.5617E-4,
     .   1.1071E-1,   -3.5777E-2,   3.1107E-3,
     .   6.5456E-4,   5.0706E-5,   -1.5334E-5,
     .   -1.7825E-3,   6.3507E-4,   -5.1735E-5,
     .   -5.2325E-3,   1.8646E-3,   -1.5150E-4,
     .   -1.1657E-2,   3.9012E-3,   -3.0678E-4,
     .   6.2784E-4,   -1.9272E-4,   2.5178E-5,
     .   4.0868E-2,   -1.2457E-2,   9.9337E-4 /
      data ( a0(i,15), a1(i,15), a2(i,15), i=1,nlmax ) /
     .   4.9135E-4,   9.7747E-4,   -1.2748E-4,
     .   -3.9340E-3,   1.6322E-3,   -1.4233E-4,
     .   -1.1846E-2,   4.8243E-3,   -4.1436E-4,
     .   -1.9512E-2,   8.1165E-3,   -7.0850E-4,
     .   1.3573E-2,   -3.6257E-3,   2.9145E-4,
     .   1.1884E-1,   -3.7589E-2,   3.1632E-3,
     .   -2.4879E-4,   2.5942E-4,   -2.7413E-5,
     .   -1.6718E-3,   5.7502E-4,   -4.5701E-5,
     .   -4.8198E-3,   1.6585E-3,   -1.3126E-4,
     .   -1.1931E-2,   3.8052E-3,   -2.8920E-4,
     .   3.6703E-6,   -2.8106E-5,   1.2671E-5,
     .   3.5914E-2,   -1.0932E-2,   8.6876E-4 /
      data ( a0(i,16), a1(i,16), a2(i,16), i=1,nlmax ) /
     .   1.7370E-3,   4.7597E-4,   -8.3331E-5,
     .   -2.4111E-3,   1.1244E-3,   -1.0183E-4,
     .   -6.8750E-3,   3.1655E-3,   -2.8162E-4,
     .   -1.1861E-2,   5.5678E-3,   -5.0537E-4,
     .   1.2116E-2,   -3.2135E-3,   2.5571E-4,
     .   1.3357E-1,   -4.1331E-2,   3.3644E-3,
     .   -9.5289E-4,   4.1575E-4,   -3.6011E-5,
     .   -1.5552E-3,   5.1862E-4,   -4.0296E-5,
     .   -4.3579E-3,   1.4550E-3,   -1.1240E-4,
     .   -1.1819E-2,   3.6302E-3,   -2.6814E-4,
     .   -3.5886E-4,   6.1009E-5,   5.8930E-6,
     .   3.2523E-2,   -9.9042E-3,   7.8462E-4 /
      data ( a0(i,17), a1(i,17), a2(i,17), i=1,nlmax ) /
     .   3.2211E-3,   -4.7868E-5,   -4.0486E-5,
     .   -1.0960E-3,   6.9740E-4,   -6.8499E-5,
     .   -2.2964E-3,   1.6899E-3,   -1.6680E-4,
     .   -5.2596E-3,   3.4260E-3,   -3.3832E-4,
     .   1.1536E-2,   -3.0423E-3,   2.3776E-4,
     .   1.5220E-1,   -4.6154E-2,   3.6464E-3,
     .   -1.4675E-3,   5.2360E-4,   -4.1490E-5,
     .   -1.4364E-3,   4.6619E-4,   -3.5482E-5,
     .   -3.8548E-3,   1.2545E-3,   -9.4773E-5,
     .   -1.1400E-2,   3.3967E-3,   -2.4490E-4,
     .   -5.3322E-4,   9.8151E-5,   2.9321E-6,
     .   3.0423E-2,   -9.2679E-3,   7.3116E-4 /
      data ( a0(i,18), a1(i,18), a2(i,18), i=1,nlmax ) /
     .   4.8155E-3,   -5.7078E-4,   2.4163E-7,
     .   5.7446E-5,   3.3125E-4,   -4.0472E-5,
     .   2.0460E-3,   3.3369E-4,   -6.3996E-5,
     .   5.2542E-4,   1.5909E-3,   -1.9793E-4,
     .   1.1528E-2,   -3.0245E-3,   2.3095E-4,
     .   1.7421E-1,   -5.1865E-2,   3.9906E-3,
     .   -1.8354E-3,   5.9445E-4,   -4.4637E-5,
     .   -1.3176E-3,   4.1720E-4,   -3.1143E-5,
     .   -3.3092E-3,   1.0534E-3,   -7.7882E-5,
     .   -1.0763E-2,   3.1255E-3,   -2.2056E-4,
     .   -5.7746E-4,   1.0071E-4,   2.4215E-6,
     .   2.9423E-2,   -8.9532E-3,   7.0188E-4 /
      data ( a0(i,19), a1(i,19), a2(i,19), i=1,nlmax ) /
     .   6.4218E-3,   -1.0713E-3,   3.7788E-5,
     .   1.0579E-3,   1.9989E-5,   -1.7068E-5,
     .   6.1687E-3,   -9.1689E-4,   2.8468E-5,
     .   5.5366E-3,   3.2770E-5,   -8.0831E-5,
     .   1.1888E-2,   -3.1025E-3,   2.3109E-4,
     .   1.9846E-1,   -5.8122E-2,   4.3711E-3,
     .   -2.0738E-3,   6.3359E-4,   -4.5848E-5,
     .   -1.1989E-3,   3.7121E-4,   -2.7211E-5,
     .   -2.7204E-3,   8.5026E-4,   -6.1548E-5,
     .   -9.9623E-3,   2.8290E-3,   -1.9584E-4,
     .   -5.2603E-4,   7.9064E-5,   3.5662E-6,
     .   2.9358E-2,   -8.9014E-3,   6.9172E-4 /
      data ( a0(i,21), a1(i,21), a2(i,21), i=1,nlmax ) /
     .   7.5704E-3,   -1.4731E-3,   6.9905E-5,
     .   1.8863E-3,   -2.5539E-4,   4.3984E-6,
     .   9.8000E-3,   -2.0733E-3,   1.1671E-4,
     .   9.6693E-3,   -1.3417E-3,   2.6336E-5,
     .   1.0969E-2,   -2.8284E-3,   2.0534E-4,
     .   2.0965E-1,   -6.0011E-2,   4.3875E-3,
     .   -1.9036E-3,   5.5945E-4,   -3.9324E-5,
     .   -9.0108E-4,   2.7594E-4,   -1.9952E-5,
     .   -1.5178E-3,   4.7813E-4,   -3.3721E-5,
     .   -7.9339E-5,   2.2093E-3,   -1.5006E-4,
     .   -3.4268E-4,   3.1677E-5,   5.5435E-6,
     .   2.8363E-2,   -8.4526E-3,   6.4261E-4 /
      data ( a0(i,22), a1(i,22), a2(i,22), i=1,nlmax ) /
     .   7.2141E-3,   -1.4185E-3,   6.8488E-5,
     .   1.8366E-3,   -2.6138E-4,   5.8589E-6,
     .   9.7528E-3,   -2.1344E-3,   1.2528E-4,
     .   9.4088E-3,   -1.3689E-3,   3.3484E-5,
     .   9.6181E-3,   -2.4662E-3,   1.7901E-4,
     .   1.9522E-1,   -5.5461E-2,   4.0231E-3,
     .   -1.6027E-3,   4.7399E-4,   -3.3379E-5,
     .   -7.2175E-4,   2.2529E-4,   -1.6437E-5,
     .   -9.0504E-4,   3.0461E-4,   -2.1579E-5,
     .   -6.7330E-3,   1.8843E-3,   -1.2823E-4,
     .   -2.5173E-4,   1.5384E-5,   5.7964E-6,
     .   2.6736E-2,   -7.8805E-3,   5.9270E-4 /
      data ( a0(i,23), a1(i,23), a2(i,23), i=1,nlmax ) /
     .   6.8247E-3,   -1.3520E-3,   6.6080E-5,
     .   1.7429E-3,   -2.5406E-4,   6.3312E-6,
     .   9.8439E-3,   -2.2505E-3,   1.3600E-4,
     .   8.9249E-3,   -1.3287E-3,   3.5637E-5,
     .   8.3098E-3,   -2.1201E-3,   1.5429E-4,
     .   1.7913E-1,   -5.0556E-2,   3.6431E-3,
     .   -1.2812E-3,   3.8542E-4,   -2.7371E-5,
     .   -5.3741E-4,   1.7462E-4,   -1.3000E-5,
     .   -2.4397E-4,   1.2240E-4,   -9.1213E-6,
     .   -5.3533E-3,   1.5217E-3,   -1.0450E-4,
     .   -1.3027E-4,   -7.9478E-6,   6.5101E-6,
     .   2.5069E-2,   -7.3070E-3,   5.4376E-4 /
      data ( a0(i,24), a1(i,24), a2(i,24), i=1,nlmax ) /
     .   6.4718E-3,   -1.2880E-3,   6.3446E-5,
     .   1.6341E-3,   -2.3961E-4,   6.1614E-6,
     .   1.0156E-2,   -2.3747E-3,   1.4923E-4,
     .   8.3654E-3,   -1.2528E-3,   3.4572E-5,
     .   7.1993E-3,   -1.8288E-3,   1.3368E-4,
     .   1.6421E-1,   -4.6070E-2,   3.3007E-3,
     .   -9.7778E-4,   3.0368E-4,   -2.1926E-5,
     .   -3.6810E-4,   1.2905E-4,   -9.9632E-6,
     .   4.0188E-4,   -5.1599E-5,   2.5422E-6,
     .   -3.8961E-3,   1.1469E-3,   -8.0448E-5,
     .   1.4061E-5,   -3.7166E-5,   7.6696E-6,
     .   2.3671E-2,   -6.8212E-3,   5.0221E-4 /
      data ( a0(i,25), a1(i,25), a2(i,25), i=1,nlmax ) /
     .   6.1100E-3,   -1.2200E-3,   6.0435E-5,
     .   1.5070E-3,   -2.1957E-4,   5.5723E-6,
     .   1.0753E-2,   -2.5924E-3,   1.6714E-4,
     .   7.7133E-3,   -1.1485E-3,   3.1380E-5,
     .   6.1351E-3,   -1.5531E-3,   1.1446E-4,
     .   1.4871E-1,   -4.1511E-2,   2.9601E-3,
     .   -6.5437E-4,   2.1853E-4,   -1.6365E-5,
     .   -1.9222E-4,   8.2704E-5,   -6.9333E-6,
     .   1.1112E-3,   -2.3888E-4,   1.4872E-5,
     .   -2.1182E-3,   6.9850E-4,   -5.2201E-5,
     .   2.0221E-4,   -7.6616E-5,   9.4633E-6,
     .   2.2346E-2,   -6.3622E-3,   4.6326E-4 /
      data ( a0(i,26), a1(i,26), a2(i,26), i=1,4 ) /
     .   -.146750E-02, 0.523600E-03, -.414900E-04,
     .   -.153898E-01, 0.459610E-02, -.329585E-03,
     .   -.577460E-03, 0.100710E-03, 0.242150E-05,
     .   0.294230E-01, -.895320E-02, 0.701880E-03 /
      tl = alog10(temp)
      upsilb = a0(nl,nz) + tl*( a1(nl,nz) + tl*a2(nl,nz) )
      upsilb = amax1(upsilb,0.0)
      return
      end
*
*
*
      function upsila(nz,nl,temp)
*
*        Maxwell averaged collision strength, upsilon, for
*        He-like ions (from Kato and Nakazaki).
*        Input:
*           nz             -  nuclear charge
*           nl             -  level number
*           temp           -  electron temperature (K)
*        Output:
*           upsila
*
*
      IMPLICIT REAL (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      parameter ( nlmax = 12, nzmax = 28 )
*        Conversion factors.
      real eV, boltz, tconv
      parameter ( eV = 1.60219e-12, boltz = 1.38062e-16 )
      parameter ( tconv = boltz/eV )
      REAL TUV(nlmax,nzmax),A(nlmax,nzmax),B(nlmax,nzmax),
     .     C(nlmax,nzmax),D(nlmax,nzmax),E(nlmax,nzmax),
     .     P(nlmax,nzmax),Q(nlmax,nzmax),X1(nlmax,nzmax)
      DATA (TUV(I,2),A(I,2),B(I,2),C(I,2),D(I,2),E(I,2),I=1,4) /
     .  1.98E+01,8.21E-04,4.22E-02,1.81E-01,-1.55E-01,0.0,
     .  2.10E+01,-1.22E-03, 4.75E-02,2.63E-01,-2.94E-01,0.0,
     .  2.06E+01,1.72E-01,-3.46E-01,4.28E-01,-2.21E-01,0.0,
     .  2.12E+01,6.73E-02,-6.66E-01,6.08E-01,0.0,6.46E-01 /
      DATA (TUV(I,3),A(I,3),B(I,3),C(I,3),D(I,3),E(I,3),I=1,4) /
     .  5.90E+01,-1.47E-03,1.70E-02,5.56E-02,-1.51E-02,0.0,
     .  6.12E+01,4.68E-03,-9.41E-02,6.19E-01,-4.40E-01,0.0,
     .  6.07E+01,2.17E-01,-3.02E-01,1.23E-01,0.0,-3.77E-02,
     .  6.22E+01,1.49E-01,-3.03E-01,1.90E-01,0.0,4.00E-01 /
      DATA (TUV(I,6),A(I,6),B(I,6),C(I,6),D(I,6),E(I,6),I=1,5) /
     .  2.98E+02,-1.82E-05,1.09E-03,1.68E-02,-8.79E-03,0.0,
     .  3.03E+02,1.85E-05,-1.77E-03,6.15E-02,-1.57E-02,0.0,
     .  3.04E+02,2.89E-02,-3.86E-02,1.58E-02,5.42E-03,0.0,
     .  3.08E+02,4.59E-02,-1.17E-01,1.01E-01,0.0,1.14E-01,
     .  3.54E+02,1.29E-02,-2.13E-02,1.66E-02,0.0,2.11E-02 /
      DATA (TUV(I,8),A(I,8),B(I,8),C(I,8),D(I,8),E(I,8),I=1,5) /
     .  5.61E+02,-2.33E-05,1.03E-03,5.97E-03,-2.86E-03,0.0,
     .  5.68E+02,5.74E-05,-8.06E-04,3.32E-02,-9.39E-03,0.0,
     .  5.69E+02,1.61E-02,-2.41E-02,2.73E-02,-1.27E-02,0.0,
     .  5.74E+02,2.07E-02,-1.55E-02,1.30E-02,0.0,6.56E-02,
     .  6.66E+02,4.43E-03,-2.30E-03,2.12E-03,0.0,1.23E-02 /
      DATA (TUV(I,12),A(I,12),B(I,12),C(I,12),D(I,12),E(I,12),I=1,4) /
     .  1.34E+03,-7.35E-05,1.02E-03,1.79E-03,-1.12E-03,0.0,
     .  1.33E+03,1.19E-04,-1.64E-03,1.99E-02,-8.71E-03,0.0,
     .  1.34E+03,7.79E-03,-1.24E-02,1.48E-02,-6.68E-03,0.0,
     .  1.34E+03,-8.77E-04,1.26E-02,-1.57E-03,0.0,3.02E-02 /
      DATA (TUV(I,20),A(I,20),B(I,20),C(I,20),D(I,20),E(I,20),I=1,6) /
     .  3.87E+03,-2.49E-05,4.05E-04,-1.13E-04, 8.08E-04,0.0,
     .  3.89E+03,-3.48E-08,-3.44E-05,6.92E-04,-2.04E-04,0.0,
     .  3.89E+03,6.45E-04,-8.06E-04,1.40E-03,1.46E-04,0.0,
     .  3.89E+03,-4.53E-07,-1.66E-04,3.41E-03,-9.82E-04,0.0,
     .  3.89E+03,2.87E-03,-3.43E-03,1.95E-03,0.0,-1.97E-04,
     .  3.91E+03,1.06E-03,-7.09E-05,3.06E-03,0.0,1.04E-02 /
      DATA (TUV(I,22),A(I,22),B(I,22),C(I,22),D(I,22),E(I,22),I=1,6) /
     .  4.70E+03,-3.02E-06,3.27E-04,-8.48E-05,5.03E-04,0.0,
     .  4.73E+03,6.80E-06,-2.15E-05,4.10E-04,-1.89E-05,0.0,
     .  4.73E+03,1.07E-03,-2.71E-03,4.10E-03,-1.25E-03,0.0,
     .  4.74E+03,8.87E-05,-4.38E-04,2.66E-03,-4.35E-04,0.0,
     .  4.73E+03,1.87E-03,-1.20E-03,2.59E-04,1.44E-04,0.0,
     .  4.76E+03,1.72E-03, -7.93E-04,2.32E-03,0.0,8.41E-03 /
      DATA (TUV(I,26),A(I,26),B(I,26),C(I,26),D(I,26),E(I,26),I=1,6) /
     .  6.65E+03,-4.11E-05,6.25E-04,-1.13E-03,1.21E-03,0.0,
     .  6.67E+03,-7.87E-06,8.78E-05,1.22E-04,7.41E-05,0.0,
     .  6.68E+03,1.66E-03,-5.09E-03,7.74E-03,-3.56E-03,0.0,
     .  6.69E+03,-4.46E-05,4.79E-04,4.81E-04,4.63E-04,0.0,
     .  6.67E+03,1.59E-03,-1.53E-03,7.48E-04,0.0,-7.20E-05,
     .  6.71E+03,7.22E-04,-4.34E-04,2.28E-03,0.0,5.72E-03 /
      DATA (TUV(I,28),A(I,28),B(I,28),C(I,28),D(I,28),E(I,28),I=1,6) /
     .  7.74E+03,-3.83E-05,4.60E-04,-5.42E-04,5.65E-04,0.0,
     .  7.77E+03,-7.46E-06,7.28E-05,8.94E-05,7.16E-05,0.0,
     .  7.77E+03,1.67E-03,-4.24E-03,5.32E-03,-1.96E-03,0.0,
     .  7.80E+03,-6.09E-05,5.39E-04,7.80E-05,5.94E-04,0.0,
     .  7.77E+03,1.12E-03,-4.88E-04,-3.21E-04,3.56E-04,0.0,
     .  7.82E+03,9.56E-04,-3.90E-04,1.38E-03,0.0,4.91E-03 /
      DATA  P(1,6), Q(1,6), X1(1,6) /
     .  -1.78E+00,1.83E+00,1.02 /
      DATA  ( P(I,8), Q(I,8), X1(I,8), I=1,3 ) /
     .  -9.33E-02,1.09E-01,1.10,
     .  -2.37E-01,2.68E-01,1.04,
     .  -5.76E-04,1.83E-02,1.02 /
      DATA  ( P(I,12), Q(I,12), X1(I,12), I=1,2 ) /
     .  -1.29E-02,1.68E-02,1.25,
     .  1.28E-02,-3.53E-03,1.20 /
      scale = 1.0
      if( nz .le. 12 .and. nl .gt. 1 )then
         n = max(nl,4) - 2
         if( nl .eq. 2 ) scale = 1./9.
         if( nl .eq. 3 ) scale = 3./9.
         if( nl .eq. 4 ) scale = 5./9.
         if( nl .eq. 7 ) n = 5
       else
         n = nl
      endif
      aa = a(n,nz)
      bb = b(n,nz)
      cc = c(n,nz)
      dd = d(n,nz)
      ee = e(n,nz)
      pp = p(n,nz)
      qq = q(n,nz)
      xx = amax1( 1.0, x1(n,nz) )
      t = tuv(n,nz)/(tconv*temp)
      upsila = strfit( t, 1, aa, bb, cc, dd, ee, 0.0, pp, qq, xx )*
     .                                                   scale
*      temp = t
      return
      end
*
*
*
      REAL FUNCTION STRFIT( Y, NTYPE, A, B, C, D, E, F, P, Q, X1 )
*
*        Calculates collision strengths according to formulas given in
*        Itikawa et al. (1985).
*
      IMPLICIT REAL (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      X = EXP( -Y*(X1-1.) )
      IF( NTYPE .EQ. 1 )THEN
         STRFIT = X*( A + E*ALOG(X1) + Y*(C+.5*D*(1./X1-Y))/X1 +
     2            XEXE1X(Y*X1)*( B - C*Y + .5*D*Y**2 + E/Y )/X1 )
       ELSE
         STRFIT = X*Y*( A/X1 + B/(F+Y)*EXP(-F*X1) +
     1      C/(2.*F+Y)*EXP(-2.*F*X1) + D/(3.*F+Y)*EXP(-3.*F*X1) +
     2      E/(4.*F+Y)*EXP(-4.*F*X1) - A*XEXE1X(Y*X1)/X1 )
      ENDIF
      STRFIT = STRFIT + P + Q + P/Y - X*( Q + X1*P + P/Y )
      END
*
*
*
      REAL FUNCTION XEXE1X(ARG)
*
*        Calculates function x*exp(x)*E1(x).
*
      IMPLICIT REAL (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      IF( ARG .LT. 1.0E-8 )THEN
         XEXE1X=20.0 
         XEXE1X = ARG*EXP(ARG)*XEXE1X
       ELSEIF( ARG .LT. 1. )THEN
         S2= ARG*ARG 
         S3= ARG*S2
         XEXE1X= -0.57721566 - ALOG(ARG) + 0.99999193*ARG -
     1           0.24991055*S2 + 0.0519968*S3 -
     2           0.00976004*S2*S2 + 0.00107857*S3*S2 
         XEXE1X = ARG*EXP(ARG)*XEXE1X
       ELSE
         XEXE1X=(ARG*ARG+2.334733*ARG+0.250621)/
     1          (ARG*ARG+3.330657*ARG+1.681534)
      ENDIF
      END 
*
*
*
      function dcfhe(t,nz)
*
*        Dielectronic recombination for He-like ions according to
*        individual fits
*        Input: t   -  temperature in keV
*               nz  -  atomic number Z
*
      IMPLICIT REAL (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      parameter ( nelem = 13 )
      integer nzz(nelem)
      real dche(nelem,2), dehe(nelem,2)
      data nzz /6,7,8,10,11,12,13,14,16,18,20,26,28/
      data ( ( dche(i,k), k=1,2 ), i=1,nelem ) / 
     . 0.291354E-02, 0.147341E-01,
     . 0.996770E-02, 0.261071E-01,
     . 0.759510E-02, 0.514944E-01,
     . 0.159875E-01, 0.972719E-01,
     . 0.326295E-01, 0.113643E+00,
     . 0.456476E-01, 0.133224E+00,
     . 0.573982E-01, 0.164022E+00,
     . 0.602121E-01, 0.193001E+00,
     . 0.885269E-01, 0.251566E+00,
     . 0.127069E+00, 0.295466E+00,
     . 0.169272E+00, 0.348906E+00,
     . 0.288151E+00, 0.420670E+00,
     . 0.313024E+00, 0.460917E+00 /
      data ( ( dehe(i,k), k=1,2 ), i=1,nelem ) / 
     . 0.251034E+03, 0.297426E+03,
     . 0.356267E+03, 0.422289E+03,
     . 0.435220E+03, 0.548011E+03,
     . 0.676471E+03, 0.866187E+03,
     . 0.840676E+03, 0.107462E+04,
     . 0.100956E+04, 0.128691E+04,
     . 0.117511E+04, 0.150106E+04,
     . 0.134859E+04, 0.173416E+04,
     . 0.175692E+04, 0.225047E+04,
     . 0.222565E+04, 0.288590E+04,
     . 0.272295E+04, 0.351858E+04,
     . 0.465981E+04, 0.609950E+04,
     . 0.540782E+04, 0.707508E+04 /
      ielem = 0.0
      j=0
 50   continue
         j = j + 1
         if( nzz(j) .eq. nz )then
            ielem = j
          elseif( j .lt. nelem )then
            go to 50
         endif
         if( ielem .eq. 0 )then
            dcfhe = 0.0
            return
         endif
      ekt = 1.e3*t
      t4 = ekt/0.861707
      tmr = 1.e-6*(t4**(-1.5))
      dcfhe = ( dche(ielem,1)*exp(-dehe(ielem,1)/ekt) +
     .          dche(ielem,2)*exp(-dehe(ielem,2)/ekt) )*tmr
      return
      end

c **************************************************************
c dummy routine to get round potential problem in gfortran

	subroutine xdinit(a)
	return
	end
