      SUBROUTINE ROTP(ITETA)
C
      INCLUDE 'com_faces.f'
      REAL*8 PI180,ANGL
      DATA   PI180 / .0174523925199433 D0 /
      DATA   UT    / .3333333333333333 /
      DATA   USQ3  / 0.577350269189626 /
C
      ANGL = DBLE(ITETA)*PI180
      SI3 = REAL(DSIN(ANGL))*USQ3
      CO  = REAL(DCOS(ANGL))
      ROTLOC(1,1) = UT*(1.+2.*CO)
      ROTLOC(2,1) = UT*(1.-CO) + SI3
      ROTLOC(3,1) = UT*(1.-CO) - SI3
      ROTLOC(1,2) = UT*(1.-CO) - SI3
      ROTLOC(2,2) = UT*(1.+2.*CO)
      ROTLOC(3,2) = UT*(1.-CO) + SI3
      ROTLOC(1,3) = UT*(1.-CO) + SI3
      ROTLOC(2,3) = UT*(1.-CO) - SI3
      ROTLOC(3,3) = UT*(1.+2.*CO)
      CALL ROTATE(1)
      END
C=========================================================================
      SUBROUTINE ROTX(ITETA)
C
      INCLUDE 'com_coor.f'
      INCLUDE 'com_faces.f'
      REAL*8 PI180,ANGL
      DATA   PI180 / .0174523925199433 D0 /
C
      ANGL = DBLE(ITETA)*PI180
      SI = REAL(DSIN(ANGL))
      CO = REAL(DCOS(ANGL))
      ROTLOC(1,1) = 1.
      ROTLOC(2,1) = 0.
      ROTLOC(3,1) = 0.
      ROTLOC(1,2) = 0.
      ROTLOC(2,2) = CO
      ROTLOC(3,2) = SI
      ROTLOC(1,3) = 0.
      ROTLOC(2,3) = -SI
      ROTLOC(3,3) = CO
      CALL MULT(ROTA,ROTLOC)
      DO 10 N=1,NF4
        DO 20 I=1,NDS2
          YYY = YF(I,N)
          ZZZ = ZF(I,N)
          YF(I,N) = CO*YYY - SI*ZZZ
          ZF(I,N) = SI*YYY + CO*ZZZ
  20    CONTINUE
  10  CONTINUE
      DO I=1,NUMBIS
        YYY = Y(I)
        ZZZ = Z(I)
        Y(I) = CO*YYY - SI*ZZZ
        Z(I) = SI*YYY + CO*ZZZ
      ENDDO
      IF (NSURF.GT.0) THEN
        DO I=1,NSURF
          DO J=1,4
            YYY = YIS(J,I)
            ZZZ = ZIS(J,I)
            YIS(J,I) = CO*YYY - SI*ZZZ
            ZIS(J,I) = SI*YYY + CO*ZZZ
          ENDDO
        ENDDO
      ENDIF
      END
C=========================================================================
      SUBROUTINE ROTY(ITETA)
C
      INCLUDE 'com_coor.f'
      INCLUDE 'com_faces.f'
      REAL*8 PI180,ANGL
      DATA   PI180 / .0174523925199433 D0 /
C
      ANGL = DBLE(ITETA)*PI180
      SI = REAL(DSIN(ANGL))
      CO = REAL(DCOS(ANGL))
      ROTLOC(1,1) = CO 
      ROTLOC(2,1) = 0.
      ROTLOC(3,1) = -SI
      ROTLOC(1,2) = 0.
      ROTLOC(2,2) = 1.
      ROTLOC(3,2) = 0.
      ROTLOC(1,3) = SI
      ROTLOC(2,3) = 0. 
      ROTLOC(3,3) = CO
      CALL MULT(ROTA,ROTLOC)
      DO 10 N=1,NF4
        DO 20 I=1,NDS2
          ZZZ = ZF(I,N)
          XXX = XF(I,N)
          ZF(I,N) = CO*ZZZ - SI*XXX
          XF(I,N) = SI*ZZZ + CO*XXX
  20    CONTINUE
  10  CONTINUE
      DO I=1,NUMBIS
        ZZZ = Z(I)
        XXX = X(I)
        Z(I) = CO*ZZZ - SI*XXX
        X(I) = SI*ZZZ + CO*XXX
      ENDDO
      IF (NSURF.GT.0) THEN
        DO I=1,NSURF
          DO J=1,4
            ZZZ = ZIS(J,I)
            XXX = XIS(J,I)
            ZIS(J,I) = CO*ZZZ - SI*XXX
            XIS(J,I) = SI*ZZZ + CO*XXX
          ENDDO
        ENDDO
      ENDIF
      END
