GEANT321/gtrak/gtreve_root.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1999/05/18 15:55:21  fca
   6 * AliRoot sources
   7 *
   8 * Revision 1.1.1.1  1995/10/24 10:21:45  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 *CMZ :  3.21/03 07/10/94  18.07.13  by  S.Giani
  14 *-- Author :
  15       SUBROUTINE GTREVE_ROOT
  16 C.
  17 C.    ******************************************************************
  18 C.    *                                                                *
  19 C.    *    SUBR. GTREVE                                                *
  20 C.    *                                                                *
  21 C.    *   Controls tracking of all particles belonging to the current  *
  22 C.    *    event.                                                      *
  23 C.    *                                                                *
  24 C.    *   Called by : GUTREV, called by GTRIG                          *
  25 C.    *   Authors   : R.Brun, F.Bruyant                                *
  26 C.    *                                                                *
  27 C.    ******************************************************************
  28 C.
  29 #include "geant321/gcbank.inc"
  30 #include "geant321/gcflag.inc"
  31 #include "geant321/gckine.inc"
  32 #include "geant321/gcnum.inc"
  33 #include "geant321/gcstak.inc"
  34 #include "geant321/gctmed.inc"
  35 #include "geant321/gctrak.inc"
  36 #include "geant321/gcunit.inc"
  37 #include "geant321/sckine.inc"
  38       REAL UBUF(2)
  39       EQUIVALENCE (UBUF(1),WS(1))
  40       LOGICAL   BTEST
  41       DIMENSION PMOM(3),VPOS(3)
  42 C.
  43 C.    ------------------------------------------------------------------
  44       NTMSTO = 0
  45       NSTMAX = 0
  46       NALIVE = 0
  47 *         Kick start the creation of the vertex
  48       VPOS(1)=0
  49       VPOS(2)=0
  50       VPOS(3)=0
  51       PMOM(1)=0
  52       PMOM(2)=0
  53       PMOM(3)=0
  54       IPART=1
  55       CALL GSVERT(VPOS,0,0,UBUF,0,NVTX)
  56       CALL GSKINE(PMOM,IPART,NVTX,UBUF,0,NT)
  57 *
  58       MTRACK=-999
  59  10   MTROLD=MTRACK
  60       CALL RXGTRAK(MTRACK,IPART,PMOM,E,VPOS,TTOF)
  61       IF(MTROLD.LT.0) THEN
  62          MPRIMA=MTRACK
  63       ENDIF
  64       IF(MTRACK.LE.MPRIMA) THEN
  65          IF(ISWIT(4).GT.0.AND.MTRACK.GT.0) THEN
  66             IF(ISWIT(4).EQ.1.OR.MOD(MTRACK,ISWIT(4)).EQ.0) THEN
  67                WRITE(CHMAIL,10200) MTRACK
  68                CALL GMAIL(0,0)
  69             ENDIF
  70          ENDIF
  71          IF(MTROLD.GT.0) THEN
  72 C --- Output root hits tree only for each primary MTRACK
  73             CALL RXOUTH
  74          ENDIF
  75       ENDIF
  76       IF(MTRACK.LE.0) GOTO 999
  77 * Set the vertex
  78       JV=LQ(JVERTX-1)
  79       Q(JV + 1) = VPOS(1)
  80       Q(JV + 2) = VPOS(2)
  81       Q(JV + 3) = VPOS(3)
  82       Q(JV + 4) = TTOF
  83       Q(JV + 5) = 0
  84       Q(JV + 6) = 0
  85 * Set the track
  86       JK=LQ(JKINE-1)
  87       Q(JK + 1) = PMOM(1)
  88       Q(JK + 2) = PMOM(2)
  89       Q(JK + 3) = PMOM(3)
  90       Q(JK + 4) = E
  91       Q(JK + 5) = IPART
  92       Q(JK + 6) = 1
  93 * Now transport
  94 C      CALL GPVERT(0)
  95 C      CALL GPKINE(0)
  96 * Normal Gtreve_root code
  97       NV = NVERTX
  98       DO 40  IV = 1,NV
  99 * ***   For each vertex in turn ..
 100          JV = LQ(JVERTX-IV)
 101          NT = Q(JV+7)
 102          IF (NT.LE.0) GO TO 40
 103          TOFG   = Q(JV+4)
 104          SAFETY = 0.
 105          IF (NJTMAX.GT.0) THEN
 106             CALL GMEDIA (Q(JV+1), NUMED)
 107             IF (NUMED.EQ.0) THEN
 108                WRITE (CHMAIL, 10000) (Q(JV+I), I=1,3)
 109                CALL GMAIL (0, 0)
 110                GO TO 40
 111             ENDIF
 112             CALL GLSKLT
 113          ENDIF
 114 *  **   Loop over tracks attached to current vertex
 115          DO 20  IT = 1,NT
 116             JV   = LQ(JVERTX-IV)
 117             ITRA = Q(JV+7+IT)
 118             IF (BTEST(IQ(LQ(JKINE-ITRA)),0)) GO TO 20
 119             CALL GFKINE (ITRA, VERT, PVERT, IPART, IVERT, UBUF, NWBUF)
 120             IF (IVERT.NE.IV) THEN
 121                WRITE (CHMAIL, 10100) IV, IVERT
 122                CALL GMAIL (0, 0)
 123                GO TO 999
 124             ENDIF
 125 *   *      Store current track parameters in stack JSTAK
 126             CALL GSSTAK (2)
 127    20    CONTINUE
 128 *  **   Start tracking phase
 129    30    IF (NALIVE.NE.0) THEN
 130             NALIVE = NALIVE -1
 131 *   *      Pick-up next track in stack JSTAK, if any
 132 *   *         Initialize tracking parameters
 133             CALL GLTRAC
 134             IF (NUMED.EQ.0) GO TO 30
 135 *   *       Resume tracking
 136             CALL GUTRAK
 137             IF (IEOTRI.NE.0) GO TO 999
 138             GO TO 30
 139          ENDIF
 140 *
 141    40 CONTINUE
 142       GOTO 10
 143 *
 144 10000 FORMAT (' GTREVE_ROOT : Vertex outside setup, XYZ=',3G12.4)
 145 10100 FORMAT (' GTREVE_ROOT : Abnormal track/vertex connection',2I8)
 146 10200 FORMAT (' GTREVE_ROOT : Transporting primary track No ',I10)
 147 *                                                             END GTREVE_ROOT
 148   999 END
 149