OpenLibm/slatec/splpfl.f

*DECK SPLPFL
      SUBROUTINE SPLPFL (MRELAS, NVARS, IENTER, ILEAVE, IBASIS, IND,
     +   IBB, THETA, DIRNRM, RPRNRM, CSC, WW, BL, BU, ERP, RPRIM,
     +   PRIMAL, FINITE, ZEROLV)
C***BEGIN PROLOGUE  SPLPFL
C***SUBSIDIARY
C***PURPOSE  Subsidiary to SPLP
C***LIBRARY   SLATEC
C***TYPE      SINGLE PRECISION (SPLPFL-S, DPLPFL-D)
C***AUTHOR  (UNKNOWN)
C***DESCRIPTION
C
C     THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO
C     DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES.
C
C     USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/.
C     /REAL (12 BLANKS)/DOUBLE PRECISION/.
C
C     THIS SUBPROGRAM IS PART OF THE SPLP( ) PACKAGE.
C     IT IMPLEMENTS THE PROCEDURE (CHOOSE VARIABLE TO LEAVE BASIS).
C     REVISED 811130-1045
C     REVISED YYMMDD-HHMM
C
C***SEE ALSO  SPLP
C***ROUTINES CALLED  (NONE)
C***REVISION HISTORY  (YYMMDD)
C   811215  DATE WRITTEN
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   890605  Removed unreferenced labels.  (WRB)
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900328  Added TYPE section.  (WRB)
C***END PROLOGUE  SPLPFL
      INTEGER IBASIS(*),IND(*),IBB(*)
      REAL             CSC(*),WW(*),BL(*),BU(*),ERP(*),RPRIM(*),
     * PRIMAL(*),BOUND,DIRNRM,RATIO,RPRNRM,THETA,ZERO
      LOGICAL FINITE,ZEROLV
C***FIRST EXECUTABLE STATEMENT  SPLPFL
      ZERO=0.E0
C
C     SEE IF THE ENTERING VARIABLE IS RESTRICTING THE STEP LENGTH
C     BECAUSE OF AN UPPER BOUND.
      FINITE=.FALSE.
      J=IBASIS(IENTER)
      IF (.NOT.(IND(J).EQ.3)) GO TO 20002
      THETA=BU(J)-BL(J)
      IF(J.LE.NVARS)THETA=THETA/CSC(J)
      FINITE=.TRUE.
      ILEAVE=IENTER
C
C     NOW USE THE BASIC VARIABLES TO POSSIBLY RESTRICT THE STEP
C     LENGTH EVEN FURTHER.
20002 I=1
      N20005=MRELAS
      GO TO 20006
20005 I=I+1
20006 IF ((N20005-I).LT.0) GO TO 20007
      J=IBASIS(I)
C
C     IF THIS IS A FREE VARIABLE, DO NOT USE IT TO
C     RESTRICT THE STEP LENGTH.
      IF (.NOT.(IND(J).EQ.4)) GO TO 20009
      GO TO 20005
C
C     IF DIRECTION COMPONENT IS ABOUT ZERO, IGNORE IT FOR COMPUTING
C     THE STEP LENGTH.
20009 IF (.NOT.(ABS(WW(I)).LE.DIRNRM*ERP(I))) GO TO 20012
      GO TO 20005
20012 IF (.NOT.(WW(I).GT.ZERO)) GO TO 20015
C
C     IF RPRIM(I) IS ESSENTIALLY ZERO, SET RATIO TO ZERO AND EXIT LOOP.
      IF (.NOT.(ABS(RPRIM(I)).LE.RPRNRM*ERP(I))) GO TO 20018
      THETA=ZERO
      ILEAVE=I
      FINITE=.TRUE.
      GO TO 20008
C
C     THE VALUE OF RPRIM(I) WILL DECREASE ONLY TO ITS LOWER BOUND OR
C     ONLY TO ITS UPPER BOUND.  IF IT DECREASES TO ITS
C     UPPER BOUND, THEN RPRIM(I) HAS ALREADY BEEN TRANSLATED
C     TO ITS UPPER BOUND AND NOTHING NEEDS TO BE DONE TO IBB(J).
20018 IF (.NOT.(RPRIM(I).GT.ZERO)) GO TO 10001
      RATIO=RPRIM(I)/WW(I)
      IF (.NOT.(.NOT.FINITE)) GO TO 20021
      ILEAVE=I
      THETA=RATIO
      FINITE=.TRUE.
      GO TO 20022
20021 IF (.NOT.(RATIO.LT.THETA)) GO TO 10002
      ILEAVE=I
      THETA=RATIO
10002 CONTINUE
20022 CONTINUE
      GO TO 20019
C
C     THE VALUE RPRIM(I).LT.ZERO WILL NOT RESTRICT THE STEP.
10001 CONTINUE
C
C     THE DIRECTION COMPONENT IS NEGATIVE, THEREFORE THE VARIABLE WILL
C     INCREASE.
20019 GO TO 20016
C
C     IF THE VARIABLE IS LESS THAN ITS LOWER BOUND, IT CAN
C     INCREASE ONLY TO ITS LOWER BOUND.
20015 IF (.NOT.(PRIMAL(I+NVARS).LT.ZERO)) GO TO 20024
      RATIO=RPRIM(I)/WW(I)
      IF (RATIO.LT.ZERO) RATIO=ZERO
      IF (.NOT.(.NOT.FINITE)) GO TO 20027
      ILEAVE=I
      THETA=RATIO
      FINITE=.TRUE.
      GO TO 20028
20027 IF (.NOT.(RATIO.LT.THETA)) GO TO 10003
      ILEAVE=I
      THETA=RATIO
10003 CONTINUE
20028 CONTINUE
C
C     IF THE BASIC VARIABLE IS FEASIBLE AND IS NOT AT ITS UPPER BOUND,
C     THEN IT CAN INCREASE TO ITS UPPER BOUND.
      GO TO 20025
20024 IF (.NOT.(IND(J).EQ.3 .AND. PRIMAL(I+NVARS).EQ.ZERO)) GO TO 10004
      BOUND=BU(J)-BL(J)
      IF(J.LE.NVARS) BOUND=BOUND/CSC(J)
      RATIO=(BOUND-RPRIM(I))/(-WW(I))
      IF (.NOT.(.NOT.FINITE)) GO TO 20030
      ILEAVE=-I
      THETA=RATIO
      FINITE=.TRUE.
      GO TO 20031
20030 IF (.NOT.(RATIO.LT.THETA)) GO TO 10005
      ILEAVE=-I
      THETA=RATIO
10005 CONTINUE
20031 CONTINUE
      CONTINUE
10004 CONTINUE
20025 CONTINUE
20016 GO TO 20005
20007 CONTINUE
C
C     IF STEP LENGTH IS FINITE, SEE IF STEP LENGTH IS ABOUT ZERO.
20008 IF (.NOT.(FINITE)) GO TO 20033
      ZEROLV=.TRUE.
      I=1
      N20036=MRELAS
      GO TO 20037
20036 I=I+1
20037 IF ((N20036-I).LT.0) GO TO 20038
      ZEROLV=ZEROLV.AND. ABS(THETA*WW(I)).LE.ERP(I)*RPRNRM
      IF (.NOT.(.NOT. ZEROLV)) GO TO 20040
      GO TO 20039
20040 GO TO 20036
20038 CONTINUE
20039 CONTINUE
20033 CONTINUE
      RETURN
      END