      subroutine phint53(stmpp,etmpp,ntmp,ethi,pirt,rrrt,piht,rrcl,
     $ abund1,abund2,ptmp1,ptmp2,xpx,opakab,
     $ opakc,rccemis,lpri,epi,ncn2,bremsa,t,swrat,xnx,crit,
     $ lfast,lun11)
c
c
c     this routine does the integration over the spectrum as required by
c     photo.
c     this is my version from 11/1/99 which performs successive bisections
c      g stands for good
c
      implicit none
c
      integer ntmp
c
      include './PARAM'
c
      real  bremsa(ncn),epi(ncn),stmpp(ntmp),etmpp(ntmp)
      real rccemis(2,ncn),opakc(ncn)
      integer lpri,ncn2,lfast,lun11
      real ethi,pirt,rrrt,piht,rrcl,abund1,abund2,ptmp1,ptmp2,xpx,
     $     opakab,t,swrat,xnx,crit
      real eth,ergsev,bk,tm,bktm,ener,sgtmp,epii,sgtp,ansar1,optmp,
     $     sumr,sumh,sumi,sumc,tempi,atmp2,enero,sgtmpo,dels,
     $     sgmn,sgmx,bremtmp,tempr,tempro,epiio,deld,sumho,exptst,
     $     tempi1,tempi2,tempio,rnist,tsq,
     $     atmp2o,bbnurj,exptmp
      integer lprisv,numcon2,nphint,nb1,kl,jk,
     $     nbinc,jkp
c
      data ergsev/1.602197e-12/
      data bk/1.38062e-16/
c
      eth=ethi
c
c
      lprisv=lpri
      if (lpri.ge.1) write (lun11,*)'in phint53:',
     $      eth,xnx,swrat,t,
     $      stmpp(1),etmpp(1),ntmp,lfast,ptmp1,ptmp2
c
      tm=t*1.e4
      bktm=bk*tm/ergsev
      tsq = sqrt(t)
      rnist=(2.61e-21)*swrat/t/tsq
c
      if (lpri.ge.1) write (lun11,*)'in phint53:',
     $      eth,rnist,xnx,swrat,t,
     $      stmpp(1),etmpp(1),ntmp,lfast
c
      numcon2=max(2,ncn2/50)
      nphint=ncn2-numcon2
c
      sumr = 0.
      sumh = 0.
      sumho=0.
      tempr = 0.
      sumc = 0.
      sumi=0.
      tempi=0.
      atmp2=0.
      ener=ethi+etmpp(1)*(13.598)
      nb1=nbinc(ener,epi,ncn2)
      kl=nb1
      if (kl.ge.nphint) return
      if (epi(kl+1).lt.ethi) return
      sgtmp=stmpp(1)
      crit=0.005
      tempr=0.
      dels=0.
      epii=epi(kl)
      jk=0
      jkp=min(jk+1,ntmp)
      do while ((jk.lt.ntmp).and.
     $          (ethi+etmpp(jkp)*(13.598).lt.epi(nphint-1)))
c     $    .and.(abs(sumh/(sumho+1.e-24)-1.).gt.1.e-6))
        jk=jk+1
        enero=ener
        ener=ethi+etmpp(jk)*(13.598)
        sgtmpo=sgtmp
        sgtmp=stmpp(jk)
        if (lpri.ne.0) write (lun11,*)jk,ener,kl,epi(kl),kl,nphint
        if (epi(kl).lt.ener) then
          dels=(sgtmp-sgtmpo)/(ener-enero+1.e-24)
          sgmn=min(sgtmp,sgtmpo)
          sgmx=max(sgtmp,sgtmpo)
          do while ((kl.lt.nphint).and.(epi(kl).lt.ener))
            kl=kl+1
            sgtp=max(sgmn,
     $                    min(sgmx,sgtmpo+dels*(epi(kl)-enero)))
            ansar1=sgtp
            bremtmp=bremsa(kl)/(12.56)
            tempro=tempr
            epiio=epii
            epii=epi(kl)
            tempr=(12.56)*sgtp*bremtmp/epii
            deld = epii - epiio
            sumr = sumr + (tempr+tempro)*deld/2.
            sumho=sumh
            sumh=sumh+(tempr*epii+tempro*epiio)*deld/2.
            exptst=(epii-eth)/bktm
            if (exptst.lt.200.) then
              exptmp=exp(-exptst)
              bbnurj=epii*epii*epii*(1.571e+22)*2.
              tempi1=rnist*bbnurj*exptmp*sgtp/epii
              tempi2=rnist*bremtmp*exptmp*sgtp/epii
c              tempi2=0.
              tempio=tempi
              Atmp2o=atmp2
              tempi=(tempi1+tempi2)*(ptmp1+ptmp2)
              atmp2=tempi*epii
              sumi = sumi + (tempi+tempio)*deld/2.
              sumc = sumc+(atmp2+atmp2o)*deld/2.
              rccemis(1,kl)=rccemis(1,kl)+abund2*atmp2*ptmp1*xpx*xnx
              rccemis(2,kl)=rccemis(2,kl)+abund2*atmp2*ptmp2*xpx*xnx
c              if (lpri.ge.1)
c     $          write (lun11,*)kl,epi(kl),sgtp,bbnurj,bremtmp,
c     $                              atmp2,tempr,tempi,sumi
              endif
            optmp=abund1*ansar1*xpx
            if (kl.le.(nb1+1)) opakab=optmp
            opakc(kl)=opakc(kl)+optmp
            enddo
          endif
        if (lpri.ge.1) then
          write (lun11,901)jk,kl,ener,epi(kl),sgtmp,bremtmp,tempr,
     $                        sumr
 901      format(1x,2i6,7(1pe11.3))
c          write (lun11,*)sgtmpo,enero,dels
c          write (lun11,*) tempr,sumr,sumh,tst
          endif
        enddo
c
      pirt = pirt + sumr
      rrrt = rrrt + xnx*sumi
      piht = piht + sumh*ergsev
      rrcl = rrcl + xnx*sumc*ergsev

      if (lpri.ge.1) write (lun11,*)'in phint53:',eth,pirt,rrrt
     $         ,piht,rrcl
      lpri=lprisv
c
c
      return
      end
