This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / erpremc / trsdsc.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/03/06 15:37:36  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 C
13       SUBROUTINE TRSDSC(PD,RD,PC,RC,H,CH,IERR,SPU,DJ,DK)
14 C
15 C *** TRANSFORMS ERROR MATRIX
16 C     FROM        VARIABLES (1/P,V',W',V,W)
17 C      TO    SC   VARIABLES (1/P,LAMBDA,PHI,YT,ZT)
18 C
19 C     Authors: A. Haas and W. Wittek
20 C
21 C
22 C *** PD(3)     1/P,V',W'                               INPUT
23 C     PC(3)     1/P,LAMBDA,PHI                         OUTPUT
24 C     H(3)      MAGNETIC FIELD                          INPUT
25 C     RD(15)    ERROR MATRIX IN 1/P,V',W',V,W           INPUT      (TRIANGLE)
26 C     RC(15)    ERROR MATRIX IN   SC   VARIABLES       OUTPUT      (TRIANGLE)
27 C     CH        CHARGE OF PARTICLE                      INPUT
28 C               CHARGE AND MAGNETIC FIELD ARE NEEDED
29 C               FOR CORRELATION TERMS (LAMBDA,V),(LAMBDA,W),(PHI,V),(PHI,W)
30 C               THESE CORRELATION TERMS APPEAR BECAUSE RC IS ASSUMED
31 C               TO BE THE ERROR MATRIX FOR FIXED S (PATH LENGTH)
32 C               AND RD FOR FIXED U
33 C     DJ(3)     UNIT VECTOR IN V-DIRECTION
34 C     DK(3)     UNIT VECTOR IN W-DIRECTION    OF DETECTOR SYSTEM
35 C
36 C     IERR              NOT USED
37 C     SPU       SIGN OF U-COMPONENT OF PARTICLE MOMENTUM    INPUT
38 C
39 #if !defined(CERNLIB_SINGLE)
40       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
41       REAL   PD,PC,H,RC,RD,CH,DJ,DK,SPU
42 #endif
43 #include "geant321/trcom3.inc"
44       DIMENSION PD(3),PC(3),H(3),RC(15),RD(15),DJ(3),DK(3)
45       DIMENSION UN(3),VN(3),DI(3),TVW(3)
46 C
47 #if defined(CERNLIB_SINGLE)
48       DATA CFACT8 / 2.997925 E-4 /
49 #endif
50 #if !defined(CERNLIB_SINGLE)
51       DATA CFACT8 / 2.997925 D-4 /
52 #endif
53 C
54       IERR=0
55       PM=PD(1)
56       TVW(1)=1./SQRT(1.+PD(2)**2+PD(3)**2)
57       IF(SPU.LT.0.) TVW(1)=-TVW(1)
58       TVW(2)=PD(2)*TVW(1)
59       TVW(3)=PD(3)*TVW(1)
60 C
61       DI(1)=DJ(2)*DK(3)-DJ(3)*DK(2)
62       DI(2)=DJ(3)*DK(1)-DJ(1)*DK(3)
63       DI(3)=DJ(1)*DK(2)-DJ(2)*DK(1)
64 C
65       DO 5 I=1,3
66          TN(I)=TVW(1)*DI(I)+TVW(2)*DJ(I)+TVW(3)*DK(I)
67     5 CONTINUE
68 C
69       PC(1)=PD(1)
70       PC(2)=ASIN(TN(3))
71       IF (ABS (TN(1)) .LT. 1.E-30) TN(1) = 1.E-30
72       PC(3) = ATAN2 (TN(2),TN(1))
73 C
74       COSL=SQRT(ABS(1.-TN(3)**2))
75       IF (COSL .LT. 1.E-30) COSL = 1.E-30
76       COSL1=1./COSL
77       UN(1)=-TN(2)*COSL1
78       UN(2)=TN(1)*COSL1
79       UN(3)=0.
80 C
81       VN(1)=-TN(3)*UN(2)
82       VN(2)=TN(3)*UN(1)
83       VN(3)=COSL
84  
85 C
86       UJ=UN(1)*DJ(1)+UN(2)*DJ(2)+UN(3)*DJ(3)
87       UK=UN(1)*DK(1)+UN(2)*DK(2)+UN(3)*DK(3)
88       VJ=VN(1)*DJ(1)+VN(2)*DJ(2)+VN(3)*DJ(3)
89       VK=VN(1)*DK(1)+VN(2)*DK(2)+VN(3)*DK(3)
90 C
91       J=0
92       DO 10 I=1,5
93          DO 4 K=I,5
94             J=J+1
95             A(I,K)=0.
96             A(K,I)=0.
97             S(J)=RD(J)
98     4    CONTINUE
99    10 CONTINUE
100 C
101       IF(CH.EQ.0.) GO TO 6
102       HA=SQRT(H(1)**2+H(2)**2+H(3)**2)
103       HAM=HA*PM
104       IF(HAM.EQ.0.) GO TO 6
105       HM=CH/HA
106 C
107       Q=-HAM*CFACT8
108 C
109       SINZ=-(H(1)*UN(1)+H(2)*UN(2)+H(3)*UN(3))*HM
110       COSZ= (H(1)*VN(1)+H(2)*VN(2)+H(3)*VN(3))*HM
111       A(2,4)=-Q*TVW(2)*SINZ
112       A(2,5)=-Q*TVW(3)*SINZ
113       A(3,4)=-Q*TVW(2)*COSZ*COSL1
114       A(3,5)=-Q*TVW(3)*COSZ*COSL1
115 C
116     6 A(1,1)=1.
117       A(2,2)=TVW(1)*VJ
118       A(2,3)=TVW(1)*VK
119       A(3,2)=TVW(1)*UJ*COSL1
120       A(3,3)=TVW(1)*UK*COSL1
121       A(4,4)=UJ
122       A(4,5)=UK
123       A(5,4)=VJ
124       A(5,5)=VK
125 C
126       CALL SSMT5T(A,S,S)
127 C
128       J=0
129       DO 25 I=1,5
130          DO 20 K=I,5
131             J=J+1
132             RC(J)=S(J)
133    20    CONTINUE
134    25 CONTINUE
135 C
136       RETURN
137 C
138 C *** ERROR EXITS
139 C
140       END
141 *