      SUBROUTINE POL CAR                                                POLC001 
	implicit real*8 (a-h,o-z)
      DIMENSION X0(6),X(6),R0(4)                                        POLC002 
      COMMON R(6) /COORD/ S                                             POLC003 
      COMMON /CONST/ PI,PIT2,PID2,DUM(5)                                POLC004 
C                                                                       POLC005 
C          CONVERTS SPHERICAL COORDINATES TO CARTESIAN                  POLC006 
      IF (R(5).EQ.0.d0.AND.R(6).EQ.0.d0) GO TO 1                        POLC007 
      VERT=0.d0                                                         POLC008 
      SINA=dSIN(R(2))                                                   POLC009 
      COSA=dSIN(PID2-R(2))                                              POLC010 
      SINP=dSIN(R(3))                                                   POLC011 
      COSP=dSIN(PID2-R(3))                                              POLC012 
      X0(1)=R(1)*SINA*COSP                                              POLC013 
      X0(2)=R(1)*SINA*SINP                                              POLC014 
      X0(3)=R(1)*COSA                                                   POLC015 
      X(4)=R(4)*SINA*COSP+R(5)*COSA*COSP-R(6)*SINP                      POLC016 
      X(5)=R(4)*SINA*SINP+R(5)*COSA*SINP+R(6)*COSP                      POLC017 
      X(6)=R(4)*COSA-R(5)*SINA                                          POLC018 
      RETURN                                                            POLC019 
C          VERTICAL INCIDENCE                                           POLC020 
    1 VERT=1.d0                                                         POLC021 
      R0(1)=R(1)                                                        POLC022 
      R0(2)=R(2)                                                        POLC023 
      R0(3)=R(3)                                                        POLC024 
      R0(4)=dSIGN(1.d0,R(4))                                            POLC025 
      RETURN                                                            POLC026 
C                                                                       POLC027 
C          STEPS THE RAY A DISTANCE S, AND THEN                         POLC028 
C          CONVERTS CARTESIAN COORDINATES TO SPHERICAL COORDINATES      POLC029 
      ENTRY CAR POL                                                     POLC030 
      IF (VERT.NE.0.) GO TO 2                                           POLC031 
ccc	print*,' CARPOL  - step = ',s
      X(1)=X0(1)+S*X(4)                                                 POLC032 
      X(2)=X0(2)+S*X(5)                                                 POLC033 
      X(3)=X0(3)+S*X(6)                                                 POLC034 
      TEMP=dSQRT(X(1)**2+X(2)**2)                                       POLC035 
      R(1)=dSQRT(X(1)**2+X(2)**2+X(3)**2)                               POLC036 
      R(2)=dATAN2(TEMP,X(3))                                            POLC037 
      R(3)=dATAN2(X(2),X(1))                                            POLC038 
      R(4)=(X(1)*X(4)+X(2)*X(5)+X(3)*X(6))/R(1)                         POLC039 
      R(5)=(X(3)*(X(1)*X(4)+X(2)*X(5))-(X(1)**2+X(2)**2)*X(6))/         POLC040 
     1 (R(1)*TEMP)                                                      POLC041 
      R(6)=(X(1)*X(5)-X(2)*X(4))/TEMP                                   POLC042 
      RETURN                                                            POLC043 
C          VERTICAL INCIDENCE                                           POLC044 
    2 R(1)=R0(1)+R0(4)*S                                                POLC045 
      R(2)=R0(2)                                                        POLC046 
      R(3)=R0(3)                                                        POLC047 
      R(4)=R0(4)                                                        POLC048 
      R(5)=0.                                                           POLC049 
      R(6)=0.                                                           POLC050 
      RETURN                                                            POLC051 
         END                                                            POLC 52-
