GEANT321/gtrak/gtreveroot.F

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