      subroutine xstarsetup(lnerrd,nlimd,lforce,lfpi,
     $       lpri,lprid,lunlog,tinf,critf,
     $       t,tp,r,delr,xee,xpx,ababs,abel,cfrac,xlum,p,lcdd,
     $       epi,ncn2,bremsa,bremsint,
     $       decomp,ecomp,sxcomp,
     $       zrems,zremsz,
     $       tau0,dpthc,tauc,
     $       idat1,rdat1,kdat1,nptrs,np2,
     $       npar,npnxt,npfi,npfirst,nlevs,
     $       nplin,nplini,nlsvn,npcon,npconi,npilev,npilevi,
     $       npconi2,ncsvn,rates,vsav,idrates,
     $       ntotit,
     $       xii,rrrt,pirt,htt,cll,httot,cltot,hmctot,elcter,
     $       xilev,bilev,rniss,nmat,elum,
     $       rcem,oplin,rccemis,brcems,opakc,opakscatt,cemab,
     $       opakab,nlin,elin)
c
c      this routine does many of the setup chores: read in atomic 
c        data, set up pointers, zeroing variables.  
c      NB: no input parameters are affected
c     
      implicit none
c
      include './PARAM'
c
      integer nptmpdim
      parameter (nptmpdim=200000)
c
c     global xstar data
c     master data
      integer idat1(nidat1)
      real rdat1(nrdat1)
      integer nptrs(nptt,ndat2)
      character*1 kdat1(nkdat1)
c     pointers to master data
      integer npar(ndat2),npnxt(ndat2),
     $      npfirst(ntyp)
      integer npfi(ntyp,nni)
c     pointers to line data
      integer nplin(nnnl),nplini(ndat2)
c     pointers to line data
      integer npcon(nnml),npconi2(ndat2),npconi(ndat2)
      integer npilev(nd,nni),npilevi(nnml)
c     line luminosities
      real elum(3,nnnl),elumo(3,nnnl)
c     line emissivities
      real rcem(2,nnnl)
c     line opacities
      real oplin(nnnl)
      real fline(ncn),flinel(ncn)
c     line optical depths
      real tau0(2,nnnl)
c     energy bins
      real epi(ncn)
c      continuum lum
      real zrems(4,ncn),zremso(4,ncn),
     $          zremsz(ncn)
c     continuum optical depths
      real dpthc(2,ncn)
c     continuum flux
      real bremsa(ncn),bremsint(ncn)
c     continuum emissivities
      real rccemis(2,ncn),brcems(ncn)
c     continuum opacities
      real opakc(ncn),opakscatt(ncn)
c     level populations
      real xilev(nnml),bilev(nnml),rniss(nnml)
      real cemab(2,nnml),opakab(nnml)
      real elumab(2,nnml),elumabo(2,nnml)
      real tauc(2,nnml)
c     ion abundances
      real xii(nni)
c     heating and cooling
      real htt(nni),cll(nni)
      real rrrt(nni),pirt(nni)
      integer nlevs(nni)
c     element abundances
      real abel(nl),abcosmic(30),ababs(nl)
c     the saved rates
      real rates(4,ndat2)
      integer idrates(2,ndat2)
      real vsav(4,ndat2)
c     compton heating data
      real decomp(ncomp,ncomp),ecomp(ncomp),sxcomp(ncomp)
      integer nlin(nnnl)
      real elin(nnnl)
c
c     local variables
c     state variables
      real p,r,t,xpx,delr,tp
c     heating-cooling variables
      real httot,cltot,htcomp,clcomp,clbrems,elcter,cllines,
     $     clcont,hmctot
c     input parameters
      real xlum,xpxcol
      real cfrac,critf,xee
      integer lcdd,ncn2
c     variables associated with thermal equilibrium solution
      integer nmat,ntotit,lnerrd
c     switches
      integer lprid,lpri,lfpi
      integer  nlimd,lunlog,lun11,lun25
