Program e04mgae

!     E04MGA Example Program Text

!     Mark 25 Release. NAG Copyright 2014.

!     .. 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 Procedures ..
      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 100
      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 100
      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

100   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