SUBROUTINE DROTU(N, X, INCX, Y, INCY, F, S) IMPLICIT NONE INTEGER I,N,INCX,INCY DOUBLE PRECISION 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 DROTU SUBROUTINE DROTX(N, X, INCX, Y, INCY, F, S) IMPLICIT NONE INTEGER I,N,INCX,INCY DOUBLE PRECISION 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 DROTX SUBROUTINE DROTV(N, X, INCX, Y, INCY, C, G) IMPLICIT NONE INTEGER I,N,INCX,INCY DOUBLE PRECISION 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 DROTV SUBROUTINE DROTW(N, X, INCX, Y, INCY, C, G) IMPLICIT NONE INTEGER I,N,INCX,INCY DOUBLE PRECISION 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 DROTW SUBROUTINE DROT2(N,X,INCX,Y,INCY,CS,SN) IMPLICIT NONE DOUBLE PRECISION ZERO, ONE PARAMETER (ONE = 1.0E0, ZERO = 0.0E0) INTEGER N,INCX,INCY DOUBLE PRECISION X(*),Y(*),CS,SN,T,CSX,SNX 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 DROTU (N, X, INCX, Y, INCY, T, SN) ENDIF ELSE IF (-CS .GE. ABS(SN)) THEN T = SN/(ONE-CS) CSX = DFMA0(SN,T,-ONE) CALL DROTX (N, X, INCX, Y, INCY, T, SN) ELSE IF(SN .GE. ZERO) THEN T = CS/(ONE+SN) SNX = DFMA0(-CS,T,ONE) CALL DROTV (N, X, INCX, Y, INCY, CS, T) ELSE IF(SN .LE. ZERO) THEN T = CS/(ONE-SN) SNX = DFMA0(CS,T,-ONE) CALL DROTW (N, X, INCX, Y, INCY, CS, T) ENDIF RETURN END SUBROUTINE DROT2