Mercurial > hg > octave-nkf
view libcruft/qpsol/lpgrad.f @ 2512:fda09c1e787e
[project @ 1996-11-14 08:39:41 by jwe]
author | jwe |
---|---|
date | Thu, 14 Nov 1996 08:39:47 +0000 |
parents | 30c606bec7a8 |
children |
line wrap: on
line source
SUBROUTINE LPGRAD( LP, N, NCTOTL, NROWA, * BIGBND, FEAMIN, NUMINF, SUMINF, ISTATE, * A, BL, BU, CVEC, FEATOL, GRAD, X ) C C IMPLICIT REAL*8(A-H,O-Z) INTEGER N, NCTOTL, NROWA, NUMINF INTEGER ISTATE(NCTOTL) DOUBLE PRECISION BIGBND, FEAMIN, SUMINF DOUBLE PRECISION A(NROWA,N), BL(NCTOTL), BU(NCTOTL), CVEC(N), * FEATOL(NCTOTL), GRAD(N), X(N) LOGICAL LP C C ********************************************************************* C IF NUMINF .GT. 0, LPGRAD FINDS THE NUMBER AND WEIGHTED SUM OF C INFEASIBILITIES FOR THE BOUNDS AND LINEAR CONSTRAINTS. AN C APPROPRIATE GRADIENT VECTOR IS RETURNED IN GRAD. C IF NUMINF = 0, AND IF AN LP PROBLEM IS BEING SOLVED, GRAD WILL BE C LOADED WITH THE TRUE LINEAR OBJECTIVE. C C POSITIVE VALUES OF ISTATE(J) WILL NOT BE ALTERED. THESE MEAN C THE FOLLOWING... C C 1 2 3 C A*X = BL A*X = BU BL = BU C C OTHER VALUES OF ISTATE(J) WILL BE RESET AS FOLLOWS... C A*X LT BL A*X GT BU A*X FREE C - 2 - 1 0 C C SYSTEMS OPTIMIZATION LABORATORY, STANFORD UNIVERSITY. C VERSION OF SEPTEMBER 1981. REV. OCT. 1982. JAN. 1983. C ********************************************************************* C INTEGER J, K, LROWA DOUBLE PRECISION ATX, FEASJ, S, WEIGHT, ZERO DOUBLE PRECISION DOT DOUBLE PRECISION DABS LOGICAL NOLOW, NOUPP DATA ZERO /0.0D+0/ C LROWA = NROWA*(N - 1) + 1 IF (NUMINF .EQ. 0) GO TO 500 NUMINF = 0 SUMINF = ZERO CALL ZEROVC( N, GRAD, N, 1 ) C DO 200 J = 1, NCTOTL C C DO NOTHING IF THE VARIABLE OR CONSTRAINT IS AT A BOUND. C IF (ISTATE(J) .GT. 0) GO TO 200 FEASJ = FEATOL(J) NOLOW = BL(J) .LE. (- BIGBND) NOUPP = BU(J) .GE. BIGBND K = J - N IF (J .LE. N) ATX = X(J) IF (J .GT. N) ATX = DOT( N, A(K,1), LROWA, NROWA, X, N, 1 ) ISTATE(J) = 0 C C SEE IF THE LOWER BOUND IS VIOLATED. C IF (NOLOW) GO TO 150 S = BL(J) - ATX IF (S .LE. FEASJ) GO TO 150 ISTATE(J) = - 2 WEIGHT = - FEAMIN/FEASJ GO TO 160 C C SEE IF THE UPPER BOUND IS VIOLATED. C 150 IF (NOUPP) GO TO 200 S = ATX - BU(J) IF (S .LE. FEASJ) GO TO 200 ISTATE(J) = - 1 WEIGHT = FEAMIN/FEASJ C C ADD THE INFEASIBILITY. C 160 NUMINF = NUMINF + 1 SUMINF = SUMINF + DABS( WEIGHT ) * S IF (J .LE. N) GRAD(J) = WEIGHT IF (J .GT. N) * CALL AXPY ( N, WEIGHT, A(K,1), LROWA, NROWA, GRAD, N, 1 ) 200 CONTINUE C C IF FEASIBLE, INSTALL TRUE OBJECTIVE. C 500 IF (LP .AND. NUMINF .EQ. 0) *CALL COPYVC( N, CVEC, N, 1, GRAD, N, 1 ) RETURN C C END OF LPGRAD END