GEANT321/gtrak/gtreve_root.F

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