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

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

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

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

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

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

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

      IMPLICIT NONE
      INTEGER I,N,INCX,INCY
      COMPLEX*16 X(*),Y(*),U,V
      DOUBLE PRECISION G,C,VR,VC,UR,UC
      
      IF (INCX .EQ. 1 .AND. INCY .EQ. 1) THEN
         DO I=1,N
            UR=DBLE(X(I))
            UC=DIMAG(X(I))
            VR=DBLE(Y(I))
            VC=DIMAG(Y(I))
            X(I)=DCMPLX(C*(-G*VR+UR)+VR,C*(-G*VC+UC)+VC)
            Y(I)=DCMPLX(C*(G*UR+VR)-UR,C*(G*UC+VC)-UC)
         ENDDO
      ELSE
         DO I=1,N
            UR=DBLE(X((I-1)*INCX+1))
            UC=DIMAG(X((I-1)*INCX+1))
            VR=DBLE(Y((I-1)*INCX+1))
            VC=DIMAG(Y((I-1)*INCX+1))
            X((I-1)*INCX+1)=DCMPLX(C*(-G*VR+UR)+VR,C*(-G*VC+UC)+VC)
            Y((I-1)*INCY+1)=DCMPLX(C*(G*UR+VR)-UR,C*(G*UC+VC)-UC)
         ENDDO
      ENDIF
  
      RETURN
  
      END SUBROUTINE ZDROTV

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

      IMPLICIT NONE
      INTEGER I,N,INCX,INCY
      COMPLEX*16 X(*),Y(*),U,V
      DOUBLE PRECISION G,C,VR,VC,UR,UC
      
      IF (INCX .EQ. 1 .AND. INCY .EQ. 1) THEN
         DO I=1,N
            UR=DBLE(X(I))
            UC=DIMAG(X(I))
            VR=DBLE(Y(I))
            VC=DIMAG(Y(I))
            X(I)=DCMPLX(C*(G*VR+UR)-VR,C*(G*VC+UC)-VC)
            Y(I)=DCMPLX(C*(-G*UR+VR)+UR,C*(-G*UC+VC)+UC)
         ENDDO
      ELSE
         DO I=1,N
            UR=DBLE(X((I-1)*INCX+1))
            UC=DIMAG(X((I-1)*INCX+1))
            VR=DBLE(Y((I-1)*INCX+1))
            VC=DIMAG(Y((I-1)*INCX+1))
            X((I-1)*INCX+1)=DCMPLX(C*(G*VR+UR)-VR,C*(G*VC+UC)-VC)
            Y((I-1)*INCY+1)=DCMPLX(C*(-G*UR+VR)+UR,C*(-G*UC+VC)+UC)
         ENDDO
      ENDIF
  
      RETURN
  
      END SUBROUTINE ZDROTW

      SUBROUTINE ZDROT2(N,X,INCX,Y,INCY,CS,SN)
      
      IMPLICIT NONE
      DOUBLE PRECISION ZERO, ONE
      PARAMETER (ONE = 1.0D0, ZERO = 0.0D0)
      INTEGER N,INCX,INCY
      DOUBLE PRECISION CS,SN,T,CSX,SNX
      COMPLEX*16 X(*),Y(*)
      EXTERNAL DFMA0
      DOUBLE PRECISION DFMA0
      
      IF (CS .GE. ABS(SN)) THEN
         
         T = SN/(ONE+CS)
         CSX = DFMA0(-SN,T,ONE)
         
         IF (CSX .NE. ONE .OR. SN .NE. ZERO) THEN
            CALL ZDROTU (N, X, INCX, Y, INCY, T, SN)
         ENDIF
         
      ELSE IF(SN .GE. ZERO) THEN
         
         T = CS/(ONE+SN)
         SNX = DFMA0(-CS,T,ONE)
         
         IF (CS .NE. ONE .OR. SNX .NE. ZERO) THEN
            CALL ZDROTV (N, X, INCX, Y, INCY, CS, T)
         ENDIF
         
      ELSE IF(SN .LE. ZERO) THEN
         
         T = CS/(ONE-SN)
         SNX = DFMA0(CS,T,-ONE)
         
         IF (CS .NE. ONE .OR. SNX .NE. ZERO) THEN
            CALL ZDROTW (N, X, INCX, Y, INCY, CS, T)
         ENDIF
         
      ENDIF
      
      RETURN
      
      END SUBROUTINE ZDROT2