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 *