SUBROUTINE CSROTU(N, X, INCX, Y, INCY, F, S)

      IMPLICIT NONE
      INTEGER I,N,INCX,INCY
      COMPLEX X(*),Y(*),U,V
      REAL F,S,VR,VC,UR,UC

      IF (INCX .EQ. 1 .AND. INCY .EQ. 1) THEN
         DO I=1,N
            UR=REAL(X(I))
            UC=AIMAG(X(I))
            VR=REAL(Y(I))
            VC=AIMAG(Y(I))
            X(I)=CMPLX(S*(-F*UR+VR)+UR,S*(-F*UC+VC)+UC)
            Y(I)=CMPLX(-S*(F*VR+UR)+VR,-S*(F*VC+UC)+VC)
         ENDDO
      ELSE
         DO I=1,N
            UR=REAL(X((I-1)*INCX+1))
            UC=AIMAG(X((I-1)*INCX+1))
            VR=REAL(Y((I-1)*INCX+1))
            VC=AIMAG(Y((I-1)*INCX+1))
            X((I-1)*INCX+1)=CMPLX(S*(-F*UR+VR)+UR,S*(-F*UC+VC)+UC)
            Y((I-1)*INCY+1)=CMPLX(-S*(F*VR+UR)+VR,-S*(F*VC+UC)+VC)
         ENDDO
      ENDIF
  
      RETURN
  
      END SUBROUTINE CSROTU

      SUBROUTINE CSROTX(N, X, INCX, Y, INCY, F, S)

      IMPLICIT NONE
      INTEGER I,N,INCX,INCY
      COMPLEX X(*),Y(*),U,V
      REAL F,S,VR,VC,UR,UC

      IF (INCX .EQ. 1 .AND. INCY .EQ. 1) THEN
         DO I=1,N
            UR=REAL(X(I))
            UC=AIMAG(X(I))
            VR=REAL(Y(I))
            VC=AIMAG(Y(I))
            X(I)=CMPLX(S*(F*UR+VR)-UR,S*(F*UC+VC)-UC)
            Y(I)=CMPLX(S*(F*VR-UR)-VR,S*(F*VC-UC)-VC)
         ENDDO
      ELSE
         DO I=1,N
            UR=REAL(X((I-1)*INCX+1))
            UC=AIMAG(X((I-1)*INCX+1))
            VR=REAL(Y((I-1)*INCX+1))
            VC=AIMAG(Y((I-1)*INCX+1))
            X((I-1)*INCX+1)=CMPLX(S*(F*UR+VR)-UR,S*(F*UC+VC)-UC)
            Y((I-1)*INCY+1)=CMPLX(S*(F*VR-UR)-VR,S*(F*VC-UC)-VC)
         ENDDO
      ENDIF
  
      RETURN
  
      END SUBROUTINE CSROTX

      SUBROUTINE CSROTV(N, X, INCX, Y, INCY, C, G)

      IMPLICIT NONE
      INTEGER I,N,INCX,INCY
      COMPLEX X(*),Y(*),U,V
      REAL G,C,UR,UC,VR,VC
      
      IF (INCX .EQ. 1 .AND. INCY .EQ. 1) THEN
         DO I=1,N
            UR=REAL(X(I))
            UC=AIMAG(X(I))
            VR=REAL(Y(I))
            VC=AIMAG(Y(I))
            X(I)=CMPLX(C*(-G*VR+UR)+VR,C*(-G*VC+UC)+VC)
            Y(I)=CMPLX(C*(G*UR+VR)-UR,C*(G*UC+VC)-UC)
         ENDDO
      ELSE
         DO I=1,N
            UR=REAL(X((I-1)*INCX+1))
            UC=AIMAG(X((I-1)*INCX+1))
            VR=REAL(Y((I-1)*INCX+1))
            VC=AIMAG(Y((I-1)*INCX+1))
            X((I-1)*INCX+1)=CMPLX(C*(-G*VR+UR)+VR,C*(-G*VC+UC)+VC)
            Y((I-1)*INCY+1)=CMPLX(C*(G*UR+VR)-UR,C*(G*UC+VC)-UC)
         ENDDO
      ENDIF
  
      RETURN
  
      END SUBROUTINE CSROTV

      SUBROUTINE CSROTW(N, X, INCX, Y, INCY, C, G)

      IMPLICIT NONE
      INTEGER I,N,INCX,INCY
      COMPLEX X(*),Y(*),U,V
      REAL G,C,UR,UC,VR,VC

      IF (INCX .EQ. 1 .AND. INCY .EQ. 1) THEN
         DO I=1,N
            UR=REAL(X(I))
            UC=AIMAG(X(I))
            VR=REAL(Y(I))
            VC=AIMAG(Y(I))
            X(I)=CMPLX(C*(G*VR+UR)-VR,C*(G*VC+UC)-VC)
            Y(I)=CMPLX(C*(-G*UR+VR)+UR,C*(-G*UC+VC)+UC)
         ENDDO
      ELSE
         DO I=1,N
            UR=REAL(X((I-1)*INCX+1))
            UC=AIMAG(X((I-1)*INCX+1))
            VR=REAL(Y((I-1)*INCX+1))
            VC=AIMAG(Y((I-1)*INCX+1))
            X((I-1)*INCX+1)=CMPLX(C*(G*VR+UR)-VR,C*(G*VC+UC)-VC)
            Y((I-1)*INCY+1)=CMPLX(C*(-G*UR+VR)+UR,C*(-G*UC+VC)+UC)
         ENDDO
      ENDIF
  
      RETURN
      
      END SUBROUTINE CSROTW

      SUBROUTINE CSROT2(N,X,INCX,Y,INCY,CS,SN)

      IMPLICIT NONE
      REAL ZERO, ONE
      PARAMETER (ONE = 1.0E0, ZERO = 0.0E0)
      INTEGER N,INCX,INCY
      REAL CS,SN,T,CSX,SNX
      COMPLEX X(*),Y(*)
      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 CSROTU (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 CSROTX (N, X, INCX, Y, INCY, T, SN)
         
      ELSE IF(SN .GE. ZERO) THEN
         
         T = CS/(ONE+SN)
         SNX = SFMA0(-CS,T,ONE)
         CALL CSROTV (N, X, INCX, Y, INCY, CS, T)
         
      ELSE IF(SN .LE. ZERO) THEN
         
         T = CS/(ONE-SN)
         SNX = SFMA0(CS,T,-ONE)
         CALL CSROTW (N, X, INCX, Y, INCY, CS, T)
         
      ENDIF
      
      RETURN

      END SUBROUTINE CSROT2