C. hw_tt_ll_dump.f
C. Compile: f77 -o hw_tt_ll_dump hw_tt_ll_dump.f herwig6500.o
C.    -L/cern/2003/lib
C.    -lpdflib -lmathlib -lpacklib -lnsl -lcrypt -ldl
C. 
C. MAXEV: number of event generator
C.       SYSPIN=.false.
C.       THREEB=.false.


      PROGRAM HWIGPR
C---COMMON BLOCKS ARE INCLUDED AS FILE HERWIG65.INC
      INCLUDE 'HERWIG65.INC'
      INTEGER N
      integer iii
      EXTERNAL HWUDAT
C---MAX NUMBER OF EVENTS THIS RUN
      MAXEV=1100000
C      MAXEV=1000
C---BEAM PARTICLES
      PART1='PBAR'
      PART2='P'
C---BEAM MOMENTA
      PBEAM1=980.
      PBEAM2=980.
C---PROCESS
      IPROC=1706
C---INITIALISE OTHER COMMON BLOCKS
      CALL HWIGIN
C---USER CAN RESET PARAMETERS AT
C   THIS POINT, OTHERWISE DEFAULT
C   VALUES IN HWIGIN WILL BE USED.
CCCC Top mass
      RMASS(6)=175.0

CCCCCCC  Spin correlation
      SYSPIN=.true.
      THREEB=.true.
C      SYSPIN=.false.
C      THREEB=.false.

      AUTPDF(1)='MRS'
      AUTPDF(2)='MRS'
      MODPDF(1)=41
      MODPDF(2)=41
C      AUTPDF(1)='CTEQ'
C      AUTPDF(2)='CTEQ'
C      MODPDF(1)=46
C      MODPDF(2)=46

C      PTMIN=100.
      PTMIN=0.
C---COMPUTE PARAMETER-DEPENDENT CONSTANTS
      CALL HWUINC
C---CALL HWUSTA TO MAKE ANY PARTICLE STABLE
C      CALL HWUSTA('PI0     ')
C---USER'S INITIAL CALCULATIONS
      CALL HWABEG
C---INITIALISE ELEMENTARY PROCESS
      CALL HWEINI
C---LOOP OVER EVENTS

C. force
      do iii=1,10
         BRFRAC(iii)=0.0
      enddo
      BRFRAC(3)=1.0
      BRFRAC(8)=1.0


      DO 100 N=1,MAXEV

C---INITIALISE EVENT
         CALL HWUINE
C---GENERATE HARD SUBPROCESS
         CALL HWEPRO
C---GENERATE PARTON CASCADES
         CALL HWBGEN
C---DO HEAVY OBJECT DECAYS
CCCCCCC  force W->e nu
         CALL HWDHOB
C---DO CLUSTER FORMATION
         CALL HWCFOR
C---DO CLUSTER DECAYS
         CALL HWCDEC
C---DO UNSTABLE PARTICLE DECAYS
         CALL HWDHAD
C---DO HEAVY FLAVOUR HADRON DECAYS
         CALL HWDHVY
C---ADD SOFT UNDERLYING EVENT IF NEEDED
         CALL HWMEVT
C---FINISH EVENT
         CALL HWUFNE
C---USER'S EVENT ANALYSIS
         CALL HWANAL
 100  CONTINUE
C---TERMINATE ELEMENTARY PROCESS
      CALL HWEFIN
C---USER'S TERMINAL CALCULATIONS
      CALL HWAEND
      STOP
      END
C----------------------------------------------------------------------
      SUBROUTINE HWABEG
C     USER'S ROUTINE FOR INITIALIZATION
C----------------------------------------------------------------------
      END
C----------------------------------------------------------------------
      SUBROUTINE HWAEND
C     USER'S ROUTINE FOR TERMINAL CALCULATIONS, HISTOGRAM OUTPUT, ETC
C----------------------------------------------------------------------
      END
C----------------------------------------------------------------------
      SUBROUTINE HWANAL
C     USER'S ROUTINE TO ANALYSE DATA FROM EVENT
      INCLUDE 'HERWIG65.INC'

      INTEGER I, J, jj
* t(1)->W+(dbar u) b      tbar(2)->W-(l- nubar) bbar
      real t1l(4), w1l(4), b1l(4), d1l(4), u1l(4)
      real t2l(4), w2l(4), b2l(4), d2l(4), u2l(4)
      logical lt1, lw1, lb1, ld1, lu1
      logical lt2, lw2, lb2, ld2, lu2, topl
      logical gg

*      print *, NEVHEP, NHEP
* 112  FORMAT( I8, 5I5, 9E14.6 )
*      DO I=1,NHEP
*         write(6,112) IDHEP(I), ISTHEP(I),
*     &        JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
*     &        (PHEP(J,I),J=1,5)
*      ENDDO

