MINICERN/mathlib/gen/x/pripar.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:58  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE PRIPAR (A1,A2,B)
  11       COMMON /SLATE/XQX(9), V(4), G1(9), G2(9), G(9)
  12       DIMENSION A1(3),A2(3),B(3)
  13       CALL UCOPY (A1,G,3)
  14       V(3)=0.
  15       I= 0
  16     1 CONTINUE
  17       GINV= 1./G(1)
  18       G2(7)=SIN(G(2))
  19       G2(8)=COS(G(2))
  20       G2(2)=COS (G(3))
  21       G2(5)= SIN(G(3))
  22       G2(3)=-G2(8)*G2(5)
  23       G2(6)=G2(8)*G2(2)
  24       G2(2)=-G2(7)*G2(2)
  25       G2(5)=-G2(7)*G2(5)
  26       G2(1)=-G2(6)*GINV
  27       G2(4)= G2(3)*GINV
  28       G2(7)=-G2(7)*GINV
  29       G2(9)=0.
  30       V(3)=V(3)-G2(7)
  31       CALL VSCALE (G2,GINV,G2,9)
  32       IF (I.EQ.2) GO TO 5
  33       CALL UCOPY (G2,G1,9)
  34       CALL UCOPY (A2,G,3)
  35       I= 2
  36       GO TO 1
  37     5 V(1)=G1(6)+G2(6)
  38       V(2)=-G1(3)-G2(3)
  39       B(1)= V(1)**2+V(2)**2
  40       B(2)=ATAN(V(3)/SQRT(B(1)))
  41       V(4)=SQRT(V(3)**2+ B(1))
  42       B(3)= ATAN2(V(2),V(1))
  43       IF(B(3).LT.0.)  B(3)=B(3)+6.28318
  44       B(1)=1./V(4)
  45       RETURN
  46       END