Mercurial > octave
view libcruft/qpsol/lpbgst.f @ 2329:30c606bec7a8
[project @ 1996-07-19 01:29:05 by jwe]
Initial revision
author | jwe |
---|---|
date | Fri, 19 Jul 1996 01:29:55 +0000 |
parents | |
children |
line wrap: on
line source
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C FILE LPSUBS66 FORTRAN C C LPBGST LPCORE LPCRSH LPDUMP LPGRAD LPPRT C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SUBROUTINE LPBGST( N, NACTIV, NCTOTL, NFREE, JBIGST, KBIGST, * ISTATE, KACTIV, * DINKY, FEAMIN, TRULAM, FEATOL, RLAMDA ) C C IMPLICIT REAL*8(A-H,O-Z) INTEGER N, NACTIV, NCTOTL, NFREE, JBIGST, KBIGST INTEGER ISTATE(NCTOTL), KACTIV(N) DOUBLE PRECISION DINKY, FEAMIN, TRULAM DOUBLE PRECISION FEATOL(NCTOTL), RLAMDA(N) C INTEGER NOUT, MSG, ISTART COMMON /SOL1CM/ NOUT, MSG, ISTART C C ********************************************************************* C FIND THE BIGGEST SCALED MULTIPLIER LARGER THAN UNITY. C C SYSTEMS OPTIMIZATION LABORATORY, STANFORD UNIVERSITY. C ORIGINAL VERSION DECEMBER 1982. C ********************************************************************* C INTEGER IS, J, K, NFIXED, NLAM DOUBLE PRECISION BIGGST, RLAM DOUBLE PRECISION ONE DOUBLE PRECISION DABS DATA ONE/1.0D+0/ C JBIGST = 0 NFIXED = N - NFREE NLAM = NFIXED + NACTIV IF (NLAM .EQ. 0) GO TO 900 C BIGGST = ONE + DINKY DO 110 K = 1, NLAM J = KACTIV(K) IF (K .LE. NACTIV) J = J + N IS = ISTATE(J) IF (IS .LT. 1) GO TO 110 RLAM = RLAMDA(K) IF (IS .EQ. 2) RLAM = - RLAM IF (IS .EQ. 3) RLAM = DABS( RLAM ) RLAM = (FEATOL(J)/FEAMIN)*RLAM C IF (BIGGST .GE. RLAM) GO TO 110 BIGGST = RLAM TRULAM = RLAMDA(K) JBIGST = J KBIGST = K 110 CONTINUE IF (MSG .GE. 80) WRITE (NOUT, 9000) JBIGST, BIGGST C 900 RETURN C 9000 FORMAT(/ 33H //LPBGST// JBIGST BIGGST * / 13H //LPBGST// , I5, G15.4 ) C C END OF LPBGST END