*   ========================
      SUBROUTINE QEDC(Iflag)
*   ========================
*     selection routine for elastic QED Compton events.
*
*     output: Iflag = 0 -> no QED Compton event
*                     1 -> good QEDC event
*
*     Author: Arnulf Quadt, 22.11.1997
*     ----------------------------------------------------------------
      Implicit NONE
*
#include "partap.inc"
#include "vctrhl.inc"
#include "zdskey.inc"
#include "zescommon.inc"
#include "zestmpcommon.inc"
*
      REAL    xv(3), psi, pi, Ehad, CalPos(3), ECal,SRTDC(20)
      REAL    SPOS(3),ESRTD, ECORR, Rdist
      INTEGER Iflag, I, IDCLU, Ierr, JBIT
      LOGICAL FIRST, box_ok
      DATA    FIRST /.TRUE./
*
      IF (FIRST) THEN
        pi = acos(-1.0)
        DO I=1,20
          SRTDC(I) = 0.0
        ENDDO
        FIRST = .FALSE.
      ENDIF

      Iflag = 0


C -----------------------------------------------
C --- DST bits 93 (SF QEDC) or 112 (EXO QEDC) ---
C -----------------------------------------------
      CALL FETTAB(ZDSKEY, ID, 1)
      IF (JBIT(ZDSKEY_tstam21,30).NE.1 .AND.
     &    JBIT(ZDSKEY_tstam22,17).NE.1) RETURN

C -----------------------
C --- 2 EM candidates ---
C -----------------------
      IF (ZESTMP_Ncand_si.NE.2)  RETURN

C -------------------------
C --- at most one track ---
C -------------------------
      IF (COUTAB(VCTRHL).GE.2)   RETURN

C --------------------------------------------
C --- central vertex or no tracking vertex ---
C --------------------------------------------
      CALL SETVTX(xv)
      IF (abs(XV(3))   .GT.50.0) RETURN

C -----------------
C --- good E-Pz ---
C -----------------
      IF (ZES_Eminpz.GT.60.0 .OR.
     &    ZES_Eminpz.LT.35.0) RETURN

C -----------------------------
C --- back to back in r-phi ---
C -----------------------------
      psi = pi-abs(ZES_phi_si-ZESTMP_2phi_si)
      IF (psi*180.0/pi .ge.5.0) RETURN

C -----------------------------------------------------------
C --- delta theta < 85 grad => DIS background suppression ---
C -----------------------------------------------------------
      IF (180.0/pi*(ZES_theta_si-ZES_2theta_si).GE.85.0) RETURN

C -----------------------------------
C --- only little hadronic energy ---
C -----------------------------------
      Ehad = ZES_Ecal - ZES_Eeu_si - ZES_2Eeu_si
      IF (Ehad.GE.2.0) RETURN

C ----------------------------------------
C --- minimum energy for both clusters ---
C ----------------------------------------
      IF (ZES_Eeu_si.LE.5.0 .OR. ZES_2Eeu_si.LE.5.0) RETURN

C ---------------
C --- box cut ---
C ---------------
      Do I=1,2
        box_ok = .FALSE.
        IF (I.EQ.1) THEN
          CALPOS(1)  = ZES_Xeu_si
          CALPOS(2)  = ZES_Yeu_si
          CALPOS(3)  = ZES_Zeu_si
          ECAL       = ZES_Eeu_si
        ELSE
          CALPOS(1)  = ZESTMP_2Xeu_si
          CALPOS(2)  = ZESTMP_2Yeu_si
          CALPOS(3)  = ZESTMP_2Zeu_si
          ECAL       = ZES_2Eeu_si
        ENDIF

        IF (CALPOS(3)     .GT.-140.0 .OR.
     &      abs(CALPOS(1)).GT.  20.0.OR.
     &      abs(CALPOS(2)).GT.  20.0) THEN
          box_ok = .TRUE.
        ELSE
          CALL SRTDELEC(XV,CALPOS,ECAL,SRTDC,
     1                  IDCLU,SPOS,ESRTD,ECORR,RDIST,Ierr)
          IF (abs(SPOS(1)).GT.13.0 .OR.
     &        abs(SPOS(2)).GT. 8.0) THEN
            box_ok = .TRUE.
          ENDIF
        ENDIF
        IF (.not.box_ok) RETURN
      ENDDO

      Iflag = 1
      WRITE(*,*) 'event : ',ZDSKEY_NR1, ZDSKEY_NR2,' is QEDC'

      RETURN
      END