*     E04UGF Example Program Text.
*     Mark 20 Revised. NAG Copyright 2001.
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          IDUMMY
      PARAMETER        (IDUMMY=-11111)
      INTEGER          MMAX, NMAX, NNZMAX, LENIZ, LENZ
      PARAMETER        (MMAX=100,NMAX=100,NNZMAX=300,LENIZ=5000,
     +                 LENZ=5000)
*     .. Local Scalars ..
      DOUBLE PRECISION OBJ, SINF
      INTEGER          I, ICOL, IFAIL, IOBJ, J, JCOL, M, MINIZ, MINZ, N,
     +                 NCNLN, NINF, NJNLN, NNAME, NNZ, NONLN, NS
      CHARACTER        START
*     .. Local Arrays ..
      DOUBLE PRECISION A(NNZMAX), BL(NMAX+MMAX), BU(NMAX+MMAX),
     +                 CLAMDA(NMAX+MMAX), USER(1), XS(NMAX+MMAX),
     +                 Z(LENZ)
      INTEGER          HA(NNZMAX), ISTATE(NMAX+MMAX), IUSER(1),
     +                 IZ(LENIZ), KA(NMAX+1)
      CHARACTER*8      NAMES(NMAX+MMAX)
*     .. External Subroutines ..
      EXTERNAL         CONFUN, E04UGF, OBJFUN
*     .. Executable Statements ..
      WRITE (NOUT,*) 'E04UGF Example Program Results'
*     Skip heading in data file.
      READ (NIN,*)
      READ (NIN,*) N, M
      IF (N.LE.NMAX .AND. M.LE.MMAX) THEN
*
*        Read NCNLN, NONLN and NJNLN from data file.
*
         READ (NIN,*) NCNLN, NONLN, NJNLN
*
*        Read NNZ, IOBJ, START, NNAME and NAMES from data file.
*
         READ (NIN,*) NNZ, IOBJ, START, NNAME
         IF (NNAME.EQ.N+M) READ (NIN,*) (NAMES(I),I=1,N+M)
*
*        Initialize KA.
*
         DO 20 I = 1, N + 1
            KA(I) = IDUMMY
   20    CONTINUE
*
*        Read the matrix A from data file. Set up KA.
*
         JCOL = 1
         KA(JCOL) = 1
         DO 60 I = 1, NNZ
*
*           Element ( HA( I ), ICOL ) is stored in A( I ).
*
            READ (NIN,*) A(I), HA(I), ICOL
*
            IF (ICOL.LT.JCOL) THEN
*
*              Elements not ordered by increasing column index.
*
               WRITE (NOUT,99999) 'Element in column', ICOL,
     +           ' found after element in column', JCOL, '. Problem',
     +           ' abandoned.'
               STOP
            ELSE IF (ICOL.EQ.JCOL+1) THEN
*
*              Index in A of the start of the ICOL-th column equals I.
*
               KA(ICOL) = I
               JCOL = ICOL
            ELSE IF (ICOL.GT.JCOL+1) THEN
*
*              Index in A of the start of the ICOL-th column equals I,
*              but columns JCOL+1,JCOL+2,...,ICOL-1 are empty. Set the
*              corresponding elements of KA to I.
*
               DO 40 J = JCOL + 1, ICOL - 1
                  KA(J) = I
   40          CONTINUE
               KA(ICOL) = I
               JCOL = ICOL
            END IF
   60    CONTINUE
*
         KA(N+1) = NNZ + 1
*
         IF (N.GT.ICOL) THEN
*
*           Columns N,N-1,...,ICOL+1 are empty. Set the corresponding
*           elements of KA accordingly.
*
            DO 80 I = N, ICOL + 1, -1
               IF (KA(I).EQ.IDUMMY) KA(I) = KA(I+1)
   80       CONTINUE
         END IF
*
*        Read BL, BU, ISTATE, XS and CLAMDA from data file.
*
         READ (NIN,*) (BL(I),I=1,N+M)
         READ (NIN,*) (BU(I),I=1,N+M)
         IF (START.EQ.'C') THEN
            READ (NIN,*) (ISTATE(I),I=1,N)
         ELSE IF (START.EQ.'W') THEN
            READ (NIN,*) (ISTATE(I),I=1,N+M)
         END IF
         READ (NIN,*) (XS(I),I=1,N)
         IF (NCNLN.GT.0) READ (NIN,*) (CLAMDA(I),I=N+1,N+NCNLN)