C  bool  gg->tt
      gg=(IDHEP(4) .eq. 21 .and. IDHEP(5) .eq. 21 )

C.. ------------------------------------------------------------
C init prior to loop in an event
      lt1=.false.
      lw1=.false.
      lb1=.false.
      ld1=.false.
      lu1=.false.
      lt2=.false.
      lw2=.false.
      lb2=.false.
      ld2=.false.
      lu2=.false.
         
C  Loop in an event
      do j=1,NHEP
* t (IDPDG, IST, MOTHER's IDPDG)=(6, 3, -)
         if (IDHEP(j).eq.6 .and. ISTHEP(j).eq.3 ) then
            do jj=1,4
               t1l(jj)=PHEP(jj, j)
            enddo
            lt1=.true.
         endif
* tbar (-6, 3, -)
         if (IDHEP(j).eq.-6 .and. ISTHEP(j).eq.3) then
            do jj=1,4
               t2l(jj)=PHEP(jj, j)
            enddo
            lt2=.true.
         endif
* b from t (5, 124, 6)
         if (IDHEP(j).eq.5 .and. ISTHEP(j).eq.124 .and.
     $        IDHEP(JMOHEP(1,j)).eq.6 ) then
            do jj=1,4
               b1l(jj)=PHEP(jj, j)
            enddo
            lb1=.true.
         endif
* bbar from tbar (-5, 124, -6)
         if (IDHEP(j).eq.-5 .and. ISTHEP(j).eq.124 .and.
     $        IDHEP(JMOHEP(1,j)).eq.-6 ) then
            do jj=1,4
               b2l(jj)=PHEP(jj, j)
            enddo
            lb2=.true.
         endif
* W+ from t (24, 123, 6)
         if (IDHEP(j).eq.24 .and. ISTHEP(j).eq.123 .and.
     $        IDHEP(JMOHEP(1,j)).eq.6 ) then
            do jj=1,4
               w1l(jj)=PHEP(jj, j)
            enddo
            lw1=.true.
         endif
* W- from tbar (-24, 123, -6)
         if (IDHEP(j).eq.-24 .and. ISTHEP(j).eq.123 .and.
     $        IDHEP(JMOHEP(1,j)).eq.-6 ) then
            do jj=1,4
               w2l(jj)=PHEP(jj, j)
            enddo
            lw2=.true.
         endif
* up-type from W+  [nu_e(12)]
         if (IDHEP(j).eq.12 .and. ISTHEP(j).eq.123 .and.
     $        IDHEP(JMOHEP(1,j)).eq.24 ) then
            do jj=1,4
               u1l(jj)=PHEP(jj, j)
            enddo
            lu1=.true.
         endif
* up-type_bar from W- [nu_e_bar(-12)]
         if (IDHEP(j).eq.-12 .and. ISTHEP(j).eq.123 .and.
     $        IDHEP(JMOHEP(1,j)).eq.-24 ) then
            do jj=1,4
               u2l(jj)=PHEP(jj, j)
            enddo
            lu2=.true.
         endif
* down_bar from W+ [e+(-11)]
         if (IDHEP(j).eq.-11 .and. ISTHEP(j).eq.124 .and.
     $        IDHEP(JMOHEP(1,j)).eq.24 ) then
            do jj=1,4
               d1l(jj)=PHEP(jj, j)
            enddo
            ld1=.true.
         endif
* down from W- (e-) [e-(11)]
         if (IDHEP(j).eq.11 .and. ISTHEP(j).eq.124 .and.
     $        IDHEP(JMOHEP(1,j)).eq.-24 ) then
            do jj=1,4
               d2l(jj)=PHEP(jj, j)
            enddo
            ld2=.true.
         endif
      enddo

      topl=lt1 .and. lw1 .and. lb1 .and. ld1 .and. lu1 .and.
     $     lt2 .and. lw2 .and. lb2 .and. ld2 .and. lu2
      if (.not.topl) then
         print *, lt1, lw1, lb1, ld1, lu1, lt2, lw2, lb2, ld2, lu2
      endif
      if (.not.topl) goto 130

      call nttemp(t1l, gg)
      call nttemp(b1l, gg)
      call nttemp(w1l, gg)
      call nttemp(d1l, gg)
      call nttemp(u1l, gg)
      call nttemp(t2l, gg)
      call nttemp(b2l, gg)
      call nttemp(w2l, gg)
      call nttemp(d2l, gg)
      call nttemp(u2l, gg)
      if (gg) then
         print *, '@='
      else
         print *, '@-'
      endif

 130  continue
      END

C...  EOF

      subroutine nttemp(x, gg)
      real x(4)
      logical gg

      if (gg) then
         print *, '@=', x(1), x(2), x(3), x(4)
      else
         print *, '@-', x(1), x(2), x(3), x(4)
      endif

      end
      
C----------------------------------------------------------------------
C      END
C----------------------------------------------------------------------
