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

NAG CL Interface Introduction
Example description
/* nag_rand_times_mv_varma (g05pjc) Example Program.
 *
 * Copyright 2024 Numerical Algorithms Group.
 *
 * Mark 30.0, 2024.
 */
/* Pre-processor includes */
#include <math.h>
#include <nag.h>
#include <stdio.h>

#define VAR(I, J)                                                              \
  var[(order == Nag_RowMajor) ? (I * pdvar + J) : (J * pdvar + I)]
#define X(I, J) x[(order == Nag_RowMajor) ? (I * pdx + J) : (J * pdx + I)]
#define PHI(I, J, L) phi[(L)*k * k + (J)*k + (I)]
#define THETA(I, J, L) theta[(L)*k * k + (J)*k + (I)]

int main(void) {
  /* Integer scalar and array declarations */
  Integer exit_status = 0;
  Integer lr, x_size, var_size, i, ip, iq, j, k, l, lstate, n, tmp1, tmp2, tmp3,
      tmp4, tmp5;
  Integer *state = 0;
  Integer pdx, pdvar;
  /* NAG structures */
  NagError fail;
  Nag_ModeRNG mode;
  /* Double scalar and array declarations */
  double *phi = 0, *r = 0, *theta = 0, *var = 0, *x = 0, *xmean = 0;
  /* Use column major order */
  Nag_OrderType order = Nag_ColMajor;
  /* Choose the base generator */
  Nag_BaseRNG genid = Nag_Basic;
  Integer subid = 0;
  /* Set the seed */
  Integer seed[] = {1762543};
  Integer lseed = 1;

  /* Initialize the error structure */
  INIT_FAIL(fail);

  printf("nag_rand_times_mv_varma (g05pjc) Example Program Results\n\n");

  /* Get the length of the state array */
  lstate = -1;
  nag_rand_init_repeat(genid, subid, seed, lseed, state, &lstate, &fail);
  if (fail.code != NE_NOERROR) {
    printf("Error from nag_rand_init_repeat (g05kfc).\n%s\n", fail.message);
    exit_status = 1;
    goto END;
  }

  /* Read data from a file */
  /* Skip heading */
  scanf("%*[^\n] ");
  /* Read in initial parameters */
  scanf("%" NAG_IFMT "%" NAG_IFMT "%" NAG_IFMT "%" NAG_IFMT "%*[^\n] ", &k, &ip,
        &iq, &n);

  /* Calculate the size of the reference vector */
  tmp1 = (ip > iq) ? ip : iq;
  if (ip == 0) {
    tmp2 = k * (k + 1) / 2;
  } else {
    tmp2 = k * (k + 1) / 2 + (ip - 1) * k * k;
  }
  tmp3 = ip + iq;
  if (k >= 6) {
    lr = (5 * tmp1 * tmp1 + 1) * k * k + (4 * tmp1 + 3) * k + 4;
  } else {
    tmp4 = k * tmp1 * (k * tmp1 + 2);
    tmp5 = k * k * tmp3 * tmp3 + tmp2 * (tmp2 + 3) + k * k * (iq + 1);
    lr = (tmp3 * tmp3 + 1) * k * k + (4 * tmp3 + 3) * k +
         ((tmp4 > tmp5) ? tmp4 : tmp5) + 4;
  }

  pdvar = k;
  pdx = (order == Nag_ColMajor) ? k : n;
  x_size = (order == Nag_ColMajor) ? pdx * n : pdx * k;
  var_size = pdvar * k;

  /* Allocate arrays */
  if (!(phi = NAG_ALLOC(ip * k * k, double)) || !(r = NAG_ALLOC(lr, double)) ||
      !(theta = NAG_ALLOC(iq * k * k, double)) ||
      !(var = NAG_ALLOC(var_size, double)) ||
      !(x = NAG_ALLOC(x_size, double)) || !(xmean = NAG_ALLOC(k, double)) ||
      !(state = NAG_ALLOC(lstate, Integer))) {
    printf("Allocation failure\n");
    exit_status = -1;
    goto END;
  }

  /* Read in the AR parameters */
  for (l = 0; l < ip; l++) {
    for (i = 0; i < k; i++) {
      for (j = 0; j < k; j++)
        scanf("%lf ", &PHI(i, j, l));
    }
  }
  scanf("%*[^\n] ");

  /* Read in the MA parameters */
  if (iq > 0) {
    for (l = 0; l < iq; l++) {
      for (i = 0; i < k; i++) {
        for (j = 0; j < k; j++)
          scanf("%lf ", &THETA(i, j, l));
      }
    }
    scanf("%*[^\n] ");
  }

  /* Read in the means */
  for (i = 0; i < k; i++)
    scanf("%lf ", &xmean[i]);
  scanf("%*[^\n] ");

  /* Read in the variance / covariance matrix */
  for (i = 0; i < k; i++) {
    for (j = 0; j <= i; j++)
      scanf("%lf ", &VAR(i, j));
  }
  scanf("%*[^\n] ");

  /* Initialize the generator to a repeatable sequence */
  nag_rand_init_repeat(genid, subid, seed, lseed, state, &lstate, &fail);
  if (fail.code != NE_NOERROR) {
    printf("Error from nag_rand_init_repeat (g05kfc).\n%s\n", fail.message);
    exit_status = 1;
    goto END;
  }

  /* Generate the first realization */
  mode = Nag_InitializeAndGenerate;
  nag_rand_times_mv_varma(order, mode, n, k, xmean, ip, phi, iq, theta, var,
                          pdvar, r, lr, state, x, pdx, &fail);
  if (fail.code != NE_NOERROR) {
    printf("Error from nag_rand_times_mv_varma (g05pjc).\n%s\n", fail.message);
    exit_status = 1;
    goto END;
  }

  /* Display the results */
  printf("  Realization Number 1\n");
  for (i = 0; i < k; i++) {
    printf("\n   Series number %3" NAG_IFMT "\n", i + 1);
    printf("   -------------\n\n ");
    for (j = 0; j < n; j++)
      printf("%9.3f%s", X(i, j), (j + 1) % 8 ? " " : "\n ");
  }
  printf("\n");

  /* Generate a second realization */
  mode = Nag_ReGenerateFromReference;
  nag_rand_times_mv_varma(order, mode, n, k, xmean, ip, phi, iq, theta, var,
                          pdvar, r, lr, state, x, pdx, &fail);
  if (fail.code != NE_NOERROR) {
    printf("Error from nag_rand_times_mv_varma (g05pjc).\n%s\n", fail.message);
    exit_status = 1;
    goto END;
  }

  /* Display the results */
  printf("  Realization Number 2\n");
  for (i = 0; i < k; i++) {
    printf("\n   Series number %3" NAG_IFMT "\n", i + 1);
    printf("   -------------\n\n ");
    for (j = 0; j < n; j++)
      printf("%9.3f%s", X(i, j), (j + 1) % 8 ? " " : "\n ");
  }
  printf("\n");

END:
  NAG_FREE(phi);
  NAG_FREE(r);
  NAG_FREE(theta);
  NAG_FREE(var);
  NAG_FREE(x);
  NAG_FREE(xmean);
  NAG_FREE(state);

  return exit_status;
}