MINICERN/mathlib/gen/f/dircos.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:30  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE DIRCOS(A,B)
  11       COMMON /SLATE/G(9),F(9),ALAM,APHI,COSL,SINL,COSP,SINP,OUT(3),
  12      +                                                          XQX(13)
  13       DIMENSION A(2),B(3)
  14 C                  VARIABLE TRANSFORMATION
  15 C                  COS X = COS L  *  COS PHI
  16 C                  COS Y = COS L  *  SIN PHI
  17 C                  COS Z = SIN L
  18       ALAM= A(1)
  19       APHI= A(2)
  20       COSL= COS(ALAM)
  21       SINL= SIN(ALAM)
  22       COSP= COS(APHI)
  23       SINP= SIN(APHI)
  24       OUT(1)= COSL*COSP
  25       OUT(2)= COSL*SINP
  26       OUT(3)= SINL
  27       CALL UCOPY (OUT,B,3)
  28       RETURN
  29 C                  JACOBIAN
  30 C                  0   -SIN L * COS PHI    -COS L * SIN PHI
  31 C                  0   -SIN L * SIN PHI     COS L * COS PHI
  32 C                  0        COS L                 0
  33 #if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
  34       ENTRY ERDIRC
  35 #endif
  36 #if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
  37       ENTRY ERDIRC(A,B)
  38 #endif
  39       CALL UZERO (F,1,9)
  40       F(2)= -SINL*COSP
  41       F(3)= -OUT(2)
  42       F(5)= -SINL*SINP
  43       F(6)=  OUT(1)
  44       F(8)=  COSL
  45       CALL MXMPY  (F,A,G,3,3,3)
  46       CALL MXMPY1 (G,F,B,3,3,3)
  47       RETURN
  48       END