PROGRAM e04uffe

!      E04UFF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : e04uff, nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: nin = 5, nout = 6
!      .. Local Scalars ..
       REAL (KIND=nag_wp)              :: objf
       INTEGER                         :: i, ifail, irevcm, iter, lda, ldcj,   &
                                          ldr, liwork, lwork, n, nclin, ncnln, &
                                          sda, sdcjac
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: a(:,:), bl(:), bu(:), c(:),          &
                                          cjac(:,:), clamda(:), objgrd(:),     &
                                          r(:,:), work(:), x(:)
       INTEGER, ALLOCATABLE            :: istate(:), iwork(:), needc(:)
!      .. Intrinsic Functions ..
       INTRINSIC                          max
!      .. Executable Statements ..
       WRITE (nout,*) 'E04UFF Example Program Results'
       FLUSH (nout)

!      Skip heading in data file.
       READ (nin,*)

       READ (nin,*) n, nclin, ncnln
       liwork = 3*n + nclin + 2*ncnln
       lda = max(1,nclin)

       IF (nclin>0) THEN
          sda = n
       ELSE
          sda = 1
       END IF

       ldcj = max(1,ncnln)

       IF (ncnln>0) THEN
          sdcjac = n
       ELSE
          sdcjac = 1
       END IF

       ldr = n

       IF (ncnln==0 .AND. nclin>0) THEN
          lwork = 2*n**2 + 21*n + 11*nclin + 2
       ELSE IF (ncnln>0 .AND. nclin>=0) THEN
          lwork = 2*n**2 + n*nclin + 2*n*ncnln + 21*n + 11*nclin + 22*ncnln + &
             1
       ELSE
          lwork = 21*n + 2
       END IF

       ALLOCATE (istate(n+nclin+ncnln),iwork(liwork),a(lda,sda), &
          bl(n+nclin+ncnln),bu(n+nclin+ncnln),c(max(1, &
          ncnln)),cjac(ldcj,sdcjac),clamda(n+nclin+ncnln),objgrd(n),r(ldr,n), &
          x(n),work(lwork),needc(max(1,ncnln)))

       IF (nclin>0) THEN
          READ (nin,*) (a(i,1:n),i=1,nclin)
       END IF

       READ (nin,*) bl(1:(n+nclin+ncnln))
       READ (nin,*) bu(1:(n+nclin+ncnln))
       READ (nin,*) x(1:n)

!      Set all constraint Jacobian elements to zero.
!      Note that this will only work when 'Derivative Level = 3'
!      (the default; see Section 11.2).

       cjac(1:ncnln,1:n) = 0.0E0_nag_wp

!      Solve the problem.

       irevcm = 0
       ifail = 0

REVCOMM: DO

          CALL e04uff(irevcm,n,nclin,ncnln,lda,ldcj,ldr,a,bl,bu,iter,istate,c, &
             cjac,clamda,objf,objgrd,r,x,needc,iwork,liwork,work,lwork,ifail)

!         On intermediate exit IFAIL should not have been changed
!         and IREVCM should be > 0.

          IF (irevcm==0) THEN
             EXIT REVCOMM
          END IF

          IF (irevcm==1 .OR. irevcm==3) THEN

!            Evaluate the objective function.

             objf = x(1)*x(4)*(x(1)+x(2)+x(3)) + x(3)
          END IF

          IF (irevcm==2 .OR. irevcm==3) THEN

!            Evaluate the objective gradient.

             objgrd(1) = x(4)*(2.0E0_nag_wp*x(1)+x(2)+x(3))
             objgrd(2) = x(1)*x(4)
             objgrd(3) = x(1)*x(4) + 1.0E0_nag_wp
             objgrd(4) = x(1)*(x(1)+x(2)+x(3))
          END IF

          IF (irevcm==4 .OR. irevcm==6) THEN

!            Evaluate the nonlinear constraint functions.

             IF (needc(1)>0) THEN
                c(1) = x(1)**2 + x(2)**2 + x(3)**2 + x(4)**2
             END IF

             IF (needc(2)>0) THEN
                c(2) = x(1)*x(2)*x(3)*x(4)
             END IF

          END IF

          IF (irevcm==5 .OR. irevcm==6) THEN

!            Evaluate the constraint Jacobian.

             IF (needc(1)>0) THEN
                cjac(1,1) = 2.0E0_nag_wp*x(1)
                cjac(1,2) = 2.0E0_nag_wp*x(2)
                cjac(1,3) = 2.0E0_nag_wp*x(3)
                cjac(1,4) = 2.0E0_nag_wp*x(4)
             END IF

             IF (needc(2)>0) THEN
                cjac(2,1) = x(2)*x(3)*x(4)
                cjac(2,2) = x(1)*x(3)*x(4)
                cjac(2,3) = x(1)*x(2)*x(4)
                cjac(2,4) = x(1)*x(2)*x(3)
             END IF

          END IF

       END DO REVCOMM

    END PROGRAM e04uffe