SUBROUTINE SROTU (N, X, INCX, Y, INCY, F, S)
      IMPLICIT NONE
      INTEGER I, N, INCX, INCY
      REAL X (*), Y (*), F, S, U, V
      IF (INCX.EQ .1.AND.INCY.EQ .1) THEN
         DO I = 1, N
            U = X (I)
            V = Y (I)
            X (I) = S * (-F * U + V) + U
            Y (I) = -S * (F * V + U) + V
         ENDDO
      ELSE
         DO I = 1, N
            U = X ((I - 1) * INCX + 1)
            V = Y ((I - 1) * INCY + 1)
            X ((I - 1) * INCX + 1) = S * (-F * U + V) + U
            Y ((I - 1) * INCY + 1) = -S * (F * V + U) + V
         ENDDO
      ENDIF
      RETURN
      END SUBROUTINE SROTU

      SUBROUTINE SROTX (N, X, INCX, Y, INCY, F, S)
      IMPLICIT NONE
      INTEGER I, N, INCX, INCY
      REAL X (*), Y (*), F, S, U, V
      IF (INCX.EQ .1.AND.INCY.EQ .1) THEN
         DO I = 1, N
            U = X (I)
            V = Y (I)
            X (I) = S * (F * U + V) - U
            Y (I) = S * (F * V - U) - V
         ENDDO
      ELSE
         DO I = 1, N
            U = X ((I - 1) * INCX + 1)
            V = Y ((I - 1) * INCY + 1)
            X ((I - 1) * INCX + 1) = S * (F * U + V) - U
            Y ((I - 1) * INCY + 1) = S * (F * V - U) - V
         ENDDO
      ENDIF
      RETURN
      END SUBROUTINE SROTX

      SUBROUTINE SROTV (N, X, INCX, Y, INCY, C, G)
      IMPLICIT NONE
      INTEGER I, N, INCX, INCY
      REAL X (*), Y (*), G, C, U, V
      IF (INCX.EQ .1.AND.INCY.EQ .1) THEN
         DO I = 1, N
            U = X (I)
            V = Y (I)
            X (I) = C * (-G * V + U) + V
            Y (I) = C * (G * U + V) - U
         ENDDO
      ELSE
         DO I = 1, N
            U = X ((I - 1) * INCX + 1)
            V = Y ((I - 1) * INCY + 1)
            X ((I - 1) * INCX + 1) = C * (-G * V + U) + V
            Y ((I - 1) * INCY + 1) = C * (G * U + V) - U
         ENDDO
      ENDIF
      RETURN
      END SUBROUTINE SROTV

      SUBROUTINE SROTW (N, X, INCX, Y, INCY, C, G)
      IMPLICIT NONE
      INTEGER I, N, INCX, INCY
      REAL X (*), Y (*), G, C, U, V
      IF (INCX.EQ .1.AND.INCY.EQ .1) THEN
         DO I = 1, N
            U = X (I)
            V = Y (I)
            X (I) = C * (G * V + U) - V
            Y (I) = C * (-G * U + V) + U
         ENDDO
      ELSE
         DO I = 1, N
            U = X ((I - 1) * INCX + 1)
            V = Y ((I - 1) * INCY + 1)
            X ((I - 1) * INCX + 1) = C * (G * V + U) - V
            Y ((I - 1) * INCY + 1) = C * (-G * U + V) + U
         ENDDO
      ENDIF
      RETURN
      END SUBROUTINE SROTW

      SUBROUTINE SROT2 (N, X, INCX, Y, INCY, CS, SN)
      IMPLICIT NONE
      REAL ZERO, ONE
      PARAMETER (ZERO = 0.0E0, ONE = 1.0E0)
      INTEGER N, INCX, INCY
      REAL X (*), Y (*), CS, SN, T, CSX, SNX
      EXTERNAL SFMA0
      REAL SFMA0
      IF (CS.GE.ABS (SN)) THEN
         T = SN / (ONE + CS)
         CSX = SFMA0 (-SN, T, ONE)
         IF (CSX.NE.ONE.OR.SN.NE.ZERO) THEN
            CALL SROTU (N, X, INCX, Y, INCY, T, SN)
         ENDIF
      ELSE IF (-CS.GE.ABS (SN)) THEN
         T = SN / (ONE - CS)
         CSX = SFMA0 (SN, T, -ONE)
         CALL SROTX (N, X, INCX, Y, INCY, T, SN)
      ELSE IF (SN.GE.ZERO) THEN
         T = CS / (ONE + SN)
         SNX = SFMA0 (-CS, T, ONE)
         CALL SROTV (N, X, INCX, Y, INCY, CS, T)
      ELSE IF (SN.LE.ZERO) THEN
         T = CS / (ONE - SN)
         SNX = SFMA0 (CS, T, -ONE)
         CALL SROTW (N, X, INCX, Y, INCY, CS, T)
      ENDIF
      RETURN
      END SUBROUTINE SROT2