GEANT321/erpremc/trptsd.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       SUBROUTINE TRPTSD(PD,RD,PC,RC,H,CH,IERR,SPU,DJ,DK)
  13 *
  14 ***************************************************************************
  15 C
  16 C *** TRANSFORMS ERROR MATRIX
  17 C     FROM        VARIABLES (1/Pt,V',W',V,W)
  18 C     FROM        VARIABLES (1/P, V',W',V,W)
  19 C
  20 C
  21 #if !defined(CERNLIB_SINGLE)
  22       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
  23       REAL   PD,PC,H,RC,RD,CH,DJ,DK,SPU
  24 #endif
  25 #include "geant321/trcom3.inc"
  26       DIMENSION PD(3),PC(3),H(3),RC(15),RD(15),DJ(3),DK(3)
  27       DIMENSION UN(3),VN(3),DI(3),TVW(3)
  28 C
  29 #if defined(CERNLIB_SINGLE)
  30       DATA CFACT8 / 2.997925 E-4 /
  31 #endif
  32 #if !defined(CERNLIB_SINGLE)
  33       DATA CFACT8 / 2.997925 D-4 /
  34 #endif
  35 *
  36 **_____________________________________________________________________
  37 *
  38       IERR=0
  39       TVW(1)=1./SQRT(1.+PD(2)**2+PD(3)**2)
  40       IF(SPU.LT.0.) TVW(1)=-TVW(1)
  41       TVW(2)=PD(2)*TVW(1)
  42       TVW(3)=PD(3)*TVW(1)
  43 C
  44       DI(1)=DJ(2)*DK(3)-DJ(3)*DK(2)
  45       DI(2)=DJ(3)*DK(1)-DJ(1)*DK(3)
  46       DI(3)=DJ(1)*DK(2)-DJ(2)*DK(1)
  47 C
  48       DO 5 I=1,3
  49          TN(I)=TVW(1)*DI(I)+TVW(2)*DJ(I)+TVW(3)*DK(I)
  50     5 CONTINUE
  51 C
  52       COSL=SQRT(ABS(1.-TN(3)**2))
  53       IF (COSL .LT. 1.E-30) COSL = 1.E-30
  54       COSL1=1./COSL
  55       SINL  = TN(3)
  56 *
  57       PC(1)=PD(1)*COSL
  58       PC(2)=PD(2)
  59       PC(3)=PD(3)
  60       PM=PC(1)
  61 *
  62       IF (ABS (TN(1)) .LT. 1.E-30) TN(1) = 1.E-30
  63 C
  64       UN(1)=-TN(2)*COSL1
  65       UN(2)=TN(1)*COSL1
  66       UN(3)=0.
  67 C
  68       VN(1)=-TN(3)*UN(2)
  69       VN(2)=TN(3)*UN(1)
  70       VN(3)=COSL
  71
  72 C
  73       UJ=UN(1)*DJ(1)+UN(2)*DJ(2)+UN(3)*DJ(3)
  74       UK=UN(1)*DK(1)+UN(2)*DK(2)+UN(3)*DK(3)
  75       VJ=VN(1)*DJ(1)+VN(2)*DJ(2)+VN(3)*DJ(3)
  76       VK=VN(1)*DK(1)+VN(2)*DK(2)+VN(3)*DK(3)
  77 C
  78       J=0
  79       DO 10 I=1,5
  80          DO 4 K=I,5
  81             J=J+1
  82             A(I,K)=0.
  83             A(K,I)=0.
  84             S(J)=RD(J)
  85     4    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 C
  94       Q=-HAM*CFACT8
  95 C
  96       SINZ=-(H(1)*UN(1)+H(2)*UN(2)+H(3)*UN(3))*HM
  97       COSZ= (H(1)*VN(1)+H(2)*VN(2)+H(3)*VN(3))*HM
  98       A(1,4)=Q*TVW(2)*SINZ*(SINL*PD(1))
  99       A(1,5)=Q*TVW(3)*SINZ*(SINL*PD(1))
 100 C
 101 6     continue
 102       A(1,1) = COSL
 103       A(2,2) = 1.
 104       A(3,3) = 1.
 105       A(4,4) = 1.
 106       A(5,5) = 1.
 107 *
 108       A(1,2)=-TVW(1)*VJ*(SINL*PD(1))
 109       A(1,3)=-TVW(1)*VK*(SINL*PD(1))
 110 C
 111       CALL SSMT5T(A,S,S)
 112 C
 113       DO J=1,15
 114         RC(J)=S(J)
 115       ENDDO
 116 *
 117       END