Modifications to allow Cherenkov transport
[u/mrichter/AliRoot.git] / 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