C=========================================================================
      SUBROUTINE ROTZ(ITETA)
C
      INCLUDE 'com_coor.f'
      INCLUDE 'com_faces.f'
      REAL*8 PI180,ANGL
      DATA   PI180 / .0174523925199433 D0 /
C
      ANGL = DBLE(ITETA)*PI180
      SI = REAL(DSIN(ANGL))
      CO = REAL(DCOS(ANGL))
      ROTLOC(1,1) = CO
      ROTLOC(2,1) = SI
      ROTLOC(3,1) = 0.
      ROTLOC(1,2) = -SI
      ROTLOC(2,2) = CO
      ROTLOC(3,2) = 0.
      ROTLOC(1,3) = 0.
      ROTLOC(2,3) = 0. 
      ROTLOC(3,3) = 1.
      CALL MULT(ROTA,ROTLOC)
      DO 10 N=1,NF4
        DO 20 I=1,NDS2
          XXX = XF(I,N)
          YYY = YF(I,N)
          XF(I,N) = CO*XXX - SI*YYY
          YF(I,N) = SI*XXX + CO*YYY
  20    CONTINUE
  10  CONTINUE
      DO I=1,NUMBIS
        XXX = X(I)
        YYY = Y(I)
        X(I) = CO*XXX - SI*YYY
        Y(I) = SI*XXX + CO*YYY
      ENDDO
      IF (NSURF.GT.0) THEN
        DO I=1,NSURF
          DO J=1,4
            XXX = XIS(J,I)
            YYY = YIS(J,I)
            XIS(J,I) = CO*XXX - SI*YYY
            YIS(J,I) = SI*XXX + CO*YYY
          ENDDO
        ENDDO
      ENDIF
      END
C=========================================================================
      SUBROUTINE ROTATE(IOPT)
C
      INCLUDE 'com_coor.f'
      INCLUDE 'com_faces.f'
C
      IF (IOPT.EQ.0) THEN
        DO I=1,3
          DO J=1,3
            ROTLOC(J,I) = ROTA(J,I)
          ENDDO
        ENDDO
      ELSE
        CALL MULT(ROTA,ROTLOC)
      ENDIF
      DO 10 N=1,NF4
        DO 20 I=1,NDS2
          XXX = XF(I,N)
          YYY = YF(I,N)
          ZZZ = ZF(I,N)
          XF(I,N) = ROTLOC(1,1)*XXX + ROTLOC(1,2)*YYY + ROTLOC(1,3)*ZZZ
          YF(I,N) = ROTLOC(2,1)*XXX + ROTLOC(2,2)*YYY + ROTLOC(2,3)*ZZZ
          ZF(I,N) = ROTLOC(3,1)*XXX + ROTLOC(3,2)*YYY + ROTLOC(3,3)*ZZZ
  20    CONTINUE
  10  CONTINUE
      DO I=1,NUMBIS
        XXX = X(I)
        YYY = Y(I)
        ZZZ = Z(I)
        X(I) = ROTLOC(1,1)*XXX + ROTLOC(1,2)*YYY + ROTLOC(1,3)*ZZZ
        Y(I) = ROTLOC(2,1)*XXX + ROTLOC(2,2)*YYY + ROTLOC(2,3)*ZZZ
        Z(I) = ROTLOC(3,1)*XXX + ROTLOC(3,2)*YYY + ROTLOC(3,3)*ZZZ
      ENDDO
      IF (NSURF.GT.0) THEN
        DO I=1,NSURF
          DO J=1,4
            XXX = XIS(J,I)
            YYY = YIS(J,I)
            ZZZ = ZIS(J,I)
            XIS(J,I)=ROTLOC(1,1)*XXX+ROTLOC(1,2)*YYY+ROTLOC(1,3)*ZZZ
            YIS(J,I)=ROTLOC(2,1)*XXX+ROTLOC(2,2)*YYY+ROTLOC(2,3)*ZZZ
            ZIS(J,I)=ROTLOC(3,1)*XXX+ROTLOC(3,2)*YYY+ROTLOC(3,3)*ZZZ
          ENDDO
        ENDDO
      ENDIF
      END
