Program e04ryfe

!     E04RYF Example Program Text

!     Demonstrate the life-cycle of a handle of a typical BMI-SDP problem
!     by printing the evolution of the HANDLE in certain stages.

!     Mark 27.1 Release. NAG Copyright 2020.

!     .. Use Statements ..
      Use, Intrinsic                   :: iso_c_binding, Only: c_null_ptr,     &
                                          c_ptr
      Use nag_library, Only: e04raf, e04ref, e04rhf, e04rnf, e04rpf, e04ryf,   &
                             e04rzf, e04svf, e04zmf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: maxnnz = 6, maxnvar = 2, nout = 6
!     .. Local Scalars ..
      Type (c_ptr)                     :: h
      Integer                          :: dima, idblk, ifail, inform, nblk,    &
                                          nnzasum, nvar
!     .. Local Arrays ..
      Real (Kind=nag_wp)               :: a(maxnnz), rdummy(1), rinfo(32),     &
                                          stats(32), x(maxnvar)
      Integer                          :: icola(maxnnz), idummy(1),            &
                                          irowa(maxnnz), nnza(maxnvar+1)
!     .. Executable Statements ..
      Continue

      Write (nout,*) 'E04RYF Example Program Results'
      Write (nout,*)
      Flush (nout)

      h = c_null_ptr

!     Start a problem formulation with 2 variables.
      nvar = 2
      ifail = 0
      Call e04raf(h,nvar,ifail)

!     Anything can be defined at this phase.
      Write (nout,*) 'Freshly created handle'
      Flush (nout)
      ifail = 0
      Call e04ryf(h,nout,'Overview',ifail)

!     Define linear objective (min y).
      ifail = 0
      Call e04ref(h,nvar,(/0.0_nag_wp,1.0_nag_wp/),ifail)

!     Add simple bounds (x>=0, -3<=y<=3).
      ifail = 0
      Call e04rhf(h,nvar,(/0.0_nag_wp,-3.0_nag_wp/),                           &
        (/1E20_nag_wp,3.0_nag_wp/),ifail)

!     The simple bounds and the objective are set and cannot be changed.
      Write (nout,*)
      Write (nout,*)                                                           &
        'Handle after definition of simple bounds and the objective'
      Flush (nout)
      ifail = 0
      Call e04ryf(h,nout,'Overview,Objective,Simple Bounds',ifail)

!     Definition of the first (linear) matrix constraint
!        ( 1   x-1   y )
!        (x-1  3/4   0 )  >= 0
!        ( y    0   16 )
!     only upper triangles, thus we have matrices
!           ( 1  -1  0 )        ( 0  1  0 )       ( 0  0  1 )
!     A0 = -(   3/4  0 ),  A1 = (    0  0 ), A2 = (    0  0 )
!           (       16 )        (       0 )       (       0 )
!     Note: don't forget the minus at A0 term!
      dima = 3
      nnzasum = 6
      nblk = 1
!     A0
      irowa(1:4) = (/1,1,2,3/)
      icola(1:4) = (/1,2,2,3/)
      a(1:4) = (/-1.0_nag_wp,1.0_nag_wp,-0.75_nag_wp,-16.0_nag_wp/)
      nnza(1) = 4
!     A1
      irowa(5:5) = (/1/)
      icola(5:5) = (/2/)
      a(5:5) = (/1.0_nag_wp/)
      nnza(2) = 1
!     A2
      irowa(6:6) = (/1/)
      icola(6:6) = (/3/)
      a(6:6) = (/1.0_nag_wp/)
      nnza(3) = 1

      idblk = 0
      ifail = 0
      Call e04rnf(h,nvar,dima,nnza,nnzasum,irowa,icola,a,nblk,idummy,idblk,    &
        ifail)

!     It is possible to add or extend existing matrix constraints.
      Write (nout,*)
      Write (nout,*) 'Handle after definition of the 1st matrix constraint'
      Flush (nout)
      ifail = 0
      Call e04ryf(h,nout,'Overview,Matrix Constraints',ifail)

!     Definition of the absolute term and linear part of BMI
!        (  x   -xy )
!        (-xy    1  ) >= 0
!     thus
!           ( 0  0 )        ( 1  0 )
!     A0 = -(    1 ),  A1 = (    0 ), A2 = zero
!     Note: don't forget the minus at A0 term!
      dima = 2
      nnzasum = 2
      nblk = 1
!     A0
      irowa(1:1) = (/2/)
      icola(1:1) = (/2/)
      a(1:1) = (/-1.0_nag_wp/)
      nnza(1) = 1
!     A1
      irowa(2:2) = (/1/)
      icola(2:2) = (/1/)
      a(2:2) = (/1.0_nag_wp/)
      nnza(2) = 1
!     A2
      nnza(3) = 0

      idblk = 0
      ifail = 0
      Call e04rnf(h,nvar,dima,nnza,nnzasum,irowa,icola,a,nblk,idummy,idblk,    &
        ifail)

!     It is possible to add or extend existing matrix constraints.
      Write (nout,*)
      Write (nout,*)                                                           &
        'Handle after partial definition of the 2nd matrix constraint'
      Flush (nout)
      ifail = 0
      Call e04ryf(h,nout,'Matrix Constraints',ifail)

!     Extending current matrix constraint (with IDBLK) by bilinear term
!           ( 0  -1 )
!     Q12 = ( 0   0 ).
      dima = 2
      nnzasum = 1
      nnza(1) = 1
      irowa(1:1) = (/1/)
      icola(1:1) = (/2/)
      a(1:1) = (/-1.0_nag_wp/)
      ifail = 0
      Call e04rpf(h,1,(/1/),(/2/),dima,nnza,nnzasum,irowa,icola,a,idblk,ifail)

!     Our problem completely defined.
      Write (nout,*)
      Write (nout,*) 'Handle with the complete problem formulation'
      Flush (nout)
      ifail = 0
      Call e04ryf(h,nout,'Overview,Matrix Constraints,Multipliers Sizes',      &
        ifail)
      ifail = 0
      Call e04ryf(h,nout,'Matrix Constraints Detailed',ifail)

!     Set optional arguments for the solver.
      ifail = 0
      Call e04zmf(h,'Print Options = No',ifail)
      ifail = 0
      Call e04zmf(h,'Initial X = Automatic',ifail)

!     Options can be printed even outside the solver.
      Write (nout,*)
      Flush (nout)
      ifail = 0
      Call e04ryf(h,nout,'Options',ifail)

!     Call the solver.
      ifail = 0
      Call e04svf(h,nvar,x,0,rdummy,0,rdummy,0,rdummy,rinfo,stats,inform,      &
        ifail)

!     After solver finished.
      Write (nout,*)
      Write (nout,*) 'Problem solved'
      Flush (nout)
      ifail = 0
      Call e04ryf(h,nout,'Overview',ifail)

!     Print result.
      Write (nout,*)
      Write (nout,'(1X,A,F9.2)') 'Final objective value = ', rinfo(1)
      Write (nout,'(1X,A,2F9.2)') 'Final X = ', x(1:nvar)

!     release all memory held in the handle
      ifail = 0
      Call e04rzf(h,ifail)

    End Program e04ryfe