GEANT321/erpremc/trscpt.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 TRSCPT(PC,RC,PD,RD,IERR)
  13 C
  14 C *** TRANSFORMS ERROR MATRIX
  15 C     FROM   SC   VARIABLES (1/P,LAMBDA,PHI,YT,ZT)
  16 C     FROM   SC   VARIABLES (1/Pt,LAMBDA,PHI,YT,ZT)
  17
  18
  19 #if !defined(CERNLIB_SINGLE)
  20       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
  21       REAL  PC,PD,RC,RD
  22 #endif
  23 #include "geant321/trcom3.inc"
  24       DIMENSION PC(3),PD(3),RC(15),RD(15)
  25 *
  26 *______________________________________________________________________
  27 *
  28       IERR = 0
  29       COSL  = COS(PC(2))
  30       IF (ABS(COSL).EQ.0) GO TO 901
  31       COSL1 = 1./COSL
  32       TANL  =    TAN(PC(2))
  33 *
  34       PD(1) = PC(1)*COSL1
  35       PD(2) = PC(2)
  36       PD(3) = PC(3)
  37 *
  38       J=0
  39 *
  40       DO 10 I=1,5
  41          DO 5 K=I,5
  42             J=J+1
  43             A(I,K)=0.
  44             A(K,I)=0.
  45             S(J)=RC(J)
  46     5    CONTINUE
  47    10 CONTINUE
  48 *
  49       A(1,1) = COSL1
  50       A(2,2) = 1.D0
  51       A(3,3) = 1.D0
  52       A(4,4) = 1.D0
  53       A(5,5) = 1.D0
  54 *
  55       A(1,2) = PD(1)*TANL
  56 C
  57       CALL SSMT5T(A,S,S)
  58 C
  59       DO 25 J=1,15
  60         RD(J)=S(J)
  61    25 CONTINUE
  62 C
  63       RETURN
  64 C
  65 C *** ERROR EXITS
  66 C
  67   901 IERR=1
  68   910 CONTINUE
  69 C
  70       END