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