/* nag_opt_sparse_nlp_option_set_file (e04vkc) Example Program.
 *
 * Copyright 2004 Numerical Algorithms Group.
 *
 * Mark 8, 2004.
 */

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

#ifdef __cplusplus
extern "C" {
#endif
static void NAG_CALL usrfun(Integer *status, Integer n, const double x[],
                            Integer needf, Integer nf, double f[],
                            Integer needg, Integer leng, double g[],
                            Nag_Comm *comm);
#ifdef __cplusplus
}
#endif

int main(int argc, char *argv[])
{
  FILE         *fpin, *fpout;
  char         *optionsfile;
  char         *outfile;

  /* Scalars */
  double       bndinf, featol, objadd, sinf;
  Integer      elmode, exit_status = 0, i, lena, leng, n, nea, neg, nf, nfname,
               ninf;
  Integer      ns, nxname, objrow;

  /* Arrays */
  char         nag_enum_arg[40];
  char         **fnames = 0, *prob = 0, **xnames = 0;
  double       *a = 0, *f = 0, *flow = 0, *fmul = 0, *fupp = 0, *ruser = 0;
  double       *x = 0, *xlow = 0, *xmul = 0, *xupp = 0;
  Integer      *fstate = 0, *iafun = 0, *igfun = 0, *iuser = 0, *javar = 0;
  Integer      *jgvar = 0, *xstate = 0;

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

  INIT_FAIL(fail);


  /* Check for command-line IO options */
  fpin = nag_example_file_io(argc, argv, "-data", NULL);
  fpout = nag_example_file_io(argc, argv, "-results", NULL);
  (void) nag_example_file_io(argc, argv, "-nag_write", &outfile);
  (void) nag_example_file_io(argc, argv, "-options", &optionsfile);
  fprintf(
    fpout, "%s\n",
    "nag_opt_sparse_nlp_option_set_file (e04vkc) Example Program"
    " Results");

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

  /* Skip heading in data file */
  fscanf(fpin, "%*[^\n] ");
  fscanf(fpin, "%ld%ld%*[^\n] ", &n, &nf);
  fscanf(fpin, "%ld%ld%ld %s %*[^\n] ", &nea, &neg,
         &objrow, nag_enum_arg);

  /* nag_enum_name_to_value(x04nac).
   * Converts NAG enum member name to value
   */
  start = (Nag_Start) nag_enum_name_to_value(nag_enum_arg);

  if (n > 0 && nf > 0 && nea > 0 && neg > 0)
    {
      nxname = n;
      nfname = nf;

      /* Allocate memory */
      if (!(fnames = NAG_ALLOC(nfname, char *)) ||
          !(prob = NAG_ALLOC(9, char)) ||
          !(xnames = NAG_ALLOC(nxname, char *)) ||
          !(a = NAG_ALLOC(300, double)) ||
          !(f = NAG_ALLOC(100, double)) ||
          !(flow = NAG_ALLOC(100, double)) ||
          !(fmul = NAG_ALLOC(100, double)) ||
          !(fupp = NAG_ALLOC(100, double)) ||
          !(ruser = NAG_ALLOC(1, double)) ||
          !(x = NAG_ALLOC(100, double)) ||
          !(xlow = NAG_ALLOC(100, double)) ||
          !(xmul = NAG_ALLOC(100, double)) ||
          !(xupp = NAG_ALLOC(100, double)) ||
          !(fstate = NAG_ALLOC(100, Integer)) ||
          !(iafun = NAG_ALLOC(300, Integer)) ||
          !(igfun = NAG_ALLOC(300, Integer)) ||
          !(iuser = NAG_ALLOC(1, Integer)) ||
          !(javar = NAG_ALLOC(300, Integer)) ||
          !(jgvar = NAG_ALLOC(300, Integer)) ||
          !(xstate = NAG_ALLOC(100, Integer)))
        {
          fprintf(fpout, "Allocation failure\n");
          exit_status = -1;
          goto END;
        }
    }
  else
    {
      fprintf(fpout, "Invalid n or nf or nea or neg\n");
      exit_status = 1;
      return exit_status;
    }
  lena = MAX(1, nea);
  leng = MAX(1, neg);
  objadd = 0.;
  strcpy(prob, "");

  /* Read the variable names xnames */

  for (i = 1; i <= nxname; ++i)
    {
      xnames[i-1] = NAG_ALLOC(9, char);
      fscanf(fpin, " ' %8s '", xnames[i-1]);
    }
  fscanf(fpin, "%*[^\n] ");

  /* Read the function names fnames */
  for (i = 1; i <= nfname; ++i)
    {
      fnames[i -1] = NAG_ALLOC(9, char);
      fscanf(fpin, " '%8s'", fnames[i-1]);
    }
  fscanf(fpin, "%*[^\n] ");

  /* Read the sparse matrix A, the linear part of F */
  for (i = 1; i <= nea; ++i)
    {
      /* For each element read row, column, A(row,column) */
      fscanf(fpin, "%ld%ld%lf%*[^\n] ", &iafun[i - 1], &javar[i - 1],
             &a[i - 1]);
    }
  /* Read the structure of sparse matrix g, the nonlinear part of f */
  for (i = 1; i <= neg; ++i)
    {
      /* For each element read row, column */
      fscanf(fpin, "%ld%ld%*[^\n] ", &igfun[i - 1], &jgvar[i - 1]);
    }

  /* Read the lower and upper bounds on the variables */
  for (i = 1; i <= n; ++i)
    {
      fscanf(fpin, "%lf%lf%*[^\n] ", &xlow[i - 1], &xupp[i - 1]);
    }

  /* Read the lower and upper bounds on the functions */
  for (i = 1; i <= nf; ++i)
    {
      fscanf(fpin, "%lf%lf%*[^\n] ", &flow[i - 1], &fupp[i - 1]);
    }

  /* Initialise x, xstate, xmul, f, fstate, fmul */
  for (i = 1; i <= n; ++i)
    {
      fscanf(fpin, "%lf", &x[i - 1]);
    }
  fscanf(fpin, "%*[^\n] ");

  for (i = 1; i <= n; ++i)
    {
      fscanf(fpin, "%ld", &xstate[i - 1]);
    }
  fscanf(fpin, "%*[^\n] ");

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

  for (i = 1; i <= nf; ++i)
    {
      fscanf(fpin, "%lf", &f[i - 1]);
    }
  fscanf(fpin, "%*[^\n] ");

  for (i = 1; i <= nf; ++i)
    {
      fscanf(fpin, "%ld", &fstate[i - 1]);
    }
  fscanf(fpin, "%*[^\n] ");

  for (i = 1; i <= nf; ++i)
    {
      fscanf(fpin, "%lf", &fmul[i - 1]);
    }
  fscanf(fpin, "%*[^\n] ");

  /* Call nag_opt_sparse_nlp_init (e04vgc) to initialise e04vhf. */
  /* nag_opt_sparse_nlp_init (e04vgc).
   * Initialization function for nag_opt_sparse_nlp_solve
   * (e04vhc)
   */
  nag_opt_sparse_nlp_init(&state, &fail);
  if (fail.code != NE_NOERROR)
    {
      fprintf(
        fpout,
        "Initialisation of nag_opt_sparse_nlp_init (e04vgc) failed.\n%s\n",
        fail.message);
      exit_status = 1;
      goto END;
    }

  /* By default nag_opt_sparse_nlp_solve (e04vhc) 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
   */
  if (outfile) fclose(fpout);
  nag_open_file(outfile, 2, &fileid, &fail);
  if (fail.code != NE_NOERROR)
    {
      exit_status = 2;
      goto END;
    }
  /* nag_opt_sparse_nlp_option_set_integer (e04vmc).
   * Set a single option for nag_opt_sparse_nlp_solve (e04vhc)
   * from an integer argument
   */
  nag_opt_sparse_nlp_option_set_integer("Print file", fileid, &state, &fail);

  if (fail.code != NE_NOERROR)
    {
      nag_close_file(fileid, &fail);
      exit_status = 1;
      goto END;
    }

  /* Use nag_opt_sparse_nlp_option_set_file (e04vkc) to read some options from
   * the options file. Call nag_open_file (x04acc) to set the
   * options file fileid */
  /* nag_open_file (x04acc), see above. */
  nag_open_file(optionsfile, 0, &fileid, &fail);
  if (fail.code != NE_NOERROR)
    {
      nag_close_file(fileid, &fail);
      exit_status = 1;
      goto END;
    }
  /* nag_opt_sparse_nlp_option_set_file (e04vkc).
   * Supply optional parameter values for
   * nag_opt_sparse_nlp_solve (e04vhc) from external file
   */
  nag_opt_sparse_nlp_option_set_file(fileid, &state, &fail);
  if (fail.code != NE_NOERROR)
    {
      nag_close_file(fileid, &fail);
      exit_status = 1;
      goto END;
    }
  fprintf(fpout, "\n");

  /* Use nag_opt_sparse_nlp_option_get_integer (e04vrc) to find the value of
   *  Integer-valued option 'Elastic mode'.
   */
  /* nag_opt_sparse_nlp_option_get_integer (e04vrc).
   * Get the setting of an integer valued option of
   * nag_opt_sparse_nlp_solve (e04vhc)
   */
  nag_opt_sparse_nlp_option_get_integer("Elastic mode", &elmode, &state, &fail);
  if (fail.code != NE_NOERROR)
    {
      nag_close_file(fileid, &fail);
      exit_status = 1;
      goto END;
    }
  fprintf(fpout, "Option 'Elastic mode' has the value %3ld.\n", elmode);

  /* Use nag_opt_sparse_nlp_option_set_double (e04vnc) to set the value of
   *  real-valued option 'Infinite bound size'.
   */
  bndinf = 1e10;
  /* nag_opt_sparse_nlp_option_set_double (e04vnc).
   * Set a single option for nag_opt_sparse_nlp_solve (e04vhc)
   * from a double argument
   */
  nag_opt_sparse_nlp_option_set_double("Infinite bound size", bndinf, &state,
                                       &fail);
  if (fail.code != NE_NOERROR)
    {
      nag_close_file(fileid, &fail);
      exit_status = 1;
      goto END;
    }

  /* Use nag_opt_sparse_nlp_option_get_double (e04vsc) to find the value of
   *  real-valued option 'Feasibility tolerance'.
   */
  /* nag_opt_sparse_nlp_option_get_double (e04vsc).
   * Get the setting of a double valued option of
   * nag_opt_sparse_nlp_solve (e04vhc)
   */
  nag_opt_sparse_nlp_option_get_double("Feasibility tolerance", &featol,
                                       &state,
                                       &fail);
  if (fail.code != NE_NOERROR)
    {
      nag_close_file(fileid, &fail);
      exit_status = 1;
      goto END;
    }
  fprintf(fpout, "Option 'Feasibility tolerance' has the value %14.5e.\n",
          featol);

  /* Use nag_opt_sparse_nlp_option_set_string (e04vlc) to set the option 'Major
   *  iterations limit'.
   */
  /* nag_opt_sparse_nlp_option_set_string (e04vlc).
   * Set a single option for nag_opt_sparse_nlp_solve (e04vhc)
   * from a character string
   */
  nag_opt_sparse_nlp_option_set_string("Major iterations limit 50", &state,
                                       &fail);
  if (fail.code != NE_NOERROR)
    {
      nag_close_file(fileid, &fail);
      exit_status = 1;
      goto END;
    }

  /* Solve the problem. */
  /* nag_opt_sparse_nlp_solve (e04vhc).
   * General sparse nonlinear optimizer
   */
  nag_opt_sparse_nlp_solve(start, nf, n, nxname, nfname, objadd, objrow, prob,
                           usrfun, iafun, javar, a, lena, nea, igfun, jgvar,
                           leng, neg, xlow, xupp, xnames, flow, fupp, fnames,
                           x, xstate, xmul, f, fstate, fmul, &ns, &ninf, &sinf,
                           &state, &comm, &fail);

  if (outfile && !(fpout = fopen(outfile, "a")))
    {
      exit_status = 2;
      goto END;
    }
  if (fail.code != NE_NOERROR)
    {
      fprintf(fpout, "Error from nag_opt_sparse_nlp_solve (e04vhc).\n%s\n",
              fail.message);
      exit_status = 1;
      goto END;
    }

  nag_close_file(fileid, &fail);
  if (fail.code != NE_NOERROR)
    {
      exit_status = 2;
      goto END;
    }

  fprintf(fpout, "Final objective value = %11.1f\n", f[objrow - 1]);
  fprintf(fpout, "Optimal X = ");

  for (i = 1; i <= n; ++i)
    {
      fprintf(fpout, "%9.2f%s", x[i - 1], i%7 == 0 || i == n?"\n":" ");
    }

 END:
  if (fpin != stdin) fclose(fpin);
  if (fpout != stdout) fclose(fpout);
  for (i = 0; i < nxname; i++)
    {
      NAG_FREE(xnames[i]);
    }
  for (i = 0; i < nfname; i++)
    {
      NAG_FREE(fnames[i]);
    }
  if (fnames) NAG_FREE(fnames);
  if (xnames) NAG_FREE(xnames);
  if (prob) NAG_FREE(prob);
  if (a) NAG_FREE(a);
  if (f) NAG_FREE(f);
  if (flow) NAG_FREE(flow);
  if (fmul) NAG_FREE(fmul);
  if (fupp) NAG_FREE(fupp);
  if (ruser) NAG_FREE(ruser);
  if (x) NAG_FREE(x);
  if (xlow) NAG_FREE(xlow);
  if (xmul) NAG_FREE(xmul);
  if (xupp) NAG_FREE(xupp);
  if (fstate) NAG_FREE(fstate);
  if (iafun) NAG_FREE(iafun);
  if (igfun) NAG_FREE(igfun);
  if (iuser) NAG_FREE(iuser);
  if (javar) NAG_FREE(javar);
  if (jgvar) NAG_FREE(jgvar);
  if (xstate) NAG_FREE(xstate);
  if (optionsfile) NAG_FREE(optionsfile);

  return exit_status;
}

