Some function moved to AliZDC
[u/mrichter/AliRoot.git] / GEANT321 / erdecks / erstor.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1996/03/06 15:37:35 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 ERSTOR
13*
14C. ******************************************************************
15C. * *
16C. * Store error matrix informations *
17C. * *
18C. * ==>Called by : ERTRGO , ERTRCH , ERTRNT *
19C. * Author M.Maire, E.Nagy ********* *
20C. * *
21C. ******************************************************************
22*
23#include "geant321/gckine.inc"
24#include "geant321/gctrak.inc"
25#include "geant321/erwork.inc"
26#include "geant321/ertrio.inc"
27#include "geant321/trcom3.inc"
28*
29 DOUBLE PRECISION C(5,5), DUM(5,5)
30*
31* *** Write out results at intermediate points
32*
33 ILPRED = ILPRED + 1
34 IF (ILPRED.GE.NEPRED) ISTOP = 1
35 IEPRED(ILPRED) = INLIST
36*
37* *** Leave B-matrix intact for eventual further tracking
38*
39 IF (.NOT. LEONLY) THEN
40 DO 6 I = 1, 5
41 DO 5 J = 1, 5
42 C(I,J) = B(I,J)
43 5 CONTINUE
44 6 CONTINUE
45*
46* *** Error matrix into single precision
47*
48 DO 10 I = 1, 15
49 ERROUT(I,ILPRED) = EF(I)
50 10 CONTINUE
51*
52* *** If backtracking - vector, charge, error- and transport-matrix
53* in original direction
54*
55 IF (BACKTR.LT.0.) THEN
56 CALL ERBCER (ERROUT(1,ILPRED))
57 CALL ERBCTR (C)
58 ENDIF
59 ENDIF
60*
61* *** Back into SC variables
62*
63 IF (VECT(7) .LT. 1.E-30) VECT(7) = 1.E-30
64 PF(1) = 1./VECT(7)
65 PF(2) = BACKTR*ASIN (VECT(6))
66 IF (ABS (VECT(4)) .LT. 1.E-30) VECT(4) = 1.E-30
67 PF(3) = ATAN2 (BACKTR*VECT(5), BACKTR*VECT(4))
68*
69* *** Transform error matrix in the variables of the plane where
70* tracking terminates
71*
72 IF (LEPLAN) THEN
73 CALL TRSCSD (PF, ERROUT(1,ILPRED), PF ,ERROUT(1,ILPRED), HF,
74 + CHARGE, IER ,SPU, ERPLO(1,1,INLIST),
75 + ERPLO(1,2,INLIST))
76 IF (LEONLY) GOTO 25
77 CALL DMM55 (A, C, DUM)
78 CALL DMM55 (DUM, ASDSC, C)
79 ENDIF
80*
81* *** Transport matrix in single precision
82*
83 DO 20 I = 1,5
84 DO 15 J = 1,5
85 ERDTRP(I,J,ILPRED) = C(I,J)
86 ERTRSP(I,J,ILPRED) = C(I,J)
87 15 CONTINUE
88 20 CONTINUE
89*
90 25 CONTINUE
91 DO 30 I = 1, 3
92 ERXOUT(I,ILPRED) = VECT(I)
93 ERPOUT(I,ILPRED) = PF(I)
94 30 CONTINUE
95*
96 END