C     =================
      SUBROUTINE CALFIL
C     =================
C
C     A.Quadt, November  1997.
C     R.Walker November  1998 : added pt excluding 1 inner ring.
C     ----------------------------------------------------------

      IMPLICIT NONE

#include "partap.inc"
#include "caltru.inc"
#include "ctime2.inc"
C
#include "zescommon.inc"
C
      INTEGER     I, Ierr, vector(5)
      INTEGER     MOD,TOW,CELL,CAL
      REAL        XV(3), px, py, CPX, CPY, CPZ, CET, RAD
      REAL        XV0(3),px0,py0,CPX0,CPY0,CPZ0,CET0,RAD0
      REAL        pxexIR,pyexIR
      CHARACTER   KIND*5

      ZES_Ecal   = 0.0
      ZES_Et     = 0.0
      ZES_Pt     = 0.0
      ZES_PtexIR = 0.0
      ZES_Phi    = 0.0
      ZES_Eminpz = 0.0
      ZES_E_EMC  = 0.0
      ZES_Et0    = 0.0
      ZES_Pt0    = 0.0
      ZES_Eminpz0= 0.0

      ZES_FEmc   = 0.0
      ZES_FHac   = 0.0
      ZES_BEmc   = 0.0
      ZES_BHac   = 0.0
      ZES_REmc   = 0.0
      ZES_RHac   = 0.0


      ZES_tf = -999.99 
      ZES_tb = -999.99 
      ZES_tr = -999.99 
      ZES_tg = -999.99 

      px = 0.0
      py = 0.0
      pxexIR = 0.0
      pyexIR = 0.0
      px0 = 0.0
      py0 = 0.0

C ------------------------------
C --- set vertex; tmp values ---
C ------------------------------
      CALL SETVTX(XV)
C ------------------------------
C --- Set nominal vertex -------
C ------------------------------
      DO I=1,3
	XV0(I) = 0.0
      EndDo

C --------------------
C --- CAL TIMING ---
C --------------------

      If (coutab(ctime2).gt.0) Then
          CALL FETTAB( ctime2, ID, 1)
          ZES_tf = CTime2_avtime(1)
          ZES_tb = CTime2_avtime(2)
          ZES_tr = CTime2_avtime(3)
          ZES_tg = CTime2_avtime(4)
      End If

C --------------------
C --- CAL ENERGIES ---
C --------------------
      DO I=1,COUTAB(CALTRU)

        CALL FETTAB(CALTRU, ID, I)

        ZES_Ecal = ZES_Ecal + CALTRU_E

        CALL CCWHAT (CALTRU_CELLNR, KIND, VECTOR, IERR)

        IF (KIND(2:2).EQ.'E')
     &  ZES_E_EMC  = ZES_E_EMC + CALTRU_E


C -----   Get Emc/Hac energies in F/B/RCal
          
        If (kind(1:2).EQ.'RE') ZES_REmc = ZES_REmc+Caltru_E 
        If (kind(1:2).EQ.'BE') ZES_BEmc = ZES_BEmc+Caltru_E 
        If (kind(1:2).EQ.'FE') ZES_FEmc = ZES_FEmc+Caltru_E 
        If (kind(1:2).EQ.'RH') ZES_RHac = ZES_RHac+Caltru_E 
        If (kind(1:2).EQ.'BH') ZES_BHac = ZES_BHac+Caltru_E 
        If (kind(1:2).EQ.'FH') ZES_FHac = ZES_FHac+Caltru_E 


        CALL GPXYZ(CPX,CPY,CPZ,CET,RAD,XV)
        ZES_Et        = ZES_Et        + CET
        px            = px            + CPX
        py            = py            + CPY
        ZES_Eminpz    = ZES_Eminpz    + CALTRU_E - CPZ

C Nominal vertex quantities
        CALL GPXYZ(CPX0,CPY0,CPZ0,CET0,RAD0,XV0)
        ZES_Et0       = ZES_Et0       + CET0
        px0           = px0           + CPX0
        py0           = py0           + CPY0
        ZES_Eminpz0   = ZES_Eminpz0   + CALTRU_E - CPZ0

C Pt excluding IR
c Phantom routine (used by sinistra) to get module, tower, cell
c and CAL from the cellnr.
        CALL PosToMTC( CALTRU_CELLNR, Mod, Tow, Cell, CAL )
        IF ( (CAL.NE.1).OR.(Mod.LT.11).OR.
     &     (MOD.GT.13).OR.(Tow.LT.11).OR.
     &     (Tow.GT.13) ) THEN
     	  pxexIR = pxexIR + CPX
 	  pyexIR = pyexIR + CPY
        ENDIF
      ENDDO
      ZES_Pt  = sqrt(px*px + py*py)
      ZES_PtexIR = sqrt(pxexIR*pxexIR + pyexIR*pyexIR)
      ZES_phi = atan2(py,px)
C Nominal vertex quantities.
      ZES_Pt0  =sqrt(px0*px0 + py0*py0)

      RETURN
      END


C     ========================================
      SUBROUTINE GPXYZ(CPX,CPY,CPZ,CET,RAD,XV)
C     ========================================
C     Auxiliary routine for angle calculation.
C
C     A.Quadt, May 1997.
C     -----------------------------------------

      IMPLICIT NONE

#include "caltru.inc"
#include "partap.inc"

C
C -------> Caltru is Fettab'd
C
      INTEGER    IERR
      REAL       ZP,YP,CPX,CPY,CPZ,CET,RAD,XV(3),THETA,PHI,
     1           SINPHI,SINTH,COSTH,COSPHI,XP

      CALL CCCXYZ (CALTRU_CELLNR,XP,YP,ZP,IERR)
      CALL CCCAPO (XP-XV(1),YP-XV(2),ZP-XV(3),RAD,THETA,PHI)
      RAD    = SQRT((XP-XV(1))**2+(YP-XV(2))**2+(ZP-XV(3))**2)
      SINPHI = SIN(PHI)
      COSPHI = COS(PHI)
      SINTH  = SIN(THETA)
      COSTH  = COS(THETA)

      CPX    = CALTRU_E*SINTH*COSPHI
      CPY    = CALTRU_E*SINTH*SINPHI
      CPZ    = CALTRU_E*COSTH
      CET    = CALTRU_E*SINTH

      RETURN
      END