C
C EXAMPLE MAIN PROGRAM FOR CALLING OPALQP90
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION X(4),F(4),G(10),U(10),R(10),IVSET(10),EPS(11)
      DIMENSION A(10,4),H(4,4),Q(100)
      COMMON/DEVICE/IOC
      DATA N,M,ME/4,10,1/
      DATA X/1.0D0,5.0D0,5.0D0,1.0D0/
      DATA R/10*0.1D0/
C
      IOC=6
      WRITE(IOC,1011)
      READ(5,1021) IPRINT,IMAX,SCALE,EP
      DO 1200 I=1,N
        DO 1100 J=1,N
1100      H(I,J)=0.0D0
1200    H(I,I)=1.0D0
      DO 1300 I=1,M+1
1300    EPS(I)=EP
      CALL OPALQP(N,M,ME,X,FF,F,H,G,A,U,IV,IVSET,R,SCALE,
     1	         EPS,IPRINT,IMAX,Q)
      STOP
1011  FORMAT('  IPRINT,IMAX,SCALE,EPS ?   ')
1021  FORMAT(2I10,2F20.10)  
      END
C
C SUBROUTINE CALFUN TO COMPUTE FUNCTION
C CONSTRAINTS AND THEIR DERIVATIVES FOR PROBLEM (4)
C
      Subroutine Calfun(x,n,m,ff,g,f,A)
      Implicit Double Precision(A-H, O-Z)
      Integer, Intent(in) :: n,m
      Real (Kind(1.0d0)), Intent(in) :: x(n)
      Real (Kind(1.0d0)), Intent(out) :: ff, g(m)
      Real (Kind(1.0d0)), Optional, Intent(out) :: f(n), A(m,n)

      FF=X(1)*X(4)*(X(1)+X(2)+X(3))+X(3)
      G(1)=X(1)**2+X(2)**2+X(3)**2+X(4)**2-40.0D0
      G(2)=X(1)*X(2)*X(3)*X(4)-25.0D0
      DO 1100 I=1,4
        G(I+2)=X(I)-1.0D0
        G(I+6)=5.0D0-X(I)
1100  CONTINUE
      If (Present(A)) then

        F(1)=X(4)*(2.0D0*X(1)+X(2)+X(3))
        F(2)=X(1)*X(4)
        F(3)=F(2)+1.0D0
        F(4)=X(1)*(X(1)+X(2)+X(3))
        DO 1101 I=1,4
          A(1,I)=2.0D0*X(I)
1101    CONTINUE
        A(2,1)=X(2)*X(3)*X(4)
        A(2,2)=X(3)*X(4)*X(1)
        A(2,3)=X(4)*X(1)*X(2)
        A(2,4)=X(1)*X(2)*X(3)
        DO 1200 I=1,4
          A(I+2,I)=1.0D0
          A(I+6,I)=-1.0D0
1200    CONTINUE
      End if
      RETURN
      END