    PROGRAM e04mgae

!      E04MGA Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : e04mfa, e04mga, e04mha, e04wbf, nag_wp, x04abf, &
                               x04acf, x04baf
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: iset = 1, lcwsav = 1, liwsav = 610,  &
                                          llwsav = 120, lrwsav = 475, nin = 5, &
                                          ninopt = 7, nout = 6
       CHARACTER (*), PARAMETER        :: fname = 'e04mgae.opt'
!      .. Local Scalars ..
       REAL (KIND=nag_wp)              :: obj
       INTEGER                         :: i, ifail, inform, iter, j, lda,      &
                                          liwork, lwork, mode, n, nclin,       &
                                          outchn, sda
       CHARACTER (80)                  :: rec
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: a(:,:), ax(:), bl(:), bu(:),         &
                                          clamda(:), cvec(:), work(:), x(:)
       REAL (KIND=nag_wp)              :: rwsav(lrwsav)
       INTEGER, ALLOCATABLE            :: istate(:), iwork(:)
       INTEGER                         :: iwsav(liwsav)
       LOGICAL                         :: lwsav(llwsav)
       CHARACTER (80)                  :: cwsav(lcwsav)
!      .. Intrinsic Functions ..
       INTRINSIC                          max
!      .. Executable Statements ..
       WRITE (rec,*) 'E04MGA Example Program Results'
       CALL x04baf(nout,rec)

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

       READ (nin,*) n, nclin

       liwork = 2*n + 3

!      The minimum LWORK for an LP problem:

       IF (0<nclin .AND. nclin<n) THEN
          lwork = 2*(nclin+1)**2 + 7*n + 5*nclin
       ELSE IF (nclin>=n) THEN
          lwork = 2*n**2 + 7*n + 5*nclin
       ELSE
          lwork = 7*n + 1
       END IF

       lda = max(1,nclin)

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

       ALLOCATE (istate(n+nclin),iwork(liwork),a(lda,sda),bl(n+nclin), &
          bu(n+nclin),cvec(n),x(n),ax(max(1,nclin)),clamda(n+nclin),work(lwork &
          ))

       READ (nin,*) cvec(1:n)
       READ (nin,*) (a(i,1:sda),i=1,nclin)
       READ (nin,*) bl(1:(n+nclin))
       READ (nin,*) bu(1:(n+nclin))
       READ (nin,*) x(1:n)

!      Set the unit number for advisory messages to OUTCHN

       outchn = nout
       CALL x04abf(iset,outchn)

!      Initialise E04MFA using E04WBF

       ifail = 0
       CALL e04wbf('E04MFA',cwsav,lcwsav,lwsav,llwsav,iwsav,liwsav,rwsav, &
          lrwsav,ifail)

!      Set two options using E04MHA

       CALL e04mha(' Check Frequency = 10 ',lwsav,iwsav,rwsav,inform)

       IF (inform==0) THEN

          CALL e04mha(' Infinite Bound Size = 1.0D+25 ',lwsav,iwsav,rwsav, &
             inform)

       END IF

       IF (inform/=0) THEN
          WRITE (rec,99999) 'E04MHA terminated with INFORM = ', inform
          CALL x04baf(nout,rec)
          GO TO 20
       END IF

!      Open the options file for reading

       mode = 0

       ifail = 0
       CALL x04acf(ninopt,fname,mode,ifail)

!      Read the options file for the remaining options

       CALL e04mga(ninopt,lwsav,iwsav,rwsav,inform)

       IF (inform/=0) THEN
          WRITE (rec,99999) 'E04MGA terminated with INFORM = ', inform
          CALL x04baf(nout,rec)
          GO TO 20
       END IF

!      Solve the problem

       ifail = -1
       CALL e04mfa(n,nclin,a,lda,bl,bu,cvec,istate,x,iter,obj,ax,clamda,iwork, &
          liwork,work,lwork,lwsav,iwsav,rwsav,ifail)

       SELECT CASE (ifail)
       CASE (0:5,7:)
          WRITE (rec,'()')
          CALL x04baf(nout,rec)
          WRITE (rec,99998)
          CALL x04baf(nout,rec)
          WRITE (rec,'()')
          CALL x04baf(nout,rec)

          DO i = 1, n
             WRITE (rec,99997) i, istate(i), x(i), clamda(i)
             CALL x04baf(nout,rec)
          END DO

          IF (nclin>0) THEN
             WRITE (rec,'()')
             CALL x04baf(nout,rec)
             WRITE (rec,'()')
             CALL x04baf(nout,rec)
             WRITE (rec,99996)
             CALL x04baf(nout,rec)
             WRITE (rec,'()')
             CALL x04baf(nout,rec)

             DO i = n + 1, n + nclin
                j = i - n
                WRITE (rec,99995) j, istate(i), ax(j), clamda(i)
                CALL x04baf(nout,rec)
             END DO
          END IF

          WRITE (rec,'()')
          CALL x04baf(nout,rec)
          WRITE (rec,'()')
          CALL x04baf(nout,rec)
          WRITE (rec,99994) obj
          CALL x04baf(nout,rec)
          WRITE (rec,'()')
          CALL x04baf(nout,rec)
          WRITE (rec,'()')
          CALL x04baf(nout,rec)
          WRITE (rec,99993) iter
          CALL x04baf(nout,rec)
       END SELECT

20     CONTINUE

99999  FORMAT (1X,A,I5)
99998  FORMAT (1X,'Varbl',2X,'Istate',3X,'Value',8X,'Lagr Mult')
99997  FORMAT (1X,'V',2(1X,I3),2X,1P,G14.6,2X,1P,G12.4)
99996  FORMAT (1X,'L Con',2X,'Istate',3X,'Value',8X,'Lagr Mult')
99995  FORMAT (1X,'L',2(1X,I3),2X,1P,G14.6,2X,1P,G12.4)
99994  FORMAT (1X,'Final objective value = ',G15.7)
99993  FORMAT (1X,'Exit from problem after',1X,I6,1X,'iterations.')
    END PROGRAM e04mgae
