Some function moved to AliZDC
[u/mrichter/AliRoot.git] / GEANT321 / erdecks / ertrak.F
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