GEANT321/gtrak/gtreveroot.F

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