      subroutine func3(jkk,jkkl,lpri,lun11,lfpi,vturbi,
     $       t,trad,r,xee,xpx,xh1,xh0,cfrac,
     $       epi,ncn2,bremsa,bremsint,tau0,tauc,
     $       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,
     $       xeltp,rrcor,htt,cll,cllines,clcont,rrrt,
     $       xilev,ipmat,ipmatsv,rniss,
     $       rcem,oplin,rccemis,opakc,opakscatt,
     $       cemab,opakab,fline,flinel)
c
c     this routine calculates rates affecting emission and
c        absorption
c     author: T. Kallman
c
      implicit none
c
      include './PARAM'
c
      integer nptmpdim
      parameter (nptmpdim=200000)
c
c     master data
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 emissivities
      real rcem(2,nnnl)
c     line optical depths
      real tau0(2,nnnl)
c     energy bins
      real epi(ncn)
c     continuum flux
      real bremsa(ncn),bremsint(ncn)
c     continuum emissivities
      real rccemis(2,ncn)
c     line opacities
      real oplin(nnnl)
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,np2
      integer nlsvn,ncsvn
      real rlev(10,nd)
      integer ilev(10,nd),nlpt(nd),iltp(nd)
      character*1 kdat(nptmpdim),klev(100,nd)
      character*48 kdesc2
      real rdat(nptmpdim)
      integer idat(nptmpdim)
      real fline(ncn),flinel(ncn)
c     level populations
      real xilev(nd)
      real cemab(2,nnml),opakab(nnml)
      real tauc(2,nnml)
      character*1 kblnk
      real tsq,ans1,ans2,xh1,xh0,cfrac
      real abund1,abund2,ptmp1,ptmp2,ans3,ans4,opakb1,
     $     xeltp,rrcor,cllines,clcont,htt,cll
      integer idest1,idest2,idest3,idest4
      real rniss(nnml)
      real abundtot,rrrt
      real tau1,tau2,e1,e2,pescl,pescv,
     $     cemtmp1,cemtmp2,czzz,elin,ener,htsum,eth,opakbb,
     $     rcemm,rcsum,ergsev
      integer nlev,nlevmx,mltype,ml,mllz,mlrdesc,lpriu,
     $     lforce,llo,lup,jkk,ipmat,ltyp,
     $     lrtyp,lcon,nrdt,nidt,nkdt,lk,kkkl,jkkl,ipmatsv,
     $     lfpi3,lprisv,ml3,mm,nb1,nbinc,mlpar,mlm,lfpi
c
c
      data kblnk/' '/
c
      ergsev=1.602197e-12
      lfpi3=lfpi
c
      abundtot=0.
      rrrt=0.
      tsq=sqrt(t)
c
      lprisv=lpri
c
      htt=0.
      cll=0.
c     now find level data
c     step thru types
      nlevmx=0
      mltype=13
      ml=npfi(mltype,jkk)
      mllz=npar(ml)
c     step thru records of this type
      mlpar=0
      if (ml.ne.0) mlpar=npar(ml)
      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)
        nlev=idat(nidt-1)
        nlevmx=max(nlevmx,nlev)
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),idat(nidt),(kdat(mm),mm=1,8)
c9101     format (1x,'level quantities:',4i6,4(1pe12.5),4i6,8a1)
        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
          do lk=nkdt+1,20
            klev(lk,nlev)=kblnk
            enddo
          endif
        ml=npnxt(ml)
        if (ml.ne.0) mlpar=npar(ml)
        enddo
      nlev=nlevmx
      if (lpri.ne.0) then
        write (lun11,*)'level populations:'
        do mm=1,nlev
          write (lun11,9022)mm,(klev(ml,mm),ml=1,20),
     $      rlev(1,mm),rlev(2,mm),
     $      xilev(mm+ipmat),rniss(mm+ipmat)
 9022     format (i4,20a1,4(1pe10.3))
          enddo
        endif
