This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / erdecks / erstor.F
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 *
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *       Store error matrix informations                          *
17 C.    *                                                                *
18 C.    *    ==>Called by : ERTRGO , ERTRCH , ERTRNT                     *
19 C.    *       Author    M.Maire, E.Nagy  *********                     *
20 C.    *                                                                *
21 C.    ******************************************************************
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