Some function moved to AliZDC
[u/mrichter/AliRoot.git] / GEANT321 / erdecks / ertrak.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1996/03/06 15:37:34 mclareni
6* Add geane321 source directories
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.49 by S.Giani
11*-- Author :
12 SUBROUTINE ERTRAK (X1, P1, X2, P2, IPA, CHOPT)
13*
14************************************************************************
15* *
16* Perform the tracking of the track from point X1 to *
17* point X2 *
18* (Before calling this routine the user should also provide *
19* the input informations in /EROPTS/ and /ERTRIO/ *
20* using subroutine EUFIL(L/P/V) *
21* X1 - Starting coordinates (Cartesian) *
22* P1 - Starting 3-momentum (Cartesian) *
23* X2 - Final coordinates (Cartesian) *
24* P2 - Final 3-momentum (Cartesian) *
25* IPA - Particle code (a la GEANT) of the track *
26* *
27* CHOPT *
28* 'B' 'Backward tracking' - i.e. energy loss *
29* added to the current energy *
30* 'E' 'Exact' calculation of errors assuming *
31* helix (i.e. pathlength not *
32* assumed as infinitesimal) *
33* 'L' Tracking upto prescribed Lengths reached *
34* 'M' 'Mixed' prediction (not yet coded) *
35* 'O' Tracking 'Only' without calculating errors *
36* 'P' Tracking upto prescribed Planes reached *
37* 'V' Tracking upto prescribed Volumes reached *
38* 'X' Tracking upto prescribed Point approached *
39* *
40* Interface with GEANT : *
41* Track parameters are in /CGKINE/ and /GCTRAK/ *
42* *
43* ==>Called by : USER *
44* Authors M.Maire, E.Nagy ********* *
45* *
46************************************************************************
47*
48#include "geant321/gcbank.inc"
49#include "geant321/gcnum.inc"
50#include "geant321/gckine.inc"
51#include "geant321/gctmed.inc"
52#include "geant321/gctrak.inc"
53#include "geant321/gcunit.inc"
54#include "geant321/ertrio.inc"
55#include "geant321/erwork.inc"
56#include "geant321/trcom3.inc"
57*
58 DIMENSION P1(3), P2(3), X1(3), X2(3), DUM(15), IOPT(30)
59 EQUIVALENCE (IOPT(1),IOPTB), (IOPT(2),IOPTE), (IOPT(3),IOPTL),
60 , (IOPT(4),IOPTM), (IOPT(5),IOPTO), (IOPT(6),IOPTP),
61 , (IOPT(7),IOPTV), (IOPT(8),IOPTX)
62 CHARACTER CHOPT*(*)
63*
64*
65* *** Decode character option
66*
67 CHOPTI = CHOPT
68 CALL UOPTC (CHOPT, 'BELMOPVX', IOPT)
69*
70 IF (IOPTB.EQ.0) THEN
71 BACKTR = 1.
72 ELSE
73 BACKTR = -1.
74 ENDIF
75*
76 LEEXAC = IOPTE.NE.0
77 LELENG = IOPTL.NE.0
78 LEONLY = IOPTO.NE.0
79 LEPLAN = IOPTP.NE.0
80 LEVOLU = IOPTV.NE.0
81 LEPOIN = IOPTX.NE.0
82*
83* *** Check consistency of the Ch-options
84*
85 IF ((LELENG .AND. LEVOLU) .OR. (LELENG .AND. LEPLAN) .OR.
86 + (LEVOLU .AND. LEPLAN)) THEN
87 WRITE (LOUT, 779)
88 GO TO 99
89 ENDIF
90*
91* *** Initialization
92*
93 IF (NEPRED.LE.0) THEN
94 WRITE (LOUT, 780)
95 GO TO 99
96 ENDIF
97 ILPRED = 0
98 TLGCM2 = 0.
99 TLRAD = 0.
100 CALL VZERO (IEPRED , MXPRED)
101 CALL VZERO (ERXOUT , 3*MXPRED)
102 CALL VZERO (ERPOUT , 3*MXPRED)
103 CALL VZERO (ERROUT ,15*MXPRED)
104*
105 DO 10 I = 1, 3
106 ERXIN(I) = X1(I)
107 10 CONTINUE
108*
109 PMOM2 = P1(1)**2 + P1(2)**2 + P1(3)**2
110 IF(PMOM2.LE.1.E-20) THEN
111 WRITE (LOUT, 778)
112 GO TO 99
113 ENDIF
114 PABS = SQRT (PMOM2)
115 ERPIN(1) = 1./PABS
116 ERPIN(2) = ASIN (P1(3)*ERPIN(1))
117 IF (ABS (P1(1)) .LT. 1.E-30) P1(1) = 1.E-30
118 ERPIN(3) = ATAN2 (P1(2), P1(1))
119*
120* *** Initialize GCKINE common
121*
122 IF((IPA.LE.0).OR.(IPA.GT.NPART)) THEN
123 WRITE (LOUT, 777) IPA
124 GO TO 99
125 ENDIF
126*
127 ITRA = 1
128 ISTAK = 0
129 IPART = IPA
130 JPA = LQ(JPART-IPART)
131 DO 26 I=1,5
132 NAPART(I) = IQ(JPA+I)
133 26 CONTINUE
134 ITRTYP = Q(JPA+6)
135 AMASS = Q(JPA+7)
136 CHARGE = Q(JPA+8)
137 CHTR = CHARGE*BACKTR
138 TLIFE = Q(JPA+9)
139*
140* *** Starting field
141*
142 CALL VZERO (HI, 9)
143 CALL VZERO (HF, 9)
144*
145* *** Error matrix into SC System
146*
147 IF (LEPLAN) THEN
148 IF (IFIELD.EQ.3) THEN
149 HI(3) = FIELDM
150 ELSEIF (IFIELD.NE.0) THEN
151 CALL GUFLD (X1, HI)
152 ENDIF
153 CALL VZERO (DUM,15)
154 CALL TRSCSD (ERPIN(1), DUM(1), ERPIN(1), DUM(1), HI(1),
155 + CHARGE, IERR, SPU, ERPLI(1,1), ERPLI(1,2))
156 IF (LEONLY) GOTO 35
157 CALL TRSDSC (ERPIN(1), ERRIN(1), DUM(1), ERRIN(1), HI(1),
158 + CHARGE, IERR, SPU, ERPLI(1,1), ERPLI(1,2))
159 DO 29 I = 1, 5
160 DO 28 J = 1, 5
161 ASDSC(I,J) = A(I,J)
162 28 CONTINUE
163 29 CONTINUE
164 ENDIF
165 IF (LEONLY) GOTO 35
166*
167* *** Error matrix into direction of tracking
168*
169 IF (BACKTR .LT. 0.) CALL ERBCER (ERRIN(1))
170*
171* *** Error matrix into double precision
172*
173 DO 30 I = 1,15
174 EI(I) = ERRIN(I)
175 30 CONTINUE
176*
177 35 CONTINUE
178 DO 41 I = 1, 3
179 VERT(I) = X1(I)
180 PVERT(I) = P1(I)*BACKTR
181 41 CONTINUE
182*
183* *** Initialize GCTRAK common
184*
185 PVERT(4) = SQRT (PMOM2 + AMASS**2)
186 VECT(7) = PABS
187 DO 51 I=1,3
188 VECT(I) = VERT(I)
189 VECT(I+3) = PVERT(I)/VECT(7)
190 51 CONTINUE
191 GETOT = PVERT(4)
192 GEKIN = GETOT - AMASS
193 IF(GEKIN.LT.0.) GEKIN = 0.
194 CALL GEKBIN
195*
196* *** Additional EMC initialization
197*
198 IF (.NOT.LEONLY) CALL ERPINI
199*
200* *** Ready for tracking
201*
202 CALL ERTRGO
203*
204* *** Copy the final point and momentum into the output buffer
205*
206 DO 60 I = 1, 3
207 X2(I) = VECT(I)
208 P2(I) = VECT(7)*BACKTR*VECT(I+3)
209 60 CONTINUE
210*
211 777 FORMAT(/,4X,'Error in ERTRAK : particle type ', I4,
212 * ' unknown in GEANT' )
213 778 FORMAT(/,4X,'Error in ERTRAK : Nul Momentum. Tracking stops now')
214 779 FORMAT(/,4X,'Error in ERTRAK : Inconsistent character options',
215 + '. Tracking stops now')
216 780 FORMAT(/,4X,'Error in ERTRAK : No prediction. Tracking stops now')
217* END ERTRAK
218 99 END