c
c     now do other  rates
      lpriu=lpri
      mltype=9
      mlrdesc=mltype
      ml=npfi(mltype,jkk)
      if (ml.ne.0) then
        mllz=npar(ml)
        mlpar=npar(ml)
        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)
          idest1=idat(1)
          idest2=idat(2)
          jkkl=nplini(ml)
          if ((rdat(1).gt.0.01).and.(jkkl.ne.0)
     $      .and.(idest1.gt.0).and.(idest2.gt.0).and.
     $      (idest1.lt.nlev).and.(idest2.lt.nlev)) then
            e1=rlev(1,idest1)
            e2=rlev(1,idest2)
            eth=abs(e2-e1)
            if (e1.lt.e2) then
                lup=idest2+ipmat
                llo=idest1+ipmat
              else
                lup=idest1+ipmat
                llo=idest2+ipmat
              endif
            abund1=xilev(llo)*xpx*xeltp
            abund2=xilev(lup)*xpx*xeltp
            tau1=tau0(1,jkkl)
            tau2=tau0(2,jkkl)
            ptmp1=
     $        pescl(tau1)*(1.-cfrac)
            ptmp2=pescl(tau2)*(1.-cfrac)+2.*pescl(tau1+tau2)*cfrac
            lforce=1
            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,lfpi3,lun11,
     $        idat1,rdat1,kdat1,nptrs,np2,
     $        npar,npnxt,npfi,npfirst,
     $        nplin,nplini,nlsvn,npcon,npconi,npilev,npilevi,
     $        npconi2,ncsvn,rates,vsav,idrates,lforce)
c
            cemtmp1=abund2*ptmp1*ans4
            cemtmp2=abund2*ptmp2*ans4
            rcsum=ans4*abund2
            cll=cll+rcsum
            clcont=clcont+rcsum
            if ((lpri.ge.1))
     $        write (lun11,9002)jkk,lrtyp,ltyp,idest1,idest2,
     $        llo,lup,ml,ans1,ans2,ans3,ans4,
     $        cemtmp1+cemtmp2,opakb1,eth,
     $        jkkl,cll,htt,lforce
            endif
          ml=npnxt(ml)
          mlpar=0
          if (ml.ne.0) mlpar=npar(ml)
          enddo
        endif
c
c     now do other  rates
      mltype=7
      mlrdesc=mltype
      ml=npfi(mltype,jkk)
      mllz=0
      if (ml.ne.0) mllz=npar(ml)
      mlpar=mllz
      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)
        idest1=idat(nidt-1)
        idest2=nlev+idat(nidt-3)-1
        kkkl=npconi2(ml)
        if ((kkkl.ne.0).and.(kkkl.le.ndat2)
     $     .and.(idest1.gt.0)) then
          llo=idest1+ipmat
          lup=idest2+ipmat
          eth=rlev(4,idest1)-rlev(1,idest1)
          abund1=xilev(llo)*xeltp
          abund2=xilev(lup)*xeltp
          if (lup.gt.ipmatsv) then
            lup=min(lup,ipmatsv)
            abund2=0.
            endif
          if ((lup.le.ipmatsv).and.
     $      (xilev(llo)/(1.e-36+xilev(1+ipmat)).gt.0.)) then
            tau1=tauc(1,kkkl)
            tau2=tauc(2,kkkl)
            ptmp1=
     $        pescv(tau1)*(1.-cfrac)
            ptmp2=pescv(tau2)*(1.-cfrac)+2.*pescv(tau1+tau2)*cfrac
            lforce=1
            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,opakab(kkkl),
     $        opakc,opakscatt,rccemis,fline,lpriu,kdesc2,
     $        r,t,trad,tsq,xee,xh1,xh0,
     $        epi,ncn2,bremsa,bremsint,
     $        rlev,ilev,nlpt,iltp,nlev,klev,lfpi3,lun11,
     $        idat1,rdat1,kdat1,nptrs,np2,
     $        npar,npnxt,npfi,npfirst,
     $        nplin,nplini,nlsvn,npcon,npconi,npilev,npilevi,
     $        npconi2,ncsvn,rates,vsav,idrates,lforce)
            htsum=ans3*xpx*abund1
            rcsum=ans4*xpx*abund2
            rrrt=rrrt+xilev(lup)*(ptmp1+ptmp2)*ans2
            abundtot=abundtot+xilev(lup)
            cemtmp1=abund2*xpx*ptmp1*ans4*rrcor
            cemtmp2=abund2*xpx*ptmp2*ans4*rrcor
            cemab(1,kkkl)=cemab(1,kkkl)+cemtmp1
            cemab(2,kkkl)=cemab(2,kkkl)+cemtmp2
            htt=htt+htsum
            clcont=clcont+rcsum
            cll=cll+rcsum
            if (lpri.ge.1)
     $        write (lun11,9002)jkk,lrtyp,ltyp,
     $          idest1,idest2,llo,lup,ml,ans1,ans2,
     $          ans3,ans4,cemab(1,kkkl)+cemab(2,kkkl),
     $          opakab(kkkl),eth,
     $          kkkl,cll,htt,lforce