c     temporary for xwrite
      character*133 tmpst
c     strings for atomic data read
      character*256 datafil3,datafil4,datafile
      logical ex3,ex4
c     temporary integers
      integer ll,mm,ldir,jk,mlm
      integer nlsvn,ncsvn, lenact
c     times
      real tinf,t1s
      integer np1r,np1i,np1k,np2
      integer lforce,jlk,j,ml,ltyp,lrtyp,lcon,
     $        nrdt,nidt,nkdt
C     storing info for parameters
      character*20 parname(55)
      real rdat(nptmpdim)
      integer idat(nptmpdim)
      character*1 kdat(nptmpdim)
c
c     Not used
      integer javi
      real javir
c
      data abcosmic/1.00E+000, 1.00E-001, 
     $ 1.e-10, 1.e-10, 1.e-10, 3.70E-004, 1.10E-004, 
     $ 6.80E-004, 3.98E-008, 2.80E-005, 1.78E-006, 3.50E-005, 
     $ 2.45E-006, 3.50E-005, 3.31E-007, 1.60E-005, 3.98E-007, 
     $ 4.50E-006, 8.91E-008, 2.10E-006, 1.66E-009, 1.35E-007, 
     $ 2.51E-008, 7.08E-007, 2.51E-007, 2.50e-005, 1.26E-007, 
     $ 2.00E-006, 3.16E-008, 1.58E-008/
c 
c
C     Parameter Names
C
      data parname/'cfrac','temperature',
     $   'lcpres','pressure','density','spectrum',
     $   'spectrum_file','spectun','trad',
     $   'rlrad38','column','rlogxi',
     $   'nsteps','niter','lwrite',
     $   'lprint','lstep',
     $   'habund','heabund',
     $   'liabund','beabund','babund','cabund',
     $   'nabund','oabund','fabund','neabund',
     $   'naabund','mgabund','alabund',
     $   'siabund','pabund','sabund',
     $   'clabund','arabund','kabund',
     $   'caabund','scabund','tiabund',
     $   'vabund','crabund','mnabund ',
     $   'feabund','coabund','niabund',
     $   'cuabund','znabund','emult','taumax','xeemin',
     $   'critf','vturbi','npass','modelname',
     $   'loopcontrol'/

c
      javir=t
      javir=tp
      javi=nlimd
      javi=lfpi
      javi=lcdd
      lcdd=javi
      javir=delr
      javir=cfrac
      javir=xlum
      javir=p
      p=javir
      javir=critf
c
      call remtms(t1s)
c
c     opening message
      write (lunlog,*)'xstar version 2.2.1bc'
c
c     Test if atomic database files are available.  Abort if not.
      call getenv('LHEA_DATA', datafile)
      datafil4 = datafile(1:lenact(datafile))//'/atdb.fits'
      datafil3 = datafile(1:lenact(datafile))//'/coheat.dat'
      inquire(file=datafil3,exist=ex3)
      inquire(file=datafil4,exist=ex4)
      if (.not.(ex3 .and. ex4 )) then
         write(tmpst,*)'xstar: One or more of the Atomic Database files'
         write(lunlog,*)tmpst
         call xwrite(tmpst,10)
         write(tmpst,*)'xstar: are missing.'
         write(lunlog,*)tmpst
         call xwrite(tmpst,10)
         write(tmpst,*)'xstar: ',datafil4(1:lenact(datafil4))
         write(lunlog,*)tmpst
         call xwrite(tmpst,10)
         write(tmpst,*)'xstar: ',datafil3(1:lenact(datafil3))
         write(lunlog,*)tmpst
         call xwrite(tmpst,10)
         write(tmpst,*)'Program aborting...'
         write(lunlog,*)tmpst
         call xwrite(tmpst,10)
         close(lunlog)
         stop 'xstar: Missing Atomic Data files.  Aborting...'
      endif
