/* nag_opt_sparse_convex_qp_option_set_file (e04nrc) Example Program.
 *
 * Copyright 2004 Numerical Algorithms Group.
 *
 * Mark 8, 2004.
 */

#include <stdio.h>
#include <string.h>
#include <nag.h>
#include <nag_stdlib.h>
#include <nage04.h>
#include <nagx04.h>

static void qphx(Integer ncolh, const double x[], double hx[],
                 Integer nstate, Nag_Comm *comm);
int main(void)
{

  /* Scalars */
  double bndinf, featol, obj, objadd, sinf;
  Integer elmode, exit_status, i, icol, iobj, j, jcol, lenc, m, n, ncolh, ne;
  Integer ninf, nname, ns;

  /* Arrays */
  char *cuser=0, *prob=0, start_char[2];
  char **names;
  double *acol=0, *bl=0, *bu=0, *c__=0, *pi=0, *rc=0, *ruser=0, *x=0;
  Integer *helast=0, *hs=0, *inda=0, *iuser=0, *loca=0;

  /*Nag Types*/
  Nag_E04State state;
  Nag_Start start;
  NagError fail;
  Nag_Comm comm;
  Nag_FileID fileid;

  exit_status = 0;
  INIT_FAIL(fail);
  Vprintf("%s", "nag_opt_sparse_convex_qp_option_set_file (e04nrc) Example"
          " Program Results");
  Vprintf("\n");

  /* This program demonstrates the use of routines to set and
   * get values of optional parameters associated with
   * nag_opt_sparse_convex_qp_solve (e04nqc).
   */

  /* Skip heading in data file. */
  Vscanf("%*[^\n] ");


  Vscanf("%ld %ld ", &n, &m);
  Vscanf("%*[^\n] ");

  if (n>=1 && m >= 1)
    {
      /* Read ne, iobj, ncolh, start and nname from data file. */
      Vscanf("%ld %ld %ld  ' %1s ' %ld",
             &ne, &iobj, &ncolh, start_char, &nname);
      Vscanf("%*[^\n] ");

      /* Allocate memory */
      if ( !(names = NAG_ALLOC(n+m, char *)) ||
           !(prob = NAG_ALLOC(9, char)) ||
           !(acol = NAG_ALLOC(ne, double)) ||
           !(bl = NAG_ALLOC(m+n, double)) ||
           !(bu = NAG_ALLOC(m+n, double)) ||
           !(c__ = NAG_ALLOC(1, double)) ||
           !(pi = NAG_ALLOC(m, double)) ||
           !(rc = NAG_ALLOC(n+m, double)) ||
           !(x = NAG_ALLOC(n+m, double)) ||
           !(helast = NAG_ALLOC(n+m, Integer)) ||
           !(hs = NAG_ALLOC(n+m, Integer)) ||
           !(inda = NAG_ALLOC(ne, Integer)) ||
           !(iuser = NAG_ALLOC(1, Integer)) ||
           !(loca = NAG_ALLOC(n+1, Integer)) )
        {
          Vprintf("Allocation failure\n");
          exit_status = -1;
          goto END;
        }
    }
  else
    {
      Vprintf("Invalid n or nf or nea or neg\n");
      exit_status = 1;
      goto END;
    }
  /* Read names from data file. */

  for (i = 1; i <= nname; ++i)
    {
      names[i-1] = NAG_ALLOC(9, char);
      Vscanf(" ' %8s '", names[i-1]);
    }
  Vscanf("%*[^\n] ");


  /* Read the matrix acol from data file. Set up loca. */
  jcol = 1;
  loca[jcol - 1] = 1;
  for (i = 1; i <= ne; ++i)
    {
      /* Element ( inda[i-1], icol ) is stored in acol[i-1]. */

      Vscanf("%lf %ld %ld", &acol[i - 1], &inda[i - 1], &icol);
      Vscanf("%*[^\n] ");

      if (icol < jcol)
        {
          /* Elements not ordered by increasing column index. */
          Vprintf("%s %5ld %s %5ld",
                  "Element in column", icol,
                  " found after element in column", jcol);
          Vprintf("%s\n\n", ". Problem abandoned.");
        }
      else if (icol == jcol + 1)
        {
          /* Index in acol of the start of the icol-th column equals i. */
          loca[icol - 1] = i;
          jcol = icol;
        }
      else if (icol > jcol + 1)
        {
          /* Index in acol of the start of the icol-th column equals i,
           * but columns jcol+1,jcol+2,...,icol-1 are empty. Set the
           * corresponding elements of loca to i.
           */
          for (j = jcol + 1; j <= icol - 1; ++j)
            {
              loca[j - 1] = i;
            }
          loca[icol - 1] = i;
          jcol = icol;
        }
    }
  loca[n] = ne + 1;
  if (n > icol)
    {
      /* Columns n,n-1,...,icol+1 are empty. Set the corresponding */
      /* elements of loca accordingly. */
      for (i = n; i >= icol + 1; --i)
        {
          loca[i - 1] = loca[i];
        }
    }

  /* Read bl, bu, hs and x from data file. */
  for (i = 1; i <= n + m; ++i)
    {
      Vscanf("%lf", &bl[i - 1]);
    }
  Vscanf("%*[^\n] ");

  for (i = 1; i <= n + m; ++i)
    {
      Vscanf("%lf", &bu[i - 1]);
    }
  Vscanf("%*[^\n] ");

  if (*(unsigned char *)start_char == 'C')
    {
      start = Nag_Cold;
      for (i = 1; i <= n; ++i)
        {
          Vscanf("%ld", &hs[i - 1]);
        }
      Vscanf("%*[^\n] ");
    }
  else if (*(unsigned char *)start_char == 'W')
    {
      start = Nag_Warm;
      for (i = 1; i <= n + m; ++i)
        {
          Vscanf("%ld", &hs[i - 1]);

        }
      Vscanf("%*[^\n] ");
    }

  for (i = 1; i <= n; ++i)
    {
      Vscanf("%lf", &x[i - 1]);
    }
  Vscanf("%*[^\n] ");

  /* We have no explicit objective vector so set lenc = 0; the
   * objective vector is stored in row iobj of acol.
   */
  lenc = 0;
  objadd = 0.;
  strcpy(prob, "");

  /* Call nag_opt_sparse_convex_qp_init (e04npc) to initialise e04nqc. */
  /* nag_opt_sparse_convex_qp_init (e04npc).
   * Initialization function for
   * nag_opt_sparse_convex_qp_solve (e04nqc)
   */
  nag_opt_sparse_convex_qp_init(&state, &fail);
  if (fail.code != NE_NOERROR)
    {
      Vprintf("Initialisation of nag_opt_sparse_convex_qp_solve (e04nqc)"
              " failed.\n");
      exit_status = 1;
      goto END;
    }

  /* By default nag_opt_sparse_convex_qp_solve (e04nqc) does not print
   *  monitoring information. Call nag_open_file (x04acc) to set the print file
   *  fileid
   */
  /* nag_open_file (x04acc).
   * Open unit number for reading, writing or appending, and
   * associate unit with named file
   */
  nag_open_file("", 2, &fileid, &fail);
  if (fail.code != NE_NOERROR)
    {
      Vprintf("Fileid could not be obtained.\n");
      exit_status = 1;
      goto END;
    }
  /* nag_opt_sparse_convex_qp_option_set_integer (e04ntc).
   * Set a single option for nag_opt_sparse_convex_qp_solve
   * (e04nqc) from an integer argument
   */
  nag_opt_sparse_convex_qp_option_set_integer("Print file", fileid, &state,
                                              &fail);
  if (fail.code != NE_NOERROR)
    {
      Vprintf("nag_opt_sparse_convex_qp_option_set_integer (e04ntc) failed to"
              " set Print File\n");
      exit_status = 1;
      goto END;
    }
  /* Set input to standard input to read */
  /* nag_open_file (x04acc), see above. */
  nag_open_file("", 0, &fileid, &fail);
  if (fail.code != NE_NOERROR)
    {
      Vprintf("nag_open_file (x04acc) failed to set fileid to read\n");
      exit_status = 1;
      goto END;
    }
  /* Use e04nrf to read some options from the end of the input
     data file.
  */
  /* nag_opt_sparse_convex_qp_option_set_file (e04nrc).
   * Supply optional parameter values for
   * nag_opt_sparse_convex_qp_solve (e04nqc) from external
   * file
   */
  nag_opt_sparse_convex_qp_option_set_file(fileid, &state, &fail);
  if (fail.code != NE_NOERROR)
    {
      Vprintf("nag_opt_sparse_convex_qp_option_set_file (e04nrc) failed to set"
              " read file option\n");
      exit_status = 1;
      goto END;
    }

  Vprintf("\n");

  /* Use nag_opt_sparse_convex_qp_option_get_integer (e04nxc) to find the value
   * of Integer-valued option 'Elastic mode'.
   */
  /* nag_opt_sparse_convex_qp_option_get_integer (e04nxc).
   * Get the setting of an integer valued option of
   * nag_opt_sparse_convex_qp_solve (e04nqc)
   */
  nag_opt_sparse_convex_qp_option_get_integer("Elastic mode", &elmode, &state,
                                              &fail);
  if (fail.code != NE_NOERROR)
    {
      Vprintf("nag_opt_sparse_convex_qp_option_get_integer (e04nxc) failed to"
              " find the value of Elastic mode\n");
      exit_status = 1;
      goto END;
    }
  Vprintf("Option 'Elastic mode' has the value %3ld.\n",   elmode);

  /* Use nag_opt_sparse_convex_qp_option_set_double (e04nuc) to set the value of
   *  real-valued option 'Infinite bound size'.
   */
  bndinf = 1e10;
  /* nag_opt_sparse_convex_qp_option_set_double (e04nuc).
   * Set a single option for nag_opt_sparse_convex_qp_solve
   * (e04nqc) from a double argument
   */
  nag_opt_sparse_convex_qp_option_set_double("Infinite bound size", bndinf,
                                             &state, &fail);
  if (fail.code != NE_NOERROR)
    {
      Vprintf("nag_opt_sparse_convex_qp_option_set_double (e04nuc) failed to"
              " set Infinite bound\n");
      exit_status = 1;
      goto END;
    }

  /* Use nag_opt_sparse_convex_qp_option_get_double (e04nyc) to find the value
   *  of real-valued option 'Feasibility tolerance'.
   */
  /* nag_opt_sparse_convex_qp_option_get_double (e04nyc).
   * Get the setting of a double valued option of
   * nag_opt_sparse_convex_qp_solve (e04nqc)
   */
  nag_opt_sparse_convex_qp_option_get_double("Feasibility tolerance", &featol,
                                             &state, &fail);
  if (fail.code != NE_NOERROR)
    {
      Vprintf("nag_opt_sparse_convex_qp_option_get_double (e04nyc) failed to"
              " find the value of Feasibility tolerance\n");
      exit_status = 1;
      goto END;
    }
  Vprintf("Option 'Feasibility tolerance' has the value %13.5e.\n", featol);
  /* Use nag_opt_sparse_convex_qp_option_set_string (e04nsc) to set the option
   *  'Iterations limit'.
   */
  /* nag_opt_sparse_convex_qp_option_set_string (e04nsc).
   * Set a single option for nag_opt_sparse_convex_qp_solve
   * (e04nqc) from a character string
   */
  nag_opt_sparse_convex_qp_option_set_string("Iterations limit 50", &state,
                                             &fail);
  if (fail.code != NE_NOERROR)
    {
      Vprintf("e04nsc failed to set Iterations limit\n");
      exit_status = 1;
      goto END;
    }

  /* Solve the QP problem. */
  /* nag_opt_sparse_convex_qp_solve (e04nqc).
   * LP or QP problem (suitable for sparse problems)
   */
  nag_opt_sparse_convex_qp_solve(start, qphx, m, n, ne, nname, lenc, ncolh,
                                 iobj, objadd, prob, acol, inda, loca, bl, bu,
                                 c__, names, helast, hs, x, pi, rc, &ns, &ninf,
                                 &sinf, &obj, &state, &comm, &fail);

  if (fail.code == NE_NOERROR)
    {
      Vprintf("Final objective value = %11.3e\n",   obj);
      Vprintf("Optimal X = ");

      for (i = 1; i <= n; ++i)
        {
          Vprintf("%9.2f%s", x[i - 1], i%7 == 0 || i == n ?"\n":" ");
        }
    }
  else
    {
      Vprintf("\nOn exit from e04nqc, fail.message = %s\n",  fail.message);
    }
 END:
  if (cuser) NAG_FREE(cuser);
  if (names) NAG_FREE(names);
  if (prob) NAG_FREE(prob);
  if (acol) NAG_FREE(acol);
  if (bl) NAG_FREE(bl);
  if (bu) NAG_FREE(bu);
  if (c__) NAG_FREE(c__);
  if (pi) NAG_FREE(pi);
  if (rc) NAG_FREE(rc);
  if (ruser) NAG_FREE(ruser);
  if (x) NAG_FREE(x);
  if (helast) NAG_FREE(helast);
  if (hs) NAG_FREE(hs);
  if (inda) NAG_FREE(inda);
  if (iuser) NAG_FREE(iuser);
  if (loca) NAG_FREE(loca);
  return exit_status;
}

static void qphx(Integer ncolh, const double x[], double hx[],
                 Integer nstate, Nag_Comm *comm)
{
  /* Routine to compute H*x. (In this version of qphx, the Hessian
   * matrix H is not referenced explicitly.)
   */

  /* Parameter adjustments */
#define HX(I) hx[(I)-1]
#define X(I) x[(I)-1]

  /* Function Body */
  HX(1) = X(1) * 2;
  HX(2) = X(2) * 2;
  HX(3) = (X(3) + X(4)) * 2;
  HX(4) = HX(3);
  HX(5) = X(5) * 2;
  HX(6) = (X(6) + X(7)) * 2;
  HX(7) = HX(6);
  return;
} /* qphx */