c     $          ,abund1,abund2,ptmp1,ptmp2
 9002         format (1x,8i6,' h-c ',
     $          7(1pe10.3),i6,2(1pe10.3),i4,4(1pe10.3))
            endif
          endif
        ml=npnxt(ml)
        mlpar=0
        if (ml.ne.0) mlpar=npar(ml)
        enddo
c
      mltype=42
      mlrdesc=mltype
      ml=npfi(mltype,jkk)
      if (ml.ne.0) then
        mllz=npar(ml)
        mlpar=npar(ml)
        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)
          idest1=idat(nidt-1)
          idest2=idat(nidt-2)
          if (idest1.gt.0) then
            llo=idest1+ipmat
            lup=idest2+ipmat
            eth=rlev(4,idest1)-rlev(1,idest1)
            abund1=xilev(llo)*xeltp
            abund2=xilev(lup)*xeltp
            if (lup.gt.ipmatsv) then
              abund2=0.
              lup=ipmatsv
              endif
            if ((lup.le.ipmatsv).and.
     $      (xilev(llo)/(1.e-36+xilev(1+ipmat)).gt.1.e-24)) then
              lforce=1
              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,opakbb,
     $          opakc,opakscatt,rccemis,fline,lpriu,kdesc2,
     $          r,t,trad,tsq,xee,xh1,xh0,
     $          epi,ncn2,bremsa,bremsint,
     $          rlev,ilev,nlpt,iltp,nlev,klev,lfpi3,lun11,
     $          idat1,rdat1,kdat1,nptrs,np2,
     $          npar,npnxt,npfi,npfirst,
     $          nplin,nplini,nlsvn,npcon,npconi,npilev,npilevi,
     $          npconi2,ncsvn,rates,vsav,idrates,lforce)
              htsum=ans3*xpx*abund1
              htt=htt+htsum
              czzz=0.
              if (lpri.ge.1)
     $        write (lun11,9002)jkk,lrtyp,ltyp,
     $          idest1,idest2,llo,lup,ml,ans1,ans2,
     $          ans3,ans4,czzz,opakbb,eth,kkkl,cll,htt,lforce
              endif
            endif
          ml=npnxt(ml)
          if (ml.ne.0) mlpar=npar(ml)
          enddo
        endif
c
      mltype=1
      mlrdesc=mltype
      ml=npfi(mltype,jkk)
      mllz=0
      if (ml.ne.0) mllz=npar(ml)
      mlpar=mllz
      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)
        if (.not.((mlrdesc.eq.1).and.((ltyp.eq.93).or.(ltyp.eq.53)))
     $      .and.(.not.((mlrdesc.eq.7).and.(idat(nidt-1).ne.1))))
     $      then
          if (nidt.gt.3) then
            idest1=idat(nidt-1)
            idest2=nlev+idat(nidt-3)-1
            kkkl=npconi2(ml)
c            if (lpri.ne.0) write (lun11,*)'kkkl=',kkkl,idest1,ltyp
            if ((kkkl.ne.0).and.(kkkl.le.ndat2)
     $        .and.(idest1.gt.0)) then
              llo=idest1+ipmat
              lup=idest2+ipmat
c              eth=rlev(4,idest1)-rlev(1,idest1)
              eth=rdat(1)
              abund1=xilev(llo)*xeltp
              abund2=xilev(lup)*xeltp
              if (lup.gt.ipmatsv) then
                abund2=0.
                lup=ipmatsv
                endif
