      subroutine func1(jkk,kl,nnz,lpri,lun11,lfpi,vturbi,
     $       t,trad,r,xee,xpx,xh1,xh0,
     $       epi,ncn2,bremsa,bremsint,
     $       idat1,rdat1,kdat1,nptrs,np2,
     $       npar,npnxt,npfi,npfirst,
     $       nplin,nplini,nlsvn,npcon,npconi,npilev,npilevi,
     $       npconi2,ncsvn,rates,vsav,idrates,
     $       rlev,ilev,
     $          nlpt,iltp,nlev,klev,
     $       pirt,rrrt2)
c
c     this routine calculates rates affecting ion balance
c     author: T. Kallman
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     energy bins
      real epi(ncn)
c     continuum flux
      real bremsa(ncn),bremsint(ncn)
c     continuum emissivities
      real rccemis(2,ncn)
      real fline(ncn),flinel(ncn)
c     continuum opacities
      real opakc(ncn),opakscatt(ncn)
c     element abundances
c     the saved rates
      real rates(4,ndat2)
      integer idrates(2,ndat2)
      real vsav(4,ndat2)
c     state variables
      real r,t,xpx
c     heating-cooling variables
c     input parameters
      real trad
      real vturbi,xee
      integer ncn2,lpri,lun11,lfpi,np2
      integer nlsvn,ncsvn
      real rlev(10,nd)
      integer ilev(10,nd),nlpt(nd),iltp(nd)
      real pirt(31)
      character*1 kdat(nptmpdim),klev(100,nd)
      character*48 kdesc2
      real rdat(nptmpdim)
      integer idat(nptmpdim)
      real tsq,ans1,ans2,xh1,xh0,rrrt2
      real abund1,abund2,ptmp1,ptmp2,ans3,ans4,opakb1
      integer idest1,idest2,idest3,idest4
      integer nnzp,nlevmx,mltype,ml,mllz,nlev,mlpar,
     $  ltyp,lrtyp,lcon,nrdt,nidt,nkdt,mlrdesc,llo,lup,
     $  lforce,nnz,mm,jkk,lk,lpriu,kl,nidtm,mlm
c
c      if (lpri.ne.0)
c     $  write (lun11,*)'in func1, inputs:',t,
c     $         xee,xpx,xnx
c
c     zero temporaries
      tsq=sqrt(t)
      nnzp=nnz+1
      do mm=1,nnzp
        pirt(mm)=0.
        enddo
      rrrt2=0.
      nlev=0
c     now find level data
c     step thru types
      nlevmx=0
      mltype=13
      ml=npfi(mltype,jkk)
      mllz=npar(ml)
      mlpar=npar(ml)
c     step thru records of this type
      do while ((ml.ne.0).and.(mlpar.eq.mllz))
        mlm=ml-1
        call dread(ltyp,lrtyp,lcon,
     $    nrdt,rdat,nidt,idat,nkdt,kdat,mlm,
     $    idat1,rdat1,kdat1,nptrs,0,lun11)
        nlevmx=nlevmx+1
        nlev=idat(nidt-1)
 9101   format (1x,'level quantities:',4i6,4(1pe12.5),3i6,8a1)
c       if (lpri.ne.0) write (lun11,9101)
c     $   ml,nlev,ltyp,lrtyp,(rdat(mm),mm=1,4),idat(1),idat(2),
c     $   idat(3),(kdat(mm),mm=1,8)
        if ((nlev.gt.0).and.(nlev.le.nd)) then
          nlpt(nlev)=ml
          iltp(nlev)=ltyp
          do  lk=1,nrdt
            rlev(lk,nlev)=rdat(lk)
            enddo
          do lk=1,nidt
            ilev(lk,nlev)=idat(lk)
            enddo
          do lk=1,nkdt
            klev(lk,nlev)=kdat(lk)
            enddo
          endif
        ml=npnxt(ml)
        if (ml.ne.0) mlpar=npar(ml)
        enddo
      nlev=nlevmx
