/* nag_ode_bvp_fd_nonlin_gen (d02rac) Example Program.
 *
 * Copyright 2024 Numerical Algorithms Group.
 *
 * Mark 30.1, 2024.
 *
 */

#include <nag.h>
#include <stdio.h>

#ifdef __cplusplus
extern "C" {
#endif
static void NAG_CALL fcn(Integer neq, double x, double eps, const double y[],
                         double f[], Nag_User *comm);
static void NAG_CALL g(Integer neq, double eps, const double ya[],
                       const double yb[], double bc[], Nag_User *comm);
static void NAG_CALL jaceps(Integer neq, double x, double eps, const double y[],
                            double f[], Nag_User *comm);
static void NAG_CALL jacgep(Integer neq, double eps, const double ya[],
                            const double yb[], double bcep[], Nag_User *comm);
static void NAG_CALL jacobf(Integer neq, double x, double eps, const double y[],
                            double f[], Nag_User *comm);
static void NAG_CALL jacobg(Integer neq, double eps, const double ya[],
                            const double yb[], double aj[], double bj[],
                            Nag_User *comm);
#ifdef __cplusplus
}
#endif

#define NEQ 3
#define MNP 40

#define Y(I, J) y[(I)*tdy + J]
int main(void) {

  static Integer use_comm[6] = {1, 1, 1, 1, 1, 1};
  double *abt = 0;
  double deleps;
  double tol;
  double *x = 0, *y = 0;
  Integer exit_status = 0;
  Integer i, j;
  Integer np;
  Integer numbeg, nummix;
  Integer neq, mnp, tdy;
  Nag_User comm;
  NagError fail;

  INIT_FAIL(fail);

  printf("nag_ode_bvp_fd_nonlin_gen (d02rac) Example Program Results\n");

  /* For communication with user-supplied functions: */
  comm.p = (Pointer)&use_comm;

  printf("\nCalculation using analytic Jacobians\n\n");
  neq = NEQ;
  mnp = MNP;
  if (neq >= 1) {
    if (!(abt = NAG_ALLOC(neq, double)) || !(x = NAG_ALLOC(mnp, double)) ||
        !(y = NAG_ALLOC(neq * mnp, double))) {
      printf("Allocation failure\n");
      exit_status = -1;
      goto END;
    }
    tdy = mnp;
  } else {
    exit_status = 1;
    return exit_status;
  }
  tol = 1.0e-4;
  np = 17;
  numbeg = 2;
  nummix = 0;
  x[0] = 0.0;
  x[np - 1] = 10.0;
  deleps = 0.1;

  /* nag_ode_bvp_fd_nonlin_gen (d02rac).
   * Ordinary differential equations solver, for general
   * nonlinear two-point boundary value problems, using a
   * finite difference technique with deferred correction
   */
  nag_ode_bvp_fd_nonlin_gen(neq, &deleps, fcn, numbeg, nummix, g,
                            Nag_DefInitMesh, mnp, &np, x, y, tol, abt, jacobf,
                            jacobg, jaceps, jacgep, &comm, &fail);
  if (fail.code != NE_NOERROR) {
    printf("Error from nag_ode_bvp_fd_nonlin_gen (d02rac).\n%s\n",
           fail.message);
    exit_status = 1;
    goto END;
  }

  printf("Solution on final mesh of %" NAG_IFMT " points \n", np);
  printf("%7s%15s%13s%13s\n", "x", "y_1", "y_2", "y_3");

  for (j = 0; j < np; ++j) {
    printf("%10.6f", x[j]);
    for (i = 0; i < neq; ++i)
      printf("%13.4f", Y(i, j));
    printf("\n");
  }

  printf("\n\nMaximum estimated error by components \n");

  for (i = 0; i < 2; ++i)
    printf(" %11.2e", abt[i]);
  printf(" \n");

END:
  NAG_FREE(abt);
  NAG_FREE(x);
  NAG_FREE(y);
  return exit_status;
}

#undef Y

static void NAG_CALL fcn(Integer neq, double x, double eps, const double y[],
                         double f[], Nag_User *comm) {
  Integer *use_comm = (Integer *)comm->p;

  if (use_comm[0]) {
    printf("(User-supplied callback fcn, first invocation.)\n");
    use_comm[0] = 0;
  }

  f[0] = y[1];
  f[1] = y[2];
  f[2] = -y[0] * y[2] - (1.0 - y[1] * y[1]) * 2.0 * eps;
}

static void NAG_CALL g(Integer neq, double eps, const double ya[],
                       const double yb[], double bc[], Nag_User *comm) {
  Integer *use_comm = (Integer *)comm->p;

  if (use_comm[1]) {
    printf("(User-supplied callback g, first invocation.)\n");
    use_comm[1] = 0;
  }

  bc[0] = ya[0];
  bc[1] = ya[1];
  bc[2] = yb[1] - 1.0;
} /* g */

static void NAG_CALL jaceps(Integer neq, double x, double eps, const double y[],
                            double f[], Nag_User *comm) {
  Integer *use_comm = (Integer *)comm->p;

  if (use_comm[2]) {
    printf("(User-supplied callback jaceps, first invocation.)\n");
    use_comm[2] = 0;
  }

  f[0] = 0.0;
  f[1] = 0.0;
  f[2] = (1.0 - y[1] * y[1]) * -2.0;
}

static void NAG_CALL jacgep(Integer neq, double eps, const double ya[],
                            const double yb[], double bcep[], Nag_User *comm) {
  Integer i;
  Integer *use_comm = (Integer *)comm->p;

  if (use_comm[3]) {
    printf("(User-supplied callback jacgep, first invocation.)\n");
    use_comm[3] = 0;
  }

  for (i = 0; i < neq; ++i)
    bcep[i] = 0.0;
}

static void NAG_CALL jacobf(Integer neq, double x, double eps, const double y[],
                            double f[], Nag_User *comm) {
  Integer i, j;
  Integer *use_comm = (Integer *)comm->p;

#define Y(I) y[(I)-1]
#define F(I, J) f[((I)-1) * neq + (J)-1]

  if (use_comm[4]) {
    printf("(User-supplied callback jacobf, first invocation.)\n");
    use_comm[4] = 0;
  }

  for (i = 1; i <= neq; ++i) {
    for (j = 1; j <= neq; ++j)
      F(i, j) = 0.0;
  }
  F(1, 2) = 1.0;
  F(2, 3) = 1.0;
  F(3, 1) = -Y(3);
  F(3, 2) = Y(2) * 4.0 * eps;
  F(3, 3) = -Y(1);
}

static void NAG_CALL jacobg(Integer neq, double eps, const double ya[],
                            const double yb[], double aj[], double bj[],
                            Nag_User *comm) {
  Integer i, j;
  Integer *use_comm = (Integer *)comm->p;

#define AJ(I, J) aj[((I)-1) * neq + (J)-1]
#define BJ(I, J) bj[((I)-1) * neq + (J)-1]

  if (use_comm[5]) {
    printf("(User-supplied callback jacobg, first invocation.)\n");
    use_comm[5] = 0;
  }

  for (i = 1; i <= neq; ++i)
    for (j = 1; j <= neq; ++j) {
      AJ(i, j) = 0.0;
      BJ(i, j) = 0.0;
    }
  AJ(1, 1) = 1.0;
  AJ(2, 2) = 1.0;
  BJ(3, 2) = 1.0;
}