*
*        Solve the problem.
*
         IFAIL = -1
*
         CALL E04UGF(CONFUN,OBJFUN,N,M,NCNLN,NONLN,NJNLN,IOBJ,NNZ,A,HA,
     +               KA,BL,BU,START,NNAME,NAMES,NS,XS,ISTATE,CLAMDA,
     +               MINIZ,MINZ,NINF,SINF,OBJ,IZ,LENIZ,Z,LENZ,IUSER,
     +               USER,IFAIL)
*
      END IF
*
      STOP
*
99999 FORMAT (/1X,A,I5,A,I5,A,A)
      END
*
      SUBROUTINE CONFUN(MODE,NCNLN,NJNLN,NNZJAC,X,F,FJAC,NSTATE,IUSER,
     +                  USER)
*     Computes the nonlinear constraint functions and their Jacobian.
*     .. Scalar Arguments ..
      INTEGER           MODE, NCNLN, NJNLN, NNZJAC, NSTATE
*     .. Array Arguments ..
      DOUBLE PRECISION  F(NCNLN), FJAC(NNZJAC), USER(*), X(NJNLN)
      INTEGER           IUSER(*)
*     .. Intrinsic Functions ..
      INTRINSIC         COS, SIN
*     .. Executable Statements ..
*
      IF (MODE.EQ.0 .OR. MODE.EQ.2) THEN
         F(1) = 1000.0D+0*SIN(-X(1)-0.25D+0) + 1000.0D+0*SIN(-X(2)
     +          -0.25D+0)
         F(2) = 1000.0D+0*SIN(X(1)-0.25D+0) + 1000.0D+0*SIN(X(1)-X(2)
     +          -0.25D+0)
         F(3) = 1000.0D+0*SIN(X(2)-X(1)-0.25D+0) + 1000.0D+0*SIN(X(2)
     +          -0.25D+0)
      END IF
*
      IF (MODE.EQ.1 .OR. MODE.EQ.2) THEN
*
*        Nonlinear Jacobian elements for column 1.
*
         FJAC(1) = -1000.0D+0*COS(-X(1)-0.25D+0)
         FJAC(2) = 1000.0D+0*COS(X(1)-0.25D+0) + 1000.0D+0*COS(X(1)-X(2)
     +             -0.25D+0)
         FJAC(3) = -1000.0D+0*COS(X(2)-X(1)-0.25D+0)
*
*        Nonlinear Jacobian elements for column 2.
*
         FJAC(4) = -1000.0D+0*COS(-X(2)-0.25D+0)
         FJAC(5) = -1000.0D+0*COS(X(1)-X(2)-0.25D+0)
         FJAC(6) = 1000.0D+0*COS(X(2)-X(1)-0.25D+0) + 1000.0D+0*COS(X(2)
     +             -0.25D+0)
      END IF
*
      END
*
      SUBROUTINE OBJFUN(MODE,NONLN,X,OBJF,OBJGRD,NSTATE,IUSER,USER)
*     Computes the nonlinear part of the objective function and its
*     gradient
*     .. Scalar Arguments ..
      DOUBLE PRECISION  OBJF
      INTEGER           MODE, NONLN, NSTATE
*     .. Array Arguments ..
      DOUBLE PRECISION  OBJGRD(NONLN), USER(*), X(NONLN)
      INTEGER           IUSER(*)
*     .. Executable Statements ..
*
      IF (MODE.EQ.0 .OR. MODE.EQ.2) OBJF = 1.0D-6*X(3)**3 + 2.0D-6*X(4)
     +    **3/3.0D+0
*
      IF (MODE.EQ.1 .OR. MODE.EQ.2) THEN
         OBJGRD(1) = 0.0D+0
         OBJGRD(2) = 0.0D+0
         OBJGRD(3) = 3.0D-6*X(3)**2
         OBJGRD(4) = 2.0D-6*X(4)**2
      END IF
*
      END