Modifications to allow Cherenkov transport
[u/mrichter/AliRoot.git] / GEANT321 / gtrak / gtreve_root.F
CommitLineData
9b79affb 1*
2* $Id$
3*
4* $Log$
ad265d61 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*
9b79affb 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
20C.
21C. ******************************************************************
22C. * *
23C. * SUBR. GTREVE *
24C. * *
25C. * Controls tracking of all particles belonging to the current *
26C. * event. *
27C. * *
28C. * Called by : GUTREV, called by GTRIG *
29C. * Authors : R.Brun, F.Bruyant *
30C. * *
31C. ******************************************************************
32C.
33#include "geant321/gcbank.inc"
34#include "geant321/gcflag.inc"
35#include "geant321/gckine.inc"
ad265d61 36#include "geant321/gcking.inc"
9b79affb 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
ad265d61 46 DIMENSION PMOM(3),VPOS(3),VPOLA(3)
9b79affb 47C.
48C. ------------------------------------------------------------------
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
ad265d61 65 CALL RXGTRAK(MTRACK,IPART,PMOM,E,VPOS,VPOLA,TTOF)
9b79affb 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
77C --- Output root hits tree only for each primary MTRACK
78 CALL RXOUTH
79 ENDIF
80 ENDIF
81 IF(MTRACK.LE.0) GOTO 999
ad265d61 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
9b79affb 97* Set the vertex
ad265d61 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
9b79affb 105* Set the track
ad265d61 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
9b79affb 116* Now transport
117C CALL GPVERT(0)
118C 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*
16710000 FORMAT (' GTREVE_ROOT : Vertex outside setup, XYZ=',3G12.4)
16810100 FORMAT (' GTREVE_ROOT : Abnormal track/vertex connection',2I8)
16910200 FORMAT (' GTREVE_ROOT : Transporting primary track No ',I10)
170* END GTREVE_ROOT
171 999 END
172