C$TEST LRPF
C TO RUN AS A MAIN PROGRAM REMOVE NEXT LINE
      SUBROUTINE LRPF
C***********************************************************************
C
C  EXAMPLE OF USE OF THE PORT PROGRAM FEASA
C
C***********************************************************************
       REAL X(4),B(5),A(5,4),SIMP(8)
       EXTERNAL LPMAN, FPRNT
       INTEGER ISIMP(8), IPTG(10)
       DATA B(1)/5.0/,B(2)/9.0/,B(3)/9.0/,B(4)/1.0/,B(5)/-5.0/
       N=4
       IA=5
       M=5
       IE=2
       IWRITE=I1MACH(2)
C
C SET UP GENERAL CONSTRAINTS
C
       DO 10 J=1,N
          A(1,J)=FLOAT(J)
          A(2,J)=FLOAT(J+1)
          A(3,J)=FLOAT(J*J)
          A(4,J)=0.0
          A(5,J)=0.0
  10   CONTINUE
       A(4,1)=1.0
       A(4,2)=1.0
       A(5,2)=-1.0
       A(5,4)=-1.0
C
C SET UP SIMPLE CONSTRAINTS
C
      IS=8
      DO 20 I=1,N
         SIMP(I)=FLOAT(-I)
         ISIMP(I)=I
         SIMP(I+N)=FLOAT(I+2)
         ISIMP(I+N)=-I
  20   CONTINUE
C
C SET UP INITIAL GUESS
C
      DO 30 I=1,N
         X(I)=1.0
  30  CONTINUE
C
C CALL FEASIBLE POINT ALGORITHM
C
      CALL FEASA(A,M,N,LPMAN,IA,B,X,15,IS,SIMP,ISIMP,IE,
     1 FPRNT,IAG,IAS,IPTG)
      WRITE(IWRITE,31)(X(I),I=1,N)
 31   FORMAT(11H SOLUTION: ,4E15.6)
C
C CHECK ANSWER
C
      DO 40 I=1,M
         S = SDOT(N, A(I,1), IA, X, 1) -B(I)
         WRITE(IWRITE,41)I, S
 40   CONTINUE
 41   FORMAT(28H THE RESIDUAL AT CONSTRAINT ,I4,4H IS ,E15.5)
      STOP
      END
       SUBROUTINE FPRNT(A,M,N,AMAN,IA,B,C,X,CTX,IS,SIMP,ISIMP,IE,
     1 ITER,IPTG,IAG,IAS,U,IEND,IPHAS)
C
C THIS IS A PRINT ROUTINE
C
       REAL CTX,A(1),X(N),B(1)
       LOGICAL IEND
       EXTERNAL AMAN
       INTEGER IA(1),IPTG(N),ISIMP(1),S
       REAL SIMP(1),C(1),U(1)
       IEND = .FALSE.
       IWRITE=I1MACH(2)
       IAGPE=IAG+IE
       WRITE(IWRITE,1)ITER,IAGPE,IAS
  1    FORMAT(/14H AT ITERATION ,I5,
     1  /18H NO.OF ACT. GEN.= ,I5,15H NO.OF ACT.SIM= I5)
       WRITE(IWRITE,2)(X(I),I=1,N)
 2     FORMAT(3H X ,5E15.5)
       DO 10 I=1,M
          CALL AMAN(.TRUE.,A,IA,N,I,X,TOUT)
          TOUT=TOUT-B(I)
          WRITE(IWRITE,9)I,TOUT
  9       FORMAT(15H AT CONSTRAINT ,I5,11H RESIDUAL= ,E15.5)
 10    CONTINUE
       IF (IAGPE.EQ.0)GO TO 12
       WRITE(IWRITE,11)(IPTG(I),I=1,IAGPE)
 11    FORMAT(29H  ACTIVE GENERAL CONSTRAINTS ,10I4)
 12    IF (IAS.LT.1)RETURN
       DO 15 I=1,IAS
          IP=IABS(ISIMP(I))
          IF (ISIMP(I).GT.0)WRITE(IWRITE,13)IP
 13       FORMAT(18H LOWER BOUND ON X(,I2,11H) IS ACTIVE)
          IF (ISIMP(I).LT.0)WRITE(IWRITE,14)IP
 14       FORMAT(18H UPPER BOUND ON X(,I2,11H) IS ACTIVE)
 15    CONTINUE
       RETURN
       END