c
c
c
!      tread=0.
!      trates1=0.
!      thcor=0.
!      trates2=0.
!      theat=0.
!      do kl=1,ntyp
!         tucalc(kl)=0.
!         ncall(kl)=0
!         enddo
c
c
c     read in
      write (lunlog,*)'Loading Atomic Database...'
      write (tmpst,*)'Loading Atomic Database...'
      call xwrite(tmpst,10)

      call readtbl(nptrs,np1r,np1i,np1k,np2,ndat2,
     &      rdat1,idat1,kdat1,nidat1,datafil4,lpri,lunlog)
c
c
      call getlun(lun25)
      open(unit=lun25,file=datafil3,status='unknown')
      rewind(lun25)
      read (lun25,901)      
 901  format (1x)
      do mm=1,ncomp
        do ll=1,ncomp
          read (lun25,902)sxcomp(mm),
     $            ecomp(ll),decomp(mm,ll)
 902      format (9x,e12.4,12x,2(e12.4))
          enddo
        enddo
      close(lun25)
c
c
c     Initialize the database
      write (lunlog,*)'initializng database...'
      write (tmpst,*)'initializng database...'
      call xwrite(tmpst,10)      
      lpri=0
      call setptrs(lunlog,lpri,
     $ idat1,rdat1,kdat1,nptrs,np2,
     $ npnxt,npfi,npar,npfirst,nplin,
     $ nplini,npcon,npconi,npilev,npilevi,
     $ npconi2,nlevs,nlsvn,ncsvn,abcosmic,abel)
      lpri=0
c
c     read in parameter values
c      write(lunlog,*)'Atomic Abundances'
c      write(lunlog,*)'Element      Solar    Hydrogen'
      do ll=1,nl
        ababs(ll)=abel(ll)*abcosmic(ll)
        write(lunlog,9990)parname(17+ll),abel(ll),ababs(ll)
        enddo
      write(lunlog,*)' '
 9990 format(A10,2(E12.4))
c
c
c     set up and initialize
      tinf=0.31
      call init(bremsa,bremsint,tau0,dpthc,tauc,
     $   xii,rrrt,pirt,htt,cll,httot,cltot,
     $   cllines,clcont,htcomp,clcomp,clbrems,
     $   xilev,rcem,oplin,rccemis,brcems,opakc,opakscatt,
     $   cemab,opakab,elumab,elumabo,elum,elumo,
     $   zrems,zremso,rates,vsav,idrates,fline,flinel)
      
c
      do jk=1,ncn
        zrems(1,jk)=0.
        zrems(2,jk)=0.
        dpthc(1,jk)=0.
        dpthc(2,jk)=0.
        enddo
      do jk=1,nnnl
        elum(1,jk)=0.
        elum(2,jk)=0.
        tau0(1,jk)=0.
        tau0(2,jk)=0.
        enddo
      do jk=1,nnml
        bilev(jk)=0.
        rniss(jk)=0.
        tauc(1,jk)=0.
        tauc(2,jk)=0.
        enddo
c
      lforce=1
      lnerrd=0
      ntotit=0
      lprid=0
      xee=1.2
      elcter=0.      
      hmctot=0.
c
          ldir=1
          lun11=lunlog
          call trnfrc(lpri,lun11,ldir,
     $      r,xpxcol,xpx,
     $      epi,ncn2,zremsz,dpthc,opakc,
     $      zrems,bremsa,bremsint,flinel)
c
c
c
      nmat=nds
c
      do jlk=1,nlsvn
         j=jlk
         ml=nplin(j)
         mlm=ml-1
         call dread(ltyp,lrtyp,lcon,
     $     nrdt,rdat,nidt,idat,nkdt,kdat,mlm,
     $     idat1,rdat1,kdat1,nptrs,0,lun11)
         elin(jlk)=0.
         nlin(jlk)=0
         if (lrtyp.ne.14) then
           elin(jlk)=rdat(1)
           nlin(jlk)=idat(nidt)
           endif
         enddo
c
      return
      end
