MINICERN/mathlib/gen/f/polrot.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:29  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE POLROT(THETA,PHI,THPRIM,PHPRIM,THAXE,PHAXE,ROTANG)
  11 C
  12 C     SUBROUTINE POUR CALCULER UNE ROTATION EN COORDONNEES POLAIRES
  13 C
  14 C     THAXE,PHAXE=DIRECTION DE L#AXE,ROTANG=ANGLE DE ROTATION
  15 C
  16 C     PI=3.14159265
  17 C
  18 C     SI THPRIM = 0.0,PHPRIM A N#IMPORTE QUELLE VALEUR
  19 C
  20       DIMENSION X(3),TENSO1(3),TENSO2(3),TENSO3(3)
  21       DATA PI/3.14159265/,PIHALF/1.57079633/
  22       A=COS(ROTANG)
  23       B=1.0-A
  24       C=SIN(ROTANG)
  25       AX=SIN(THAXE)
  26       E1=AX*COS(PHAXE)
  27       E2=AX*SIN(PHAXE)
  28       E3=COS(THAXE)
  29       ET=SIN(THETA)
  30       X(1)=ET*COS(PHI)
  31       X(2)=ET*SIN(PHI)
  32       X(3)=COS(THETA)
  33       B12=B*E1*E2
  34       B13=B*E1*E3
  35       B23=B*E2*E3
  36       C1=C*E1
  37       C2=C*E2
  38       C3=C*E3
  39       TENSO1(1)=A+B*E1**2
  40       TENSO1(2)=B12+C3
  41       TENSO1(3)=B13-C2
  42       TENSO2(1)=B12-C3
  43       TENSO2(2)=A+B*E2**2
  44       TENSO2(3)=B23+C1
  45       TENSO3(1)=B13+C2
  46       TENSO3(2)=B23-C1
  47       TENSO3(3)=A+B*E3**2
  48       Y1=0.0
  49       Y2=0.0
  50       Y3=0.0
  51       DO 3 K=1,3
  52       Y1=Y1+TENSO1(K)*X(K)
  53       Y2=Y2+TENSO2(K)*X(K)
  54     3 Y3=Y3+TENSO3(K)*X(K)
  55       IF(Y1.NE.0.OR.Y2.NE.0.)GO TO 12
  56       PHPRIM=0.0
  57       THPRIM=PIHALF-SIGN(PIHALF,Y3)
  58       GO TO 13
  59    12 PHPRIM=ATAN2(Y2,Y1)
  60       IF(PHPRIM)1,2,2
  61     1 PHPRIM=PHPRIM+2.0*PI
  62     2 CONTINUE
  63       IF(Y1.NE.0.OR.Y3.NE.0.)GO TO 15
  64       THPRIM=PIHALF
  65       GO TO 13
  66    15 COPHPR=COS(PHPRIM)
  67       IF(ABS(COPHPR).LT.0.7)GO TO 5
  68       THPRIM=ATAN2(Y1/COS(PHPRIM),Y3)
  69       GO TO 13
  70     5                  THPRIM=ATAN2(Y2/SIN(PHPRIM),Y3)
  71    13 RETURN
  72       END