c              if (lpri.ne.0) write (lun11,*)lup,ipmatsv,llo,xilev(llo),
c     $               xilev(1+ipmat)
              if ((lup.le.ipmatsv).and.
     $          (xilev(llo)/(1.e-36+xilev(1+ipmat)).gt.1.e-24)) then
                tau1=tauc(1,kkkl)
                tau2=tauc(2,kkkl)
                ptmp1=
     $          pescv(tau1)*(1.-cfrac)
                ptmp2=pescv(tau2)*(1.-cfrac)+2.*pescv(tau1+tau2)*cfrac
                lforce=1
                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,opakab(kkkl),
     $            opakc,opakscatt,rccemis,fline,lpriu,kdesc2,
     $            r,t,trad,tsq,xee,xh1,xh0,
     $            epi,ncn2,bremsa,bremsint,
     $            rlev,ilev,nlpt,iltp,nlev,klev,lfpi3,lun11,
     $            idat1,rdat1,kdat1,nptrs,np2,
     $            npar,npnxt,npfi,npfirst,
     $            nplin,nplini,nlsvn,npcon,npconi,npilev,npilevi,
     $            npconi2,ncsvn,rates,vsav,idrates,lforce)
                htsum=ans3*xpx*abund1
                rrrt=rrrt+xilev(lup)*(ptmp1+ptmp2)*ans2
                abundtot=abundtot+xilev(lup)
                htt=htt+htsum
                if (lpri.ge.1)
     $            write (lun11,9002)jkk,lrtyp,ltyp,
     $            idest1,idest2,llo,lup,ml,ans1,ans2,
     $            ans3,ans4,cemab(1,kkkl)+cemab(2,kkkl),
     $            opakab(kkkl),eth,
     $            kkkl,cll,htt,lforce
                endif
              endif
            endif
          endif
        ml=npnxt(ml)
        mlpar=0
        if (ml.ne.0) mlpar=npar(ml)
        enddo
c
      mltype=4
      mlrdesc=mltype
      ml=npfi(mltype,jkk)
      if (ml.ne.0) then
        mllz=npar(ml)
        mlpar=npar(ml)
        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)
             idest1=idat(1)
             idest2=idat(2)
             jkkl=nplini(ml)
             if ((rdat(1).gt.0.01).and.(jkkl.ne.0)
     $          .and.(idest1.gt.0).and.(idest2.gt.0).and.
     $          (idest1.lt.nlev).and.(idest2.lt.nlev)) then
               e1=rlev(1,idest1)
               e2=rlev(1,idest2)
               if (e1.lt.e2) then
                   lup=idest2+ipmat
                   llo=idest1+ipmat
                 else
                   lup=idest1+ipmat
                   llo=idest2+ipmat
                 endif
c               if (lpri.ne.0) write (lun11,*)idest1,idest2
               if ((xilev(llo)/(1.e-36+xilev(1+ipmat)).gt.1.e-24).or.
     $             (xilev(lup)/(1.e-36+xilev(1+ipmat)).gt.1.e-24)) then
                 abund1=xilev(llo)*xpx*xeltp
                 abund2=xilev(lup)*xpx*xeltp
                 tau1=tau0(1,jkkl)
                 tau2=tau0(2,jkkl)
                 ptmp1=
     $                pescl(tau1)*(1.-cfrac)
                 ptmp2=pescl(tau2)*(1.-cfrac)+2.*pescl(tau1+tau2)*cfrac
                 lpriu=lpri
                 lforce=1
                 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,lfpi3,lun11,
     $             idat1,rdat1,kdat1,nptrs,np2,
     $             npar,npnxt,npfi,npfirst,
     $             nplin,nplini,nlsvn,npcon,npconi,npilev,npilevi,
     $             npconi2,ncsvn,rates,vsav,idrates,lforce)
                 rcem(1,jkkl)=abund2*ans4*ptmp1
                 rcem(2,jkkl)=abund2*ans4*ptmp2
                 cll=cll+rcem(1,jkkl)+rcem(2,jkkl)
                 htt=htt+abund1*ans3
                 cllines=cllines+rcem(1,jkkl)+rcem(2,jkkl)
                 ml3=nplin(jkkl)
                 if (ml3.ne.0) then
                   mlm=ml3-1
                   call dread(ltyp,lrtyp,lcon,
     $               nrdt,rdat,nidt,idat,nkdt,kdat,mlm,
     $               idat1,rdat1,kdat1,nptrs,0,lun11)
                   elin=abs(rdat(1))
                   ener=12398.54/elin
                   nb1=nbinc(ener,epi,ncn2)
                   nb1=max(2,min(ncn2-1,nb1))
                   oplin(jkkl)=opakb1
