Mercurial > hg > octave-lyh
view libcruft/qpsol/elm.f @ 2542:484977eb65ad
[project @ 1996-11-20 02:17:08 by jwe]
author | jwe |
---|---|
date | Wed, 20 Nov 1996 02:18:00 +0000 |
parents | 30c606bec7a8 |
children |
line wrap: on
line source
SUBROUTINE ELM ( ORTHOG, N, X, LENX, INCX, Y, LENY, INCY, * CS, SN ) C LOGICAL ORTHOG INTEGER N, LENX, INCX, LENY, INCY DOUBLE PRECISION CS, SN DOUBLE PRECISION X(LENX), Y(LENY) C C ********************************************************************* C IF ORTHOG IS TRUE, ELM APPLIES A PLANE ROTATION. OTHERWISE, C ELM COMPUTES THE TRANSFORMATION (X Y)*E AND RETURNS THE RESULT C IN (X Y), WHERE THE 2 BY 2 MATRIX E IS DEFINED BY CS AND SN C AS FOLLOWS... C C E = ( 1 SN ) IF CS .GT. ZERO, E = ( 1 ) OTHERWISE. C ( 1 ) ( 1 SN ) C C VERSION 1, APRIL 5 1983. C SYSTEMS OPTIMIZATION LABORATORY, STANFORD UNIVERSITY. C ********************************************************************* C INTEGER I, IX, IY DOUBLE PRECISION XI, YI, ZERO C IF (ORTHOG) GO TO 800 ZERO = 0.0 IF (CS .LE. ZERO) GO TO 200 IF (SN .EQ. ZERO) RETURN CALL AXPY ( N, SN, X, LENX, INCX, Y, LENY, INCY ) RETURN C 200 IX = 1 IY = 1 IF (SN .EQ. ZERO) GO TO 300 C DO 210 I = 1, N XI = X(IX) YI = Y(IY) X(IX) = YI Y(IY) = XI + YI*SN IX = IX + INCX IY = IY + INCY 210 CONTINUE RETURN C C TREAT AN INTERCHANGE SPECIALLY. C 300 DO 310 I = 1, N XI = X(IX) X(IX) = Y(IY) Y(IY) = XI IX = IX + INCX IY = IY + INCY 310 CONTINUE RETURN C C 800 CALL ROT3 ( N, X, LENX, INCX, Y, LENY, INCY, CS, SN ) RETURN C C END OF ELM END