      SUBROUTINE GUKINE
C
C   $Id: gukine.F,v 1.17 2001/04/10 04:22:41 molchan Exp $
C   $Author: molchan $
C
C        Original Author:  Erik Ramberg,  April 1998
C
C  Generates Kinematics for primary track
C

      Implicit none

C Geant include files.  They are not implicit none save.
#include "gtflag.inc"
#include "gcflag.inc"
#include "gconsp.inc"
#include "gtscan.inc"
#include "gcscan.inc"
#include "gtkine.inc"
#include "gckine.inc"

c local include files

#include "ckm_units.inc"
#include "ckm_para.inc"
#include "ckm_files.inc"
#include "spj.inc"

c local variables
      Logical ifirst
      Character*132 fname
      Integer NVERT,NT,IP,i,j,blklen,NUBUF,nin
      Real UBUF(10),ran

      data ifirst/.true./

      save ifirst


C
C  Initialize event variables
C

C
C     Put initial kinematics depending on /GCKINE/ variables
C     IKINE   PKINE(10)
C
C        -1   pnum  vx vy vz px py pz  
C             - start particle # pnum from point (vx,vy,vz)
C               with momentum (px,py,pz). Good for debuging purposes
C        -2   pnum  vx vy vz px py pz  smear_tx smear_ty
C             - start particle # pnum from point (vx,vy,vz)
C               with momentum (px,py,pz), and smear angles in x and y.
C               Good for debuging purposes
C               
C
C         0   used  
C             - read general file with option for multiple input tracks
C
C         1   pnum
C             - read beam kinematics from a file and assumes particle # pnum
C
C         2   pnum
C             - generate somehow beam kinematics and assumes particle # pnum
C
C

      LOGICAL       do_return
*
*---  Executable code  -------------------------------------------------
*
c     Never, never insert executable code before next line. VVM.
      CALL SPJ__GUKINE(SPJ_BEG, do_return)
      IF (do_return) RETURN


C      Call package initialization routines

      Call ums_gukine
      Call krch_gukine
      Call prch_gukine
      Call keat_gukine
c      Call bivs_gukine
c      Call vvs_gukine
      Call straw_gukine
      Call fvs_gukine
      Call mvs_gukine
      
      Call UUKINE

      CALL GRNDMQ(ckm_nrndm(1),ckm_nrndm(2),0,'G') ! get random number seed


C  read event according to flag ikine

      NUBUF = 2
      UBUF(1) = 0.  ! this particle is original
      UBUF(2) = 0.  ! start time-of-flight (by definition)

      IF (IKINE .EQ. 0) THEN

        if (ifirst) then        
          Write(*,*) 'Opening file ',beamfile(1:blklen(beamfile))
#ifdef LINUX
          Open(UKPI2,file=beamfile,status='old')
#else
          Open(UKPI2,file=beamfile,status='old',Readonly)
#endif
          ifirst=.false.
        endif

        read(UKPI2,*,end=200) nin

        do i=1,nin
          read(UKPI2,*,end=200) ip,(pkine(j),j=2,7)
          CALL GSVERT(PKINE(2),0,0,0,0,NVERT)
          CALL GSKINE(PKINE(5),ip,nvert,UBUF,NUBUF,nt)
        end do
        return

 200    continue
        close(UKPI2)
        ifirst=.true.
        return

      ELSEIF (IKINE .EQ. -1) THEN
        IP = PKINE(1)
        CALL GSVERT(PKINE(2),0,0,0,0,NVERT)
        CALL GSKINE(PKINE(5),IP,NVERT,UBUF,NUBUF,NT)
      ELSEIF (IKINE .EQ. -2) THEN
        IP = PKINE(1)
        CALL GSVERT(PKINE(2),0,0,0,0,NVERT)
        If (pkine(8).gt.0.) Then
          Call GRNDM(RAN,1)
          pkine(5) = pkine(8)*(ran-0.5)*pkine(7)
        EndIf
        If (pkine(9).gt.0.) Then
          Call GRNDM(RAN,1)
          pkine(6) = pkine(9)*(ran-0.5)*pkine(7)
        EndIf
        pkine(7) = sqrt(pkine(7)**2-pkine(5)**2-pkine(6)**2) ! pz
        CALL GSKINE(PKINE(5),IP,NVERT,UBUF,NUBUF,NT)
      ELSEIF (IKINE .EQ.  1) THEN
c         WRITE(*,*) 'IKINE=1 CALL READ_BM'
        CALL READ_BM(PKINE(2))
        IF (PKINE(1).NE.0)THEN
          IP = PKINE(1)
        ELSE
          IP = PKINE(2)
        END IF
        CALL GSVERT(PKINE(3),0,0,0,0,NVERT)
        CALL GSKINE(PKINE(6),IP,NVERT,UBUF,NUBUF,NT)
      ELSEIF (IKINE .EQ.  2) THEN
c         WRITE(*,*) 'IKINE=2'
        IP = PKINE(1)
        CALL GENE_BM(PKINE(2))
        CALL GSVERT(PKINE(2),0,0,0,0,NVERT)
        CALL GSKINE(PKINE(5),IP,NVERT,UBUF,NUBUF,NT)
      ELSE
         GOTO 10                  ! Print sorry message
      ENDIF


      RETURN

 10   CONTINUE
      PRINT *,'GUKINE: Sorry, this mode is not implemented yet'
 
      RETURN

      END

C
C   $Log: gukine.F,v $
C   Revision 1.17  2001/04/10 04:22:41  molchan
C   Preparation for SPJ introduction.
C
C   Revision 1.16  2001/02/18 16:49:52  ramberg
C   Make KINE 0 option more general, with possibility for multiple tracks in
C    the same event
C
C   Revision 1.15  2001/01/29 21:27:07  caroline
C        call bivs_gukine
C
C   Revision 1.14  2001/01/05 02:09:29  jurgen
C   introduce and handle ikine=-2 (angle smear)
C
C   Revision 1.13  2001/01/04 08:25:34  ramberg
C   Added call to keat_gukine
C
C   Revision 1.12  2000/12/06 01:01:34  jurgen
C   change dealing of particle type for ikine=1
C
C   Revision 1.11  2000/11/03 10:34:53  ramberg
C   add calls to ums_gukine,fvs_gukine and mvs_gukine
C
C   Revision 1.10  2000/09/05 23:38:58  jurgen
C   add writing of random number seed at begin of event
C
C   Revision 1.9  2000/08/17 01:06:29  ckm
C   add LINUX compatability.
C
C   Revision 1.8  2000/08/02 17:27:09  ckm
C   add reading old k2pi file for Caroline
C   use new units file
C   call packages begin-of-event routines
C   add user buffer to new tracks
C
C   Revision 1.7  2000/02/09 01:39:13  ckm
C   Implementing reading in file with beam data (first version)
C
C   Revision 1.6  1999/11/27 01:06:01  jurgen
C   avoid compiler warning
C
c Revision 1.5  1999/10/28  00:05:19  jurgen
c Substantial changes by Dima Vavilov
c
c Revision 1.4  1998/05/20  18:46:16  jurgen
c declare local variables
c
c Revision 1.3  1998/05/20  18:39:33  jurgen
c also include gt...
c
c Revision 1.1  1998/05/13  22:56:42  jurgen
c First time to cvs
c
C