static void NAG_CALL usrfun(Integer *status, Integer n, const double x[],
                            Integer needf, Integer nf, double f[],
                            Integer needg, Integer leng, double g[],
                            Nag_Comm *comm)
{
  /* Parameter adjustments */
#define X(I) x[(I) -1]
#define F(I) f[(I) -1]
#define G(I) g[(I) -1]

  /* Function Body */
  if (needf > 0)
    {
      /* The nonlinear components of f_i(x) need to be assigned, */
      F(1) = sin(-X(1) - .25) * 1e3 + sin(-X(2) - .25) * 1e3;
      F(2) = sin(X(1) - .25) * 1e3 + sin(X(1) - X(2) - .25) * 1e3;
      F(3) = sin(X(2) - X(1) - .25) * 1e3 + sin(X(2) - .25) * 1e3;
      /* N.B. in this example there is no need to assign for the wholly */
      /* linear components f_4(x) and f_5(x). */
      F(6) = X(3) * (X(3) * X(3)) * 1e-6 + X(4) * (X(4) * X(4)) * 2e-6 / 3.;
    }

  if (needg > 0)
    {
      /* The derivatives of the function f_i(x) need to be assigned. */
      /* G(k) should be set to partial derivative df_i(x)/dx_j where */
      /* i = igfun[k-1] and j = igvar[k-1], for k = 1 to LENG. */
      G(1) = cos(-X(1) - .25) * -1e3;
      G(2) = cos(-X(2) - .25) * -1e3;
      G(3) = cos(X(1) - .25) * 1e3 + cos(X(1) - X(2) - .25) * 1e3;
      G(4) = cos(X(1) - X(2) - .25) * -1e3;
      G(5) = cos(X(2) - X(1) - .25) * -1e3;
      G(6) = cos(X(2) - X(1) - .25) * 1e3 + cos(X(2) - .25) * 1e3;
      G(7) = X(3) * X(3) * 3e-6;
      G(8) = X(4) * X(4) * 2e-6;
    }

  return;
} /* usrfun */