Program e04ndae

!     E04NDA Example Program Text

!     Mark 30.3 Release. nAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: dgemv, e04nca, e04nda, e04nea, e04wbf, nag_wp,    &
                             x04abf, x04acf, x04baf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Real (Kind=nag_wp), Parameter    :: one = 1.0_nag_wp
      Real (Kind=nag_wp), Parameter    :: zero = 0.0_nag_wp
      Integer, Parameter               :: inc1 = 1, iset = 1, lcwsav = 1,      &
                                          liwsav = 610, llwsav = 120,          &
                                          lrwsav = 475, nin = 5, ninopt = 7,   &
                                          nout = 6
      Character (*), Parameter         :: fname = 'e04ndae.opt'
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: obj
      Integer                          :: i, ifail, inform, iter, j, lda, ldc, &
                                          liwork, lwork, m, mode, n, nclin,    &
                                          outchn, sdc
      Character (80)                   :: rec
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: a(:,:), b(:), bl(:), bu(:), c(:,:),  &
                                          clamda(:), cvec(:), work(:), x(:)
      Real (Kind=nag_wp)               :: rwsav(lrwsav)
      Integer, Allocatable             :: istate(:), iwork(:), kx(:)
      Integer                          :: iwsav(liwsav)
      Logical                          :: lwsav(llwsav)
      Character (80)                   :: cwsav(lcwsav)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: max
!     .. Executable Statements ..
      Write (rec,99993) 'E04NDA Example Program Results'
      Call x04baf(nout,rec)

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

      Read (nin,*) m, n, nclin
      liwork = n
      ldc = max(1,nclin)
      lda = max(1,m)

      If (nclin>0) Then
        sdc = n
      Else
        sdc = 1
      End If

!     This particular example problem is of type QP2, so we allocate
!     A(LDA,N), CVEC(N), B(1) and define LWORK as below

      If (nclin>0) Then
        lwork = 2*n**2 + 10*n + 6*nclin
      Else
        lwork = 10*n
      End If

      Allocate (istate(n+nclin),kx(n),iwork(liwork),c(ldc,sdc),bl(n+nclin),    &
        bu(n+nclin),cvec(n),x(n),a(lda,n),b(1),clamda(n+nclin),work(lwork))

      Read (nin,*) cvec(1:n)
      Read (nin,*)(a(i,1:n),i=1,m)
      Read (nin,*)(c(i,1:sdc),i=1,nclin)
      Read (nin,*) bl(1:(n+nclin))
      Read (nin,*)
      Read (nin,*) bu(1:(n+nclin))
      Read (nin,*)
      Read (nin,*) x(1:n)

!     Set the unit number for advisory messages to OUTCHN

      outchn = nout
      Call x04abf(iset,outchn)

!     Initialise E04NCA

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

!     Set one option using E04NEA

      Call e04nea(' Problem Type = QP2 ',lwsav,iwsav,rwsav,inform)

      If (inform/=0) Then
        Write (rec,99999) ' ** E04NEA 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 e04nda(ninopt,lwsav,iwsav,rwsav,inform)

      If (inform/=0) Then
        Write (rec,99999) ' ** E04NDA terminated with INFORM =', inform
        Call x04baf(nout,rec)
        Go To 100
      End If

!     Solve the problem

      ifail = -1
      Call e04nca(m,n,nclin,ldc,lda,c,bl,bu,cvec,istate,kx,x,a,b,iter,obj,     &
        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

!         C*x --> work.
!         The NAG name equivalent of dgemv is f06paf
          Call dgemv('N',nclin,n,one,c,ldc,x,inc1,zero,work,inc1)

          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), work(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)
      End Select

100   Continue

99999 Format (1X,A,I5)
99998 Format (1X,'Varbl',2X,'Istate',3X,'Value',9X,'Lagr Mult')
99997 Format (1X,'V',2(1X,I3),4X,1P,G14.6,2X,1P,G12.4)
99996 Format (1X,'L Con',2X,'Istate',3X,'Value',9X,'Lagr Mult')
99995 Format (1X,'L',2(1X,I3),4X,1P,G14.6,2X,1P,G12.4)
99994 Format (1X,'Final objective value = ',G15.7)
99993 Format (1X,A)
    End Program e04ndae