GEANT321/erpremc/trscsp.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 C
  13       SUBROUTINE TRSCSP(PC,RC,PS,RS,H,CH,IERR,SPX)
  14 C
  15 C *** TRANSFORMS ERROR MATRIX
  16 C     FROM   SC   VARIABLES (1/P,LAMBDA,PHI,YT,ZT)
  17 C      TO  SPLINE VARIABLES (1/P,Y',Z',Y,Z)
  18 C
  19 C     Authors: A. Haas and W. Wittek
  20 C
  21 C
  22 C *** PC(3)     1/P,LAMBDA,PHI                          INPUT
  23 C     PS(3)     1/P,Y',Z'                              OUTPUT
  24 C     H(3)      MAGNETIC FIELD                          INPUT
  25 C     RC(15)    ERROR MATRIX IN   SC   VARIABLES        INPUT     (TRIANGLE)
  26 C     RS(15)    ERROR MATRIX IN SPLINE VARIABLES       OUTPUT     (TRIANGLE)
  27 C     CH        CHARGE OF PARTICLE                      INPUT
  28 C               CHARGE AND MAGNETIC FIELD ARE NEEDED
  29 C               FOR CORRELATION TERMS (Y',YT),(Y',ZT),(Z',YT),(Z',ZT)
  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 RS FOR FIXED X
  33 C
  34 C     IERR  =   1       PARTICLE MOVES PERPENDICULAR TO X-AXIS
  35 C                      ( Y',Z' ARE NOT DEFINED )
  36 C     SPX       SIGN OF X-COMPONENT OF PARTICLE MOMENTUM   OUTPUT
  37 C
  38 #if !defined(CERNLIB_SINGLE)
  39       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
  40       REAL   PC,PS,H,RC,RS,CH,SPX
  41 #endif
  42 #include "geant321/trcom3.inc"
  43       DIMENSION PC(3),PS(3),H(3),RC(15),RS(15)
  44       DIMENSION UN(3),VN(3)
  45 C
  46 #if defined(CERNLIB_SINGLE)
  47       DATA CFACT8 / 2.997925 E-4 /
  48 #endif
  49 #if !defined(CERNLIB_SINGLE)
  50       DATA CFACT8 / 2.997925 D-4 /
  51 #endif
  52 C
  53       IERR=0
  54       PM=PC(1)
  55       COSL=COS(PC(2))
  56       SINP=SIN(PC(3))
  57       COSP=COS(PC(3))
  58 C
  59       TN(1)=COSL*COSP
  60       SPX=1.
  61       IF(TN(1).LT.0.) SPX=-1.
  62       IF(TN(1).EQ.0.) GO TO 901
  63       TN(2)=COSL*SINP
  64       TN(3)=SIN(PC(2))
  65 C
  66       T1R=1./TN(1)
  67       PS(1)=PC(1)
  68       PS(2)=SINP/COSP
  69       PS(3)=TN(3)*T1R
  70 C
  71       UN(1)=-SINP
  72       UN(2)=COSP
  73 C
  74       VN(1)=-TN(3)*UN(2)
  75       VN(2)=TN(3)*UN(1)
  76       VN(3)=COSL
  77 C
  78       J=0
  79       DO 10 I=1,5
  80          DO 5 K=I,5
  81             J=J+1
  82             A(I,K)=0.
  83             A(K,I)=0.
  84             S(J)=RC(J)
  85     5    CONTINUE
  86    10 CONTINUE
  87 C
  88       IF(CH.EQ.0.) GO TO 6
  89       HA=SQRT(H(1)**2+H(2)**2+H(3)**2)
  90       HAM=HA*PM
  91       IF(HAM.EQ.0.) GO TO 6
  92       HM=CH/HA
  93       Q=-HAM*CFACT8
  94 C
  95 C
  96       SINZ=-(H(1)*UN(1)+H(2)*UN(2)           )*HM
  97       COSZ= (H(1)*VN(1)+H(2)*VN(2)+H(3)*VN(3))*HM
  98
  99       T3R=Q*T1R**3
 100       A(2,4)=-UN(1)*(VN(3)*COSZ           )*T3R
 101       A(2,5)=-VN(1)*(VN(3)*COSZ           )*T3R
 102       A(3,4)=UN(1)*(VN(2)*COSZ-UN(2)*SINZ)*T3R
 103       A(3,5)=VN(1)*(VN(2)*COSZ-UN(2)*SINZ)*T3R
 104 C
 105     6 T2R=T1R**2
 106 C
 107       A(1,1)=1.
 108       A(2,3)=VN(3)*COSL*T2R
 109       A(3,2)=UN(2)*T2R
 110       A(3,3)=-VN(2)*COSL*T2R
 111       A(4,4)=VN(3)*T1R
 112       A(5,4)=-VN(2)*T1R
 113       A(5,5)=UN(2)*T1R
 114 C
 115       CALL SSMT5T(A,S,S)
 116 C
 117       J=0
 118       DO 25 I=1,5
 119          DO 20 K=I,5
 120             J=J+1
 121             RS(J)=S(J)
 122    20    CONTINUE
 123    25 CONTINUE
 124 C
 125       RETURN
 126 C
 127 C *** ERROR EXITS
 128 C
 129   901 IERR=1
 130   910 CONTINUE
 131 C
 132       RETURN
 133       END
 134 *