C$TEST LRPG
C TO RUN AS A MAIN PROGRAM REMOVE NEXT LINE
      SUBROUTINE LRPG
C***********************************************************************
C
C  SECOND EXAMPLE OF USE OF THE PORT PROGRAM LINPA
C
C***********************************************************************
        REAL X(30), C(30), B(29), SIMP(31), U(30)
        INTEGER ISIMP(31), IPTG(30)
        EXTERNAL LPRNT,AMAN
        COMMON /CSTAK/DSTAK
        DOUBLE PRECISION DSTAK(2000)
C
C  GET WORK SPACE FROM THE STACK
C
        CALL ISTKIN(2000,4)
        N=30
        M=29
        IE=0
        IS=31
C
C SET UP RIGHT HAND SIDE
C
        DO 10 I =1,M
           B(I) = FLOAT(I)/10.0
  10    CONTINUE
C
C SET UP INITIAL GUESS, OBJECTIVE FUNCTION AND SIMPLE CONSTRAINTS
C
       SIGN=-1.0
       DO 20 I=1,N
          X(I)=3.0*FLOAT(I)
          C(I)=SIGN*FLOAT(I)
          SIGN=-SIGN
          ISIMP(I)=I
          SIMP(I)=FLOAT(I)
  20   CONTINUE
       ISIMP(N+1)=-N
       SIMP(N+1)=3.0*FLOAT(N)
C
C SOLVE THE PROBLEM AND PRINT OUT THE RESULTS
C
       CALL LINPA(A,M,N,AMAN,IA,B,C,X,100,CTX,IS,SIMP,ISIMP,IE,
     1 LPRNT,IAG,IAS,IPTG,U)
       IWRITE=I1MACH(2)
       WRITE(IWRITE,21)(X(I),I=1,N)
  21   FORMAT(10H SOLUTION ,5E15.5)
C
       IF(IAG .GT. 1)WRITE(IWRITE,22)(IPTG(I),I=1,IAG)
  22   FORMAT( 28H ACTIVE GENERAL CONSTRAINTS ,15I3)
C
       IF (IAS .EQ. 0)STOP
       DO 30 I=1,IAS
          IP=IABS(ISIMP(I))
          WRITE(IWRITE,23)IP
  23      FORMAT(12H BOUND ON X(,I2,11H) IS ACTIVE)
  30   CONTINUE
       STOP
       END
       SUBROUTINE AMAN(L,A,IA,N,I,TVEC,T)
       LOGICAL L
       REAL TVEC(N)
       IF (L) GOTO 20
C
C THE ITH ROW IS REQUESTED
C
       DO 10 J=1,N
          TVEC(J)=0.0
  10   CONTINUE
       TVEC(I+1)=1.0
       TVEC(I)=-1.0
       RETURN
C
C THIS IS INNERPRODUCT REQUEST
C
  20   T=TVEC(I+1)-TVEC(I)
       RETURN
       END