C     ===================
      SUBROUTINE DO_ZUFOS
C     ===================

      IMPLICIT NONE

#include "partap.inc"
#include "zescommon.inc"
#include "zestmpcommon.inc"
#include "zdrecgb.inc"
#include "zisles.inc"
#include "zdskey.inc"
#include "caltru.inc"

      INTEGER Icell
      REAL    hE1, hPx1, hPy1, hPz1, vtx(3)

      REAL ETA(5000)
      REAL ZTHE,GAP,DIF2,PIPPO
      INTEGER I,NETA,J,IND2,IERR

      CALL MODIN('DO_ZUFOS', IErr)
      CALL SETVTX(VTX)
C ----------------------------------------------
C --- Do ZUFO reconstruction for EM electron ---
C ----------------------------------------------
*-->  Zero Hadronic Info
      hE1  = 0.
      hPx1 = 0.
      hPy1 = 0.
      hPz1 = 0.

C --------------------------------
C --- Fill zRec02 COMMON block ---
C --------------------------------
      If (ZESTMP_Ncand_em.GT.0) Then
       eNdis  = ZESTMP_Ncell_em
       ePrdis = ZES_Prob_em
       eEdis  = ZES_Eeu_em
       eXdis  = ZES_Xeu_em
       eYdis  = ZES_Yeu_em
       eZdis  = ZES_Zeu_em
      Else
       eNdis = 0
      EndIf

*-->  get the hadronic flow information.....................
      zCells  = CouTab(CalTru)
      If (zCells.GT.Nr_cMax) Then
       CALL FETTAB(ZDSKEY,ID,1)
       Write(6,*)'*==> ',ZDSKEY_NR1, ZDSKEY_NR2,
     &           'Caltru has more than',Nr_cMax,
     &           ' cells:',zCells,' cell in this event'
       GOTO 300
      EndIf

      Icell = 0
      Do 110 I=1,zCells
       Call FetTab(Caltru,ID,I)
*
       Do J=1,MIN(eNdis,50)
        If (Caltru_Cellnr.EQ.ZESTMP_CellList_em(J)) GOTO 110
       EndDo
*
             Icell  = Icell + 1
       zPnrl(Icell) = Caltru_CellNr
       zEl(  Icell) = Caltru_e
       zImbl(Icell) = Caltru_imbal
       zID(  Icell) = Caltru_ID
*
 110  Continue
      zCells = Icell


C      If    (do_the_CTD_or_CAL_thing) Then
       call z_RecGB( 1,1,vtx,Ierr)
C      ElseIf(do_the_coneIsland_thing) Then
C       call z_RecGB(-3,1,vtx,Ierr)
C      EndIf

      If (Ierr.LT.0) Then
       Write(6,*)'*==> ZUFO: Whoops got an error ??',Ierr
      EndIf
*
      Do I=1,Nzufos
       hPx1 = hPx1 + zufo(1,I)
       hPy1 = hPy1 + zufo(2,I)
       hPz1 = hPz1 + zufo(3,I)
       hE1  = hE1  + zufo(4,I)
      EndDo

 300  CONTINUE
      ZESTMP_ZUFOPX_em = hPx1
      ZESTMP_ZUFOPY_em = hPy1
      ZESTMP_ZUFOPZ_em = hPz1
      ZESTMP_ZUFOEN_em = hE1



C ------------------------------------------------------
C --- Do ZUFO reconstruction for SINISTRA95 electron ---
C ------------------------------------------------------

*-->  Zero Hadronic Info
      hE1  = 0.
      hPx1 = 0.
      hPy1 = 0.
      hPz1 = 0.

C --------------------------------
C --- Fill zRec02 COMMON block ---
C --------------------------------
      If (ZESTMP_Ncand_si.GT.0) Then
       eNdis  = ZESTMP_Ncell_si
       ePrdis = ZES_Prob_si
       eEdis  = ZES_Eeu_si
       eXdis  = ZES_Xeu_si
       eYdis  = ZES_Yeu_si
       eZdis  = ZES_Zeu_si
      Else
       eNdis = 0
      EndIf

*-->  get the hadronic flow information.....................
      zCells  = CouTab(CalTru)
      If (zCells.GT.Nr_cMax) Then
       CALL FETTAB(ZDSKEY,ID,1)
       Write(6,*)'*==> ',ZDSKEY_NR1, ZDSKEY_NR2,
     &           'Caltru has more than',Nr_cMax,
     &           ' cells:',zCells,' cell in this event'
       GOTO 200
      EndIf

      Icell = 0
      Do 100 I=1,zCells
       Call FetTab(Caltru,ID,I)
*
       Do J=1,MIN(eNdis,50)
        If (Caltru_Cellnr.EQ.ZESTMP_CellList_si(J)) GOTO 100
       EndDo
*
             Icell  = Icell + 1
       zPnrl(Icell) = Caltru_CellNr
       zEl(  Icell) = Caltru_e
       zImbl(Icell) = Caltru_imbal
       zID(  Icell) = Caltru_ID
*
 100  Continue
      zCells = Icell


C      If    (do_the_CTD_or_CAL_thing) Then
       call z_RecGB( 1,1,vtx,Ierr)
C      ElseIf(do_the_coneIsland_thing) Then
C       call z_RecGB(-3,1,vtx,Ierr)
C      EndIf

      If (Ierr.LT.0) Then
       Write(6,*)'*==> ZUFO: Whoops got an error ??',Ierr
      EndIf
*
      Do I=1,Nzufos
C        add on for the diffractive group (Stefan Stonjek)
       ZTHE = ATAN2(SQRT(ZUFO(1,I)**2+ZUFO(2,I)**2),ZUFO(3,I))
       ETA(I)=-LOG(TAN(ZTHE/2))
C        end off add on
       hPx1 = hPx1 + zufo(1,I)
       hPy1 = hPy1 + zufo(2,I)
       hPz1 = hPz1 + zufo(3,I)
       hE1  = hE1  + zufo(4,I)
      EndDo

 200  CONTINUE
      ZES_V_H_px_zu = hPx1
      ZES_V_H_py_zu = hPy1
      ZES_V_H_pz_zu = hPz1
      ZES_V_H_E_zu = hE1

C code for the diffractive group (Stefan Stonjek)

C Here I order the eta array in order 
C i=1 (max) --> i - nzufo (min) pseudorap.

      NETA=NZUFOS

      Do  I = 1,NETA
         DO  J=I+1, NETA
            IF(ETA(J).GT.ETA(I)) THEN
               PIPPO=ETA(I)
               ETA(I)=ETA(J)
               ETA(J)=PIPPO
            ENDIF
         ENDDO
      ENDDO
c
c Compute the forward edge of the gap and put it in IND2
c

      GAP = ETA(1)-ETA(2)
      IND2 = 1
      DO I=2,NETA-1
         j=i+1
         DIF2=ETA(I)-ETA(j)
         IF(DIF2.GT.GAP) THEN
            GAP=DIF2
            IND2=I
         ENDIF
      ENDDO

* Fill the GAP block

      ZES_Fgap = ETA(IND2)
      IF (NETA.GT.1) ZES_Bgap = ETA(IND2+1)
      ZES_etamax_zu = ETA(1)

C end off diffractive group code


      CALL MODOUT('DO_ZUFOS')
      RETURN
      END