NAG Library Manual, Mark 30
Interfaces:  FL   CL   CPP   AD 

NAG CL Interface Introduction
Example description
/* nag_opt_nlp2_sparse_option_file (e04vkc) Example Program.
 *
 * Copyright 2024 Numerical Algorithms Group.
 *
 * Mark 30.0, 2024.
 */

#include <math.h>
#include <nag.h>
#include <stdio.h>
#include <string.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(void) {
  const char *optionsfile = "e04vkce.opt";

  /* 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 */
  static double ruser[1] = {-1.0};
  char nag_enum_arg[40];
  char **fnames = 0, *prob = 0, **xnames = 0;
  double *a = 0, *f = 0, *flow = 0, *fmul = 0, *fupp = 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 optfileid;

  /* By default e04vhc does not print monitoring information.
     Define SHOW_MONITORING_INFO to turn it on - see further below. */
#ifdef SHOW_MONITORING_INFO
  Nag_FileID outfileid;
#endif

  INIT_FAIL(fail);

  printf("%s\n", "nag_opt_nlp2_sparse_option_file (e04vkc) Example Program"
                 " Results");

  /* For communication with user-supplied functions: */
  comm.user = ruser;

  fflush(stdout);

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

  /* Skip heading in data file */
  scanf("%*[^\n] ");
  scanf("%" NAG_IFMT "%" NAG_IFMT "%*[^\n] ", &n, &nf);
  scanf("%" NAG_IFMT "%" NAG_IFMT "%" NAG_IFMT " %39s %*[^\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)) || !(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))) {
      printf("Allocation failure\n");
      exit_status = -1;
      goto END;
    }
  } else {
    printf("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 = 0; i < nxname; ++i) {
    xnames[i] = NAG_ALLOC(9, char);
    scanf(" ' %8s '", xnames[i]);
  }
  scanf("%*[^\n] ");

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

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

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

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

  /* Initialize x, xstate, xmul, f, fstate, fmul */
  for (i = 0; i < n; ++i) {
    scanf("%lf", &x[i]);
  }
  scanf("%*[^\n] ");

  for (i = 0; i < n; ++i) {
    scanf("%" NAG_IFMT "", &xstate[i]);
  }
  scanf("%*[^\n] ");

  for (i = 0; i < n; ++i) {
    scanf("%lf", &xmul[i]);
  }
  scanf("%*[^\n] ");

  for (i = 0; i < nf; ++i) {
    scanf("%lf", &f[i]);
  }
  scanf("%*[^\n] ");

  for (i = 0; i < nf; ++i) {
    scanf("%" NAG_IFMT "", &fstate[i]);
  }
  scanf("%*[^\n] ");

  for (i = 0; i < nf; ++i) {
    scanf("%lf", &fmul[i]);
  }
  scanf("%*[^\n] ");

  /* Initialize e04vhc using nag_opt_nlp2_sparse_init (e04vgc):
   *  Initialization function for nag_opt_nlp2_sparse_solve (e04vhc).
   */
  nag_opt_nlp2_sparse_init(&state, &fail);
  if (fail.code != NE_NOERROR) {
    printf("Initialization of nag_opt_nlp2_sparse_init (e04vgc) failed.\n%s\n",
           fail.message);
    exit_status = 1;
    goto END;
  }

#ifdef SHOW_MONITORING_INFO
  /* Call nag_file_open (x04acc) to set the print file outfileid */
  /* nag_file_open (x04acc).
   * Open unit number for reading, writing or appending, and
   * associate unit with named file
   */
  nag_file_open("", 2, &outfileid, &fail);
  if (fail.code != NE_NOERROR) {
    exit_status = 2;
    goto END;
  }

  /* nag_opt_nlp2_sparse_option_integer_set (e04vmc).
   * Set a single option for nag_opt_nlp2_sparse_solve (e04vhc)
   * from an integer argument
   */
  nag_opt_nlp2_sparse_option_integer_set("Print file", outfileid, &state,
                                         &fail);

  if (fail.code != NE_NOERROR) {
    exit_status = 1;
    goto END;
  }
#endif

  /* Use nag_opt_nlp2_sparse_option_file (e04vkc) to read some options from
   * the options file. Call nag_file_open (x04acc) to set the
   * options file optfileid.
   */
  nag_file_open(optionsfile, 0, &optfileid, &fail);
  if (fail.code != NE_NOERROR) {
    nag_file_close(optfileid, &fail);
    exit_status = 1;
    goto END;
  }
  /* nag_opt_nlp2_sparse_option_file (e04vkc).
   * Supply optional parameter values for
   * nag_opt_nlp2_sparse_solve (e04vhc) from external file
   */
  nag_opt_nlp2_sparse_option_file(optfileid, &state, &fail);
  if (fail.code != NE_NOERROR) {
    nag_file_close(optfileid, &fail);
    exit_status = 1;
    goto END;
  }
  printf("\n");

  /* Find the value of Integer-valued option 'Elastic mode' using
   * nag_opt_nlp2_sparse_option_integer_get (e04vrc):
   *  Get the setting of an integer valued option of
   *  nag_opt_nlp2_sparse_solve (e04vhc)
   */
  nag_opt_nlp2_sparse_option_integer_get("Elastic mode", &elmode, &state,
                                         &fail);
  if (fail.code != NE_NOERROR) {
    nag_file_close(optfileid, &fail);
    exit_status = 1;
    goto END;
  }
  printf("Option 'Elastic mode' has the value %3" NAG_IFMT ".\n", elmode);

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

  /* Find the value of real-valued option 'Feasibility tolerance' using
   * nag_opt_nlp2_sparse_option_double_get (e04vsc):
   *  Get the setting of a double valued option of
   *  nag_opt_nlp2_sparse_solve (e04vhc)
   */
  nag_opt_nlp2_sparse_option_double_get("Feasibility tolerance", &featol,
                                        &state, &fail);
  if (fail.code != NE_NOERROR) {
    nag_file_close(optfileid, &fail);
    exit_status = 1;
    goto END;
  }
  printf("Option 'Feasibility tolerance' has the value %14.5e.\n", featol);

  /* Set the option 'Major iterations limit' using
   * nag_opt_nlp2_sparse_option_string (e04vlc):
   *  Set a single option for nag_opt_nlp2_sparse_solve (e04vhc)
   *  from a character string
   */
  nag_opt_nlp2_sparse_option_string("Major iterations limit 50", &state, &fail);
  if (fail.code != NE_NOERROR) {
    nag_file_close(optfileid, &fail);
    exit_status = 1;
    goto END;
  }
  printf("\n");
  fflush(stdout);

  /* Solve the problem. */
  /* nag_opt_nlp2_sparse_solve (e04vhc).
   * General sparse nonlinear optimizer
   */
  nag_opt_nlp2_sparse_solve(
      start, nf, n, nxname, nfname, objadd, objrow, prob, usrfun, iafun, javar,
      a, lena, nea, igfun, jgvar, leng, neg, xlow, xupp, (const char **)xnames,
      flow, fupp, (const char **)fnames, x, xstate, xmul, f, fstate, fmul, &ns,
      &ninf, &sinf, &state, &comm, &fail);
  if (fail.code != NE_NOERROR) {
    printf("Error from nag_opt_nlp2_sparse_solve (e04vhc).\n%s\n",
           fail.message);
    exit_status = 1;
    goto END;
  }
  nag_file_close(optfileid, &fail);

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

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

END:
  for (i = 0; i < nxname; i++)
    NAG_FREE(xnames[i]);
  for (i = 0; i < nfname; i++)
    NAG_FREE(fnames[i]);
  NAG_FREE(fnames);
  NAG_FREE(xnames);
  NAG_FREE(prob);
  NAG_FREE(a);
  NAG_FREE(f);
  NAG_FREE(flow);
  NAG_FREE(fmul);
  NAG_FREE(fupp);
  NAG_FREE(x);
  NAG_FREE(xlow);
  NAG_FREE(xmul);
  NAG_FREE(xupp);
  NAG_FREE(fstate);
  NAG_FREE(iafun);
  NAG_FREE(igfun);
  NAG_FREE(iuser);
  NAG_FREE(javar);
  NAG_FREE(jgvar);
  NAG_FREE(xstate);

  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) {
  if (comm->user[0] == -1.0) {
    fflush(stdout);
    printf("(User-supplied callback usrfun, first invocation.)\n");
    comm->user[0] = 0.0;
    fflush(stdout);
  }
  if (needf > 0) {
    /* The nonlinear components of f_i(x) need to be assigned, */
    f[0] = sin(-x[0] - .25) * 1e3 + sin(-x[1] - .25) * 1e3;
    f[1] = sin(x[0] - .25) * 1e3 + sin(x[0] - x[1] - .25) * 1e3;
    f[2] = sin(x[1] - x[0] - .25) * 1e3 + sin(x[1] - .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[5] = x[2] * (x[2] * x[2]) * 1e-6 + x[3] * (x[3] * x[3]) * 2e-6 / 3.;
  }

  if (needg > 0) {
    /* The derivatives of the function f_i(x) need to be assigned.
     * g[k-1] 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[0] = cos(-x[0] - .25) * -1e3;
    g[1] = cos(-x[1] - .25) * -1e3;
    g[2] = cos(x[0] - .25) * 1e3 + cos(x[0] - x[1] - .25) * 1e3;
    g[3] = cos(x[0] - x[1] - .25) * -1e3;
    g[4] = cos(x[1] - x[0] - .25) * -1e3;
    g[5] = cos(x[1] - x[0] - .25) * 1e3 + cos(x[1] - .25) * 1e3;
    g[6] = x[2] * x[2] * 3e-6;
    g[7] = x[3] * x[3] * 2e-6;
  }

  return;
} /* usrfun */