C=======================================================================
C     CDF - Les Houches interface for User-based generator.
C
C     Date   12/16/02 
C     Author  Adam Gibson - for ZGRAD
C
C     user_upinit    Initialization for UPINIT.
C     user_upevnt    Event generation for UPEVNT.
C
C=======================================================================
      SUBROUTINE USER_UPINIT
C...All real arithmetic in double precision.
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)

C...Include HEP common parameter.
      INTEGER MAXPUP
      PARAMETER (MAXPUP=100)
      INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
      DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
      COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
     &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
     &LPRUP(MAXPUP)
      SAVE /HEPRUP/
      CHARACTER OPTF*100


CCC      WRITE(*,*) 'This is dummy routine for User-UPINIT.'

C...Set incoming beams: Tevatron Run II.
      IDBMUP(1) = 2212
      IDBMUP(2) = -2212
      EBMUP(1) = 980D0
      EBMUP(2) = 980D0

C...Set PDF's of incoming beams: CTEQ 5L.
C...Note that Pythia will not look at PDFGUP and PDFSUP.  
      PDFGUP(1) = 4
      PDFSUP(1) = 46
c for the moment, let's use the same as I've been using with ZGRAD
c (below)
c      PDFGUP(1) = 3
c      PDFSUP(1) = 37      
      PDFGUP(2) = PDFGUP(1)
      PDFSUP(2) = PDFSUP(1)

C...Decide on weighting strategy: unweighted on input.
c      IDWTUP = 3
c I guess we use -3 since we can have negative weights-  though we don't really
c want Pythia to do anything with them
      IDWTUP = -3

C...Number of external processes. 
      NPRUP = 1
      LPRUP(1) = 200
      XSECUP(1) = 1.0D0
      XMAXUP(1) = 1.0D0

C...Done.
      DO 1000, i = 1,20
      READ(51,'(a)') OPTF
      WRITE(*,*) OPTF
      IF (OPTF(2:3).EQ.'#') GOTO 1001

      IF (i.eq.20) THEN
         PRINT *, 'Giving up on reading file init info.'
         STOP
      END IF

 1000 CONTINUE
 1001 CONTINUE

      RETURN
      END


      SUBROUTINE USER_UPEVNT
C...All real arithmetic in double precision.
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)

C...Include HEP common parameter.
      INTEGER MAXNUP
      PARAMETER (MAXNUP=500) 
      INTEGER ZMAXNUP
      PARAMETER (ZMAXNUP=6)     
c Backwards compatibility with the old file format is retained.
c ZMAXNUP=5 will work with the old format, ZMAXNUP=6 with the new.

c As far as I can tell ZGRAD's Z for 2->3 events is always just the di-lepton.
      INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
      DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP  
      COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP),
     &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP),
     &VTIMUP(MAXNUP),SPINUP(MAXNUP)  
      SAVE /HEPEUP/ 
      CHARACTER XFMT*100
      REAL RAND
      INTEGER EVREAD, NUMREAD
      

CCC      WRITE(*,*) 'This is dummy routine for User-UPEVNT.'
c      PRINT *, 'Beginning of USER_UPEVNT'

           XFMT = '(##i3,##f11.4,##i4,##i3,##i3,##f11.4)'
            WRITE(XFMT(2:3),FMT='(i2)') 1
            WRITE(XFMT(7:8),FMT='(i2)') 4
            WRITE(XFMT(15:16),FMT='(i2)') ZMAXNUP
            WRITE(XFMT(20:21),FMT='(i2)') ZMAXNUP
            WRITE(XFMT(25:26),FMT='(i2)') 2*(ZMAXNUP-2)
            WRITE(XFMT(30:31),FMT='(i2)') 5*ZMAXNUP
c            PRINT *, 'Here is XFMT: ', XFMT
            EVREAD = 0
            NUMREAD = NUMREAD + 1
c            IF (NUMREAD.GE.33000) PRINT *, 'NUMREAD ', NUMREAD
c            PRINT *, 'NUMREAD ', NUMREAD

            READ(51,FMT=XFMT,END=500) 
     $           NUP,XWGTUP,
     $           SCALUP,
     $           AQEDUP,AQCDUP,
     $           (IDUP(I),I=1,2),
     $           (IDUP(I),I=3,4),
     $           (IDUP(I),I=5,ZMAXNUP),
     $           (ISTUP(I),I=1,ZMAXNUP),
     $           ((MOTHUP(I,J),I=1,2),J=3,
     $                                       ZMAXNUP),
     $           ((PUP(I,J),I=1,5),J=1,
     $                                       ZMAXNUP)

            EVREAD = 1
c let's do some printing, just to make sure things got filled correctly
c            PRINT *, 'NUP ', NUP, ' AQCDUP ', AQCDUP, ' PUP(1,4) ', 
c     *   PUP(1,4), ' PUP(2,5) ', PUP(2,5)

C...Flavour codes for entries.
      DO 1500, I=1,NUP
        ICOLUP(1,I) = 0
        ICOLUP(2,I) = 0
        SPINUP(I)=0D0
        VTIMUP(I)=0D0
 1500 CONTINUE

c can't hurt to zero these again

c and just in case these aren't initialized
      MOTHUP(1,1) = 0
      MOTHUP(2,1) = 0
      MOTHUP(1,2) = 0
      MOTHUP(2,2) = 0

c for the moment we'll just randomly assign quark flavors
c 
      call RANLUX(RAND,1)
c      PRINT *, 'The random number is ', RAND
c I suppose I should handle this seed better sometime.

      IF (IDUP(1).GE.0) THEN   ! quark from proton
       IF (RAND.LT.(0.2)) THEN
         IDUP(1) = 1
         IDUP(2) = -1
         ICOLUP(1,1) = 501
         ICOLUP(2,1) = 0
         ICOLUP(1,2) = 0
         ICOLUP(2,2) = 501
       ELSE
         IDUP(1) = 2
         IDUP(2) = -2
         ICOLUP(1,1) = 501
         ICOLUP(2,1) = 0
         ICOLUP(1,2) = 0
         ICOLUP(2,2) = 501
       END IF

      ELSE  ! ant-quark from proton
       IF (RAND.LT.(0.5)) THEN
         IDUP(1) = -1
         IDUP(2) = 1
         ICOLUP(1,1) = 0
         ICOLUP(2,1) = 501
         ICOLUP(1,2) = 501
         ICOLUP(2,2) = 0
       ELSE
         IDUP(1) = -2
         IDUP(2) = 2
         ICOLUP(1,1) = 0
         ICOLUP(2,1) = 501
         ICOLUP(1,2) = 501
         ICOLUP(2,2) = 0
       END IF         
      END IF ! end if (IDUP(1).GT.0)
C...Ensure proper normalization of weights for MODE=+-2
      IDPRUP = 200


 500  CONTINUE
      IF (EVREAD.EQ.0) PRINT *, 'ERROR: Unexpected End of File.'
 
      RETURN
      END