This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gtrak / gltrac.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:21:41  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/04 13/12/94  15.36.22  by  S.Giani
11 *-- Author :
12       SUBROUTINE GLTRAC
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *    SUBR. GLTRAC                                                *
17 C.    *                                                                *
18 C.    *   Extracts next track from stack JSTAK and prepares commons    *
19 C.    *    /GCTRAK/, /GCKINE/ and /GCVOLU/                             *
20 C.    *                                                                *
21 C.    *   Called by : GTREVE                                           *
22 C.    *   Authors   : R.Brun, F.Bruyant                                *
23 C.    *                                                                *
24 C.    ******************************************************************
25 C.
26 #include "geant321/gcbank.inc"
27 #include "geant321/gckine.inc"
28 #include "geant321/gcnum.inc"
29 #include "geant321/gconsp.inc"
30 #include "geant321/gcphys.inc"
31 #include "geant321/gcstak.inc"
32 #include "geant321/gctmed.inc"
33 #include "geant321/gctrak.inc"
34 #include "geant321/gcvolu.inc"
35       DIMENSION RNDM(5)
36 #if !defined(CERNLIB_SINGLE)
37       DOUBLE PRECISION P2,GETOTD,GEKIND
38       DOUBLE PRECISION PXD,PYD,PZD,ONE,HNORM,DAMASS,PP
39 #endif
40       PARAMETER (ONE=1)
41 C.
42 C.    ------------------------------------------------------------------
43 *
44 * *** Extract next track from stack JSTAK
45 *
46       IF(ISTORD.EQ.1) THEN
47 *
48 * *** User ordering of tracks if requested
49          CALL GSTORD
50       ENDIF
51       ISTAK = IQ(JSTAK+1)
52       IQ(JSTAK+1) = ISTAK -1
53       JST = JSTAK +NWSTAK*IQ(JSTAK+1) +3
54       ITRA   = IQ(JST+1)
55       IF (ITRA.LT.0) THEN
56          ITRA = -ITRA
57       ELSE
58 *
59 *        This is a new track. We set to zero the stack number and
60 *        update the vertex number
61          ISTAK = 0
62          JK=LQ(JKINE-ITRA)
63          IVERT=Q(JK+6)
64       ENDIF
65       IPART  = IQ(JST+2)
66       DO 60 I = 1,3
67          VERT(I) = Q(JST+3+I)
68         PVERT(I) = Q(JST+6+I)
69    60 CONTINUE
70       TOFG   = Q(JST+10)
71       SAFETY = Q(JST+11)
72       UPWGHT = Q(JST+12)
73 *
74 * *** Prepare tracking parameters
75 *
76       VECT(1) = VERT(1)
77       VECT(2) = VERT(2)
78       VECT(3) = VERT(3)
79       PXD = PVERT(1)
80       PYD = PVERT(2)
81       PZD = PVERT(3)
82       P2 = PXD**2+PYD**2+PZD**2
83       IF(P2.GT.0.) THEN
84          PP    = SQRT(P2)
85          HNORM = ONE/PP
86          VECT(4) = PVERT(1)*HNORM
87          VECT(5) = PVERT(2)*HNORM
88          VECT(6) = PVERT(3)*HNORM
89          VECT(7) = PP
90       ELSE
91          VECT(4) = 0.
92          VECT(5) = 0.
93          VECT(6) = 1.
94          VECT(7) = 0.
95       ENDIF
96 *
97 *  ** Reload Particle characteristics, if needed
98 *
99       IF (IPART.NE.IPAOLD) THEN
100          JPA = LQ(JPART-IPART)
101          DO 90 I = 1,5
102             NAPART(I) = IQ(JPA+I)
103    90    CONTINUE
104          ITRTYP = Q(JPA+6)
105          AMASS  = Q(JPA+7)
106          CHARGE = Q(JPA+8)
107          TLIFE  = Q(JPA+9)
108          IUPD   = 0
109          IPAOLD = IPART
110       ENDIF
111 *
112       DAMASS = AMASS
113       GETOTD = SQRT(P2+DAMASS**2)
114       GEKIND = GETOTD - DAMASS
115       GETOT  = GETOTD
116       GEKIN  = GEKIND
117 *
118       IF (ITRTYP.EQ.7) THEN
119 *
120 * *** Cerenkov photon. Retrieve polarisation
121          JPO = LQ(JSTAK-1)+(ISTAK-1)*3
122          POLAR(1) = Q(JPO+1)
123          POLAR(2) = Q(JPO+2)
124          POLAR(3) = Q(JPO+3)
125       ELSE
126          CALL GEKBIN
127       ENDIF
128 *
129       SLENG  = 0.
130       NSTEP  = 0
131       NTMSTO = NTMSTO +1
132       NTMULT = NTMSTO
133       ISTORY = 0
134 *
135 *  ** Initialize interaction probabilities
136 *
137       IF (ITRTYP.EQ.1) THEN
138 *      Gammas
139          CALL GRNDM(RNDM,5)
140          ZINTPA = -LOG(RNDM(1))
141          ZINTCO = -LOG(RNDM(2))
142          ZINTPH = -LOG(RNDM(3))
143          ZINTPF = -LOG(RNDM(4))
144          ZINTRA = -LOG(RNDM(5))
145       ELSE IF (ITRTYP.EQ.2) THEN
146 *       Electrons
147          CALL GRNDM(RNDM,3)
148          ZINTBR = -LOG(RNDM(1))
149          ZINTDR = -LOG(RNDM(2))
150          ZINTAN = -LOG(RNDM(3))
151       ELSE IF (ITRTYP.EQ.3) THEN
152 *       Neutral hadrons
153          CALL GRNDM(RNDM,2)
154          SUMLIF = -CLIGHT*TLIFE*LOG(RNDM(1))
155          ZINTHA = -LOG(RNDM(2))
156       ELSE IF (ITRTYP.EQ.4) THEN
157 *       Charged hadrons
158          CALL GRNDM(RNDM,3)
159          SUMLIF = -CLIGHT*TLIFE*LOG(RNDM(1))
160          ZINTHA = -LOG(RNDM(2))
161          ZINTDR = -LOG(RNDM(3))
162       ELSE IF (ITRTYP.EQ.5) THEN
163 *       Muons
164          CALL GRNDM(RNDM,5)
165          SUMLIF = -CLIGHT*TLIFE*LOG(RNDM(1))
166          ZINTBR = -LOG(RNDM(2))
167          ZINTPA = -LOG(RNDM(3))
168          ZINTDR = -LOG(RNDM(4))
169          ZINTMU = -LOG(RNDM(5))
170       ELSE IF (ITRTYP.EQ.7) THEN
171 *       Cerenkov photons
172          CALL GRNDM(RNDM,1)
173          ZINTLA = -LOG(RNDM(1))
174       ELSE IF (ITRTYP.EQ.8) THEN
175 *       Ions
176          CALL GRNDM(RNDM,2)
177          ZINTHA = -LOG(RNDM(1))
178          ZINTDR = -LOG(RNDM(2))
179       ENDIF
180 *
181 *   * Prepare common /GCVOLU/ and structure JGPAR, if needed
182 *
183       IF (NJTMAX.LE.0) THEN
184         IF (GONLY(NLEVEL).EQ.0.) NLEVEL=0
185         CALL GMEDIA (VECT, NUMED)
186       ENDIF
187       INFROM = 0
188 *                                                             END GLTRAC
189       END
190