C=========================================================================
      SUBROUTINE ROTINT(V0,V1)
      INCLUDE 'com_faces.f'
      REAL*8 V0(3),V1(3),VR(3),VRN,USVRN,CO1,CO,SI,UMCO
C      
      VR(1) = V0(2)*V1(3) - V1(2)*V0(3)
      VR(2) = V0(3)*V1(1) - V1(3)*V0(1)
      VR(3) = V0(1)*V1(2) - V1(1)*V0(2)
      VRN = VR(1)**2 + VR(2)**2 + VR(3)**2
      IF (VRN.NE.0.) THEN
        USVRN = 1.D0/DSQRT(VRN)
        VR(1) = VR(1)*USVRN
        VR(2) = VR(2)*USVRN
        VR(3) = VR(3)*USVRN
        CO1 = V0(1)*V1(1)+V0(2)*V1(2)+V0(3)*V1(3)
        CO = MIN(1.D0,2.D0*CO1**2 - 1.D0)
        SI = DSQRT(1.D0-CO**2)
        UMCO = 1.D0-CO
        ROTLOC(1,1) = REAL(CO + UMCO*VR(1)**2)
        ROTLOC(2,1) = REAL( VR(3)*SI + UMCO*VR(1)*VR(2))
        ROTLOC(3,1) = REAL(-VR(2)*SI + UMCO*VR(3)*VR(1))
        ROTLOC(1,2) = REAL(-VR(3)*SI + UMCO*VR(1)*VR(2))
        ROTLOC(2,2) = REAL(CO + UMCO*VR(2)**2)
        ROTLOC(3,2) = REAL( VR(1)*SI + UMCO*VR(2)*VR(3))
        ROTLOC(1,3) = REAL( VR(2)*SI + UMCO*VR(3)*VR(1))
        ROTLOC(2,3) = REAL(-VR(1)*SI + UMCO*VR(2)*VR(3))
        ROTLOC(3,3) = REAL(CO + UMCO*VR(3)**2)
        CALL MULT(ROTA,ROTLOC)
      ENDIF
      END
C=========================================================================
      SUBROUTINE MULT(R1,R2)
      DIMENSION R1(3,3),R2(3,3),R3(3,3)
C
      DO I=1,3
        DO J=1,3
          R3(J,I) = R1(J,I)
        ENDDO
      ENDDO
C
      DO I=1,3
        DO J=1,3
          R1(J,I) = R2(J,1)*R3(1,I) + R2(J,2)*R3(2,I) + R2(J,3)*R3(3,I)
        ENDDO
      ENDDO
      END
C=========================================================================
      SUBROUTINE ROTATION(X,Y,Z,ROT,XR,YR,ZR)
      DIMENSION ROT(3,3)
C
      XR = ROT(1,1)*X + ROT(1,2)*Y + ROT(1,3)*Z
      YR = ROT(2,1)*X + ROT(2,2)*Y + ROT(2,3)*Z
      ZR = ROT(3,1)*X + ROT(3,2)*Y + ROT(3,3)*Z
      END

