*
* $Id$
*
* $Log$
* Revision 1.1  2000/06/19 20:00:33  eugenio
* Initial revision
*
* Revision 1.1.1.1  1994/10/08  02:21:35  zfiles
* first version of qqlib in CVS
*
*
#include "sys/CLEO_machine.h"
#include "pilot.h"
*CMZ :  1.04/00 22/09/94  00.22.19  by  Paul Avery
*CMZ :  1.03/75 27/01/94  22.26.36  by  Peter C Kim
*CMZ :  1.03/20 12/08/91  10.45.50  by  R.A.FULTON
*-- Author :    R.A.FULTON   27/12/90
* 14/10/96 Lynn Garren: use VZERO for each element in QQVRT2 
*                       (don't assume common block is contiguous)
*                       Add double precision conditionals.
      SUBROUTINE GGGEVT
C
C. Author    : R.A.FULTON  27/12/90  02.07.32
#include "qqlib/gggseq/ggprms.inc"
#include "qqlib/gggseq/fragmt.inc"
#include "seq/clinc/qqpars.inc"
#include "seq/clinc/qqtrak.inc"
#include "seq/clinc/qqvrtx.inc"
#include "qqlib/seq/qqbrat.inc"
#include "seq/clinc/qqevnt.inc"
#include "seq/clinc/qqbmst.inc"
#include "qqlib/seq/qqluns.inc"
#include "seq/clinc/qqprop.inc"
#include "geant/gcdes/lujets.inc"
#include "geant/gcdes/ludat1.inc"
#include "qqlib/gggseq/ggmodl.inc"
C
      CHARACTER*(*) CRNAME
      PARAMETER(    CRNAME = 'GGGEVT' )
      INTEGER    I, IDUM, NC
#if defined(NONCLEO_DOUBLE)
      INTEGER    J
      double precision HZ1, HZ2
#else
      REAL       HZ1, HZ2
#endif
C
      INTEGER    ISEED
      COMMON/RANDM/ISEED
C
      REAL       RLU
      EXTERNAL   RLU
C
C       get random seed at start of event
CPCK        CALL RDMOUT( IRANQQ )
C                                    Commented out 1/27/94 PCK
C
C                         generate event
C       pick production vertex
#if defined(NONCLEO_DOUBLE)
	do I=1,MCVRTX
	    do J=1,3
	       XVTX(I,J) = 0.D0
	    enddo
	    TVTX(I) = 0.D0
	    RVTX(I) = 0.D0
	enddo
#else
        CALL VZERO(XVTX,MCVRTX*3)
        CALL VZERO(TVTX,MCVRTX)
        CALL VZERO(RVTX,MCVRTX)
#endif
        CALL VZERO(ITRKIN,MCVRTX)
        CALL VZERO(NTRKOU,MCVRTX)
        CALL VZERO(ITRKOU,MCVRTX)
        CALL VZERO(IVKODE,MCVRTX)
        DO 101 I=1,2
            XVTX(1,I) = (2.0*RLU(0) - 1.0)*BSIZQQ(I) + BPOSQQ(I)
            XVTX(2,I) = XVTX(1,I)
  101   CONTINUE
C
        RVTX(1)   = SQRT(XVTX(1,1)**2 + XVTX(1,2)**2)
        RVTX(2)   = RVTX(1)
        HZ1       = RLU(0) - 0.5
        HZ2       = RLU(0) - 0.5
        XVTX(1,3) = (HZ1 + HZ2)*BSIZQQ(3) + BPOSQQ(3)
        XVTX(2,3) = XVTX(1,3)
        CALL VZERO(IPRNTV,MCTRK)
        CALL VZERO(ITRKOU,MCVRTX)
        CALL VZERO(IVDECA,MCTRK)
C
C       Set Following Inorder Given:
C       # tracks
C       # vertices in event
C       track # into vertex
C       # tracks out of vertex
C       first track out of vertex
C       production vertex
C       # quarks
C       length of Sjostrand list
        NTRKQQ = 0
        NVRTX = 1
        ITRKIN(1) = 0
        NTRKOU(1) = 0
        ITRKOU(1) = 0
        IVKODE(1) = 1
        NC = 0
        N  = 0
C
C       first particle has no parent
        K(1,1) = 0
C
C       main control routine for 2-photon generator
         CALL GGGEN0
        IF(.NOT.ELEC2G)THEN
C
C        Flip z-component of LUND momentum vector for all particles.  This
C        is necessary because the generator assumes the positron beam
C        direction opposite what it is in the CLEO experiment.
         DO 102 I=1,N
 102     P(I,3) = -P(I,3)
C
C        Decay via LUND if asked for
         IF(DOFRAG)CALL LUEXEC
C
C        Strip of some extra info generated by LUND
         CALL LUEDIT(1314)
C
C        Call translation/decay routine LUND ===> QQTRAK
C        Finish decays at QQ level and fill QQTRAK
         CALL DECADL
      ENDIF
C
      RETURN
      END