c                   fline(nb1)=fline(nb1)+abund2*ans4*(ptmp1+ptmp2)
c     $                *2./(epi(nb1+1)-epi(nb1-1))/ergsev
c                   flinel(nb1)=fline(nb1)+abund2*ans4
c     $                *2./(epi(nb1+1)-epi(nb1-1))/ergsev
                   if ((lpri.ge.1))
     $               write (lun11,9002)jkk,lrtyp,
     $                 ltyp,idest1,idest2,
     $                 llo,lup,ml,ans1,ans2,ans3,ans4,
     $                 rcem(1,jkkl)+rcem(2,jkkl),oplin(jkkl),
     $                 rdat(1),jkkl,cll,htt,lforce
                   endif
                 endif
               endif
             ml=npnxt(ml)
             if (ml.ne.0) mlpar=npar(ml)
             enddo
        endif
c
           mltype=14
           mlrdesc=mltype
           ml=npfi(mltype,jkk)
           mllz=0
           if (ml.ne.0)  mllz=npar(ml)
           mlpar=mllz
           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)
             idest1=idat(nidt-3)
             idest2=idat(nidt-2)
             if ((idest1.gt.0).and.(idest2.gt.0).and.
     $          (idest1.lt.nlev).and.(idest2.lt.nlev)) then
               e1=rlev(1,idest1)
               e2=rlev(1,idest2)
               eth=abs(e2-e1)
               if (e1.lt.e2) then
                   lup=idest2+ipmat
                   llo=idest1+ipmat
                 else
                   lup=idest1+ipmat
                   llo=idest2+ipmat
                 endif
               if ((xilev(llo)/(1.e-36+xilev(1+ipmat)).gt.1.e-24).or.
     $             (xilev(lup)/(1.e-36+xilev(1+ipmat)).gt.1.e-24)) then
                 abund1=xilev(llo)*xpx*xeltp
                 abund2=xilev(lup)*xpx*xeltp
                 tau1=tau0(1,jkkl)
                 tau2=tau0(2,jkkl)
                 ptmp1=
     $                pescl(tau1)*(1.-cfrac)
                 ptmp2=pescl(tau2)*(1.-cfrac)+2.*pescl(tau1+tau2)*cfrac
                 lpriu=lpri
                 lforce=1
                 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,lfpi3,lun11,
     $             idat1,rdat1,kdat1,nptrs,np2,
     $             npar,npnxt,npfi,npfirst,
     $             nplin,nplini,nlsvn,npcon,npconi,npilev,npilevi,
     $             npconi2,ncsvn,rates,vsav,idrates,lforce)
                 rcemm=abund2*ans4
                 rccemis(2,3)=rccemis(2,3)+
     $                  rcemm/(epi(4)-epi(3)+1.e-24)/ergsev
c                if (lpri.ne.0) write (lun11,*)jkkl,tau0(1,jkkl),
                 cll=cll+rcemm
                 clcont=clcont+rcemm
                 if ((lpri.ge.1))
     $              write (lun11,9002)jkk,lrtyp,ltyp,
     $               idest1,idest2,llo,lup,ml,ans1,ans2,
     $               ans3,ans4,rcemm,opakb1,eth,
     $               kkkl,cll,htt,lforce
                 endif
               endif
             ml=npnxt(ml)
             mlpar=0
             if (ml.ne.0) mlpar=npar(ml)
             enddo
c
      rrrt=rrrt/max(1.e-24,abundtot)
      lpri=lprisv
c
c
      return
      end