c     now find all the rates affecting this ion
c     step thru types
      mltype=1
      do while (mltype.lt.ntyp)
        mlrdesc=mltype
        ml=npfi(mltype,jkk)
        if (((mlrdesc.eq.6).or.(mlrdesc.eq.1).or.(mlrdesc.eq.8)
     $    .or.(mlrdesc.eq.15).or.(mlrdesc.eq.7).or.(mlrdesc.eq.42))
     $    .and.(ml.ne.0)) then
          mllz=npar(ml)
          mlpar=npar(ml)
          do while ((ml.ne.0).and.(mlpar.eq.mllz))
c           step thru records of this type
            if (nptrs(3,ml).eq.mlrdesc) then
              mlm=ml-1
              call dread(ltyp,lrtyp,lcon,
     $          nrdt,rdat,nidt,idat,nkdt,kdat,mlm,
     $          idat1,rdat1,kdat1,nptrs,0,lun11)
c              call dprinto(ltyp,lrtyp,lcon,
c     $          nrdt,rdat,nidt,idat,nkdt,kdat,lun11)
              nidtm=max(1,nidt-1)
c             calculate rates
              lpriu=lpri
              lforce=1
              abund1=0.
              abund2=0.
              ptmp1=0.
              ptmp2=0.
              idest1=0
              if (lrtyp.eq.7) idest1=idat(nidt-1)
              if (((lrtyp.eq.1).and.(ltyp.ne.53))
     $             .or.((lrtyp.eq.7).and.(idest1.eq.1))
     $             .or.(lrtyp.eq.15).or.(lrtyp.eq.42)) then
                 call ucalc(ltyp,lrtyp,ml,lcon,jkk,vturbi,
     $             nrdt,rdat,nidt,idat,nkdt,kdat,ans1,ans2,
     $             ans3,ans4,idest1,idest2,idest3,idest4,
     $             abund1,abund2,ptmp1,ptmp2,xpx,opakb1,
     $             opakc,opakscatt,rccemis,fline,lpriu,kdesc2,
     $             r,t,trad,tsq,xee,xh1,xh0,
     $             epi,ncn2,bremsa,bremsint,
     $             rlev,ilev,nlpt,iltp,nlev,klev,lfpi,lun11,
     $             idat1,rdat1,kdat1,nptrs,np2,
     $             npar,npnxt,npfi,npfirst,
     $             nplin,nplini,nlsvn,npcon,npconi,npilev,npilevi,
     $             npconi2,ncsvn,rates,vsav,idrates,lforce)
                 if (idest1.ne.0) then
                   llo=idest3
                   lup=idest4-idest3
                   pirt(kl+lup)=pirt(kl+lup)+ans1
                   if (lpri.ge.1)
     $              write (lun11,9001)jkk,lrtyp,ltyp,llo,lup+idest3,
     $                      ml,ans1,pirt(kl+lup)
 9001               format (1x,6i6,' ion ',1pe10.3,14x,1pe10.3)
                   endif
                 endif
              if ((lrtyp.eq.6).or.(lrtyp.eq.8)) then
                 call ucalc(ltyp,lrtyp,ml,lcon,jkk,vturbi,
     $             nrdt,rdat,nidt,idat,nkdt,kdat,ans1,ans2,
     $             ans3,ans4,idest1,idest2,idest3,idest4,
     $             abund1,abund2,ptmp1,ptmp2,xpx,opakb1,
     $             opakc,opakscatt,rccemis,fline,lpriu,kdesc2,
     $             r,t,trad,tsq,xee,xh1,xh0,
     $             epi,ncn2,bremsa,bremsint,
     $             rlev,ilev,nlpt,iltp,nlev,klev,lfpi,lun11,
     $             idat1,rdat1,kdat1,nptrs,np2,
     $             npar,npnxt,npfi,npfirst,
     $             nplin,nplini,nlsvn,npcon,npconi,npilev,npilevi,
     $             npconi2,ncsvn,rates,vsav,idrates,lforce)
                 rrrt2=rrrt2+ans1
c                Commented... llo has a funny value...    jg
                 llo=1
                 if (lpri.ge.1)                   
     $              write (lun11,9002)jkk,lrtyp,ltyp,llo,ml,
     $                    ans1,rrrt2
 9002            format (1x,4i6,6x,i6,' ion ',14x,
     $                              1pe10.3,14x,1pe10.4)
                 endif
              endif
            ml=npnxt(ml)
            if (ml.ne.0) mlpar=npar(ml)
            enddo
          endif
        mltype=mltype+1
        enddo
c
c
      return
      end
