C      ========================================================
       Subroutine IsoCones(P, R, NR, Vtx, CellListIn, nCell,
     &             EInList, ENotInList,RElec,EMCenrgy,HACenrgy)
C      ========================================================
C
c   Author: B. Straub
c   version 1. 30 Nov 93
C
C     Modified   Mar 96  G. Howell
C     Modified   May 96  N. Brummer
c
c inputs: P(1:3) Position vector of cluster in CAL (relative to nominal IP)
c         R(1:NR)  = Radius for each of NR Eta-Phi cones (deta**2+dphi**2)
c     The Radii must be in increasing order R(1)<R(2)<R(3)...
c         NR = Number of Cones
c         Vtx(1:3) = Vertex
c         CellListIn(1:nCell) = List of Cell Numbers for the Object
c
c outputs: EInList(1:NR) = Energy in each cone for cells in CellList
c          ENotInList(1:NR) = Energy in each cone for cells not in CellList
c          EHAC EEMC - energy in HAC and EMC cells in CellList
c          RElec  eta-phi 'radius' of electron cluster
c
      implicit none
c
#include "partap.inc"
#include "caltru.inc"
#include "zrevt.inc"
c
      integer nCell, i, j, k, NR, Locati
      integer CellListIn(nCell)
      INTEGER ncellmax
      PARAMETER (ncellmax=100)
      integer CellList(ncellmax)
c
      logical InList,error,lerr,haccell,emccell
      real Imbal, d, dEta, dPhi, Eta, EtaC, EInList(NR), ENotInList(NR),
     + Phi, PhiC, Pi,twopi, R(NR), Theta, Vtx(3), x(3),P(3),polarangle
     + ,CELLVECTOR(5),Pvtx(3),Hacenrgy,EMCenrgy
     + ,RElec
      CHARACTER*5 CELLKIND
      parameter (Pi=3.14159265359,twopi=2*pi)
c
c ---------
c
      Relec    = 0.
      HACenrgy = 0.
      EMCenrgy = 0.
      Do k=1,nr
       EInlist(k)    = 0.
       ENotInlist(k) = 0.
      ENDDO
c ---------
      if (ncell.gt.ncellmax) then
       write(6,*) 'ISOCONES ncell=',ncell,' Exceeds maximum=',ncellmax
       write(6,*) 'ISOCONES abandoned',zrevt_runnr,zrevt_evtnr(3)
       RETURN
      endif
c
c     direction of the electron:
c
      do k=1,3
         Pvtx(k)=P(k)-Vtx(k)
      enddo
      polarangle= ATan2(sqrt(Pvtx(1)**2+Pvtx(2)**2), Pvtx(3))
      Eta=-LOG(TAN(polarangle/2.))
      Phi=atan2(Pvtx(2),Pvtx(1))
c
c     Transfer cell-list to local array. Then sort it.
      do k=1,ncell
       CellList(k)=CellListIn(k)
      enddo
      call IntSor(CellList, nCell)
c
      do i = 1, CouTab(Caltru)
        call FetTab(Caltru, ID, i)
c
        call CccXYZ(Caltru_CellNr, x(1), x(2), x(3), lErr)
        if (lErr)  then
         Write(6,*) 'IsoCones: CccXYZ Error.'
         write(6,*) 'ISOCONES abandoned',zrevt_runnr,zrevt_evtnr(3)
         RETURN
        endif
c
        x(1) = x(1) - Vtx(1)
        x(2) = x(2) - Vtx(2)
        x(3) = x(3) - Vtx(3)

c       is the Cell part of the electron cluster?

        j=Locati(Celllist,Ncell,Caltru_CellNr)
        InList=(j.gt.0)
c
c       what kind of cell is this, if it is in the electron list?

        if (InList) then
           CALL CCWHAT(Caltru_CellNr,CellKind,Cellvector,Error)
           if (Error) then
            write(6,*) 'ISOCONES CCWHAT ERROR:',caltru_cellnr,cellkind
            write(6,*) 'ISOCONES abandoned',zrevt_runnr,zrevt_evtnr(3)
            RETURN
           endif
c
c          lump HAC0 energy with EMC energy,
c
           if(Cellkind(2:4).eq.'HAC'.and.Cellkind(2:5).ne.'HAC0')then
               HACenrgy=HACenrgy+CAltru_E
           else
              EMCenrgy=EMCenrgy+Caltru_E
           endif
c
           PhiC = atan2(x(2),x(1))
           dPhi = abs(Phi-PhiC)
           if (dPhi.gt.Pi) dPhi = dPhi-TwoPi
           Theta = ATan2(sqrt(x(1)**2+x(2)**2), x(3))
           EtaC = -log(Tan(Theta/2.))
           dEta = Eta - EtaC
           d = sqrt(dEta**2 + dPhi**2)
           if (d.gt.RElec) RElec = d
        else
c          signify that dPhi, dTheta, d must still be calculated
           d=-1.
        endif
c
c       use the convention: -180 < phi, dphi < 180
        if (d.lt.0.) then
           PhiC = atan2(x(2),x(1))
           dPhi = abs(Phi-PhiC)
           if (dPhi.gt.Pi) dPhi = dPhi-TwoPi
        endif
c
        if (abs(dPhi) .lt. R(NR)) then
          if (d.lt.0.) then
             Theta = ATan2(sqrt(x(1)**2+x(2)**2), x(3))
             EtaC = -log(Tan(Theta/2.))
             dEta = Eta - EtaC
             d = sqrt(dEta**2 + dPhi**2)
          endif

c         Is this Cell inside the largest cone?

          if (d.lt.R(NR)) then
c
c           loop over cone sizes from large to small
c           and sum up the energy in/outside the electron, within each cone
c
            k = NR
            do while (k.ge.1 .and. d.lt.R(k))
               if (InList) then
c                This Cell is in the electron cluster
                 EInList(k) = EInList(k) + Caltru_E
               else
c                This Cell is in the cone, not in the electron cluster
                 ENotInList(k) = ENotInList(k) + Caltru_E
               end if
               k = k - 1
            End Do

          end if
        end if
      end do
      end