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

NAG CL Interface Introduction
Example description
/* nag_sparse_real_gen_precon_bdilu (f11dfc) Example Program.
 *
 * Copyright 2024 Numerical Algorithms Group.
 *
 * Mark 30.1, 2024.
 */

#include <nag.h>

static void overlap(Integer *n, Integer *nnz, Integer *irow, Integer *icol,
                    Integer *nb, Integer *istb, Integer *indb, Integer *lindb,
                    Integer *nover, Integer *iwork);

int main(void) {

  /* Scalars */
  double dtolg;
  Integer i, j, k, la, lfillg, lindb, liwork, minval, mb, n, nb, nnz, nnzc,
      nover;
  Integer exit_status = 0, maxval_ret = 9999;
  Nag_SparseNsym_Piv pstrag;
  Nag_SparseNsym_Fact milug;

  /* Arrays */
  char nag_enum_arg[40];
  double *a = 0, *dtol = 0;
  Integer *icol = 0, *idiag = 0, *indb = 0, *ipivp = 0, *ipivq = 0, *irow = 0;
  Integer *istb = 0, *istr = 0, *iwork = 0, *lfill = 0, *npivm = 0;
  Nag_SparseNsym_Piv *pstrat;
  Nag_SparseNsym_Fact *milu;

  /* Nag Types */
  NagError fail;

  /* Print example header */
  printf(
      "nag_sparse_real_gen_precon_bdilu (f11dfc) Example Program Results\n\n");

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

  /* Get the matrix order and number of nonzero entries. */
  scanf("%" NAG_IFMT " %*[^\n]", &n);
  scanf("%" NAG_IFMT " %*[^\n]", &nnz);

  la = 20 * nnz;
  lindb = 3 * n;
  liwork = 9 * n + 3;

  /* Allocate arrays */
  a = NAG_ALLOC(la, double);
  irow = NAG_ALLOC(la, Integer);
  icol = NAG_ALLOC(la, Integer);

  idiag = NAG_ALLOC(lindb, Integer);
  indb = NAG_ALLOC(lindb, Integer);
  ipivp = NAG_ALLOC(lindb, Integer);
  ipivq = NAG_ALLOC(lindb, Integer);
  istr = NAG_ALLOC(lindb + 1, Integer);

  iwork = NAG_ALLOC(liwork, Integer);

  if ((!a) || (!irow) || (!icol) || (!idiag) || (!indb) || (!ipivp) ||
      (!ipivq) || (!istr) || (!iwork)) {
    printf("Allocation failure!\n");
    exit_status = -1;
    goto END;
  }

  /* Initialize arrays */
  for (i = 0; i < la; i++) {
    a[i] = 0.0;
    irow[i] = 0;
    icol[i] = 0;
  }

  for (i = 0; i < lindb; i++) {
    indb[i] = 0;
    ipivp[i] = 0;
    ipivq[i] = 0;
    istr[i] = 0;
    idiag[i] = 0;
  }
  istr[lindb] = 0;

  for (i = 0; i < liwork; i++) {
    iwork[i] = 0;
  }

  /* Read the matrix A */
  for (i = 0; i < nnz; i++) {
    scanf("%lf %" NAG_IFMT " %" NAG_IFMT, &a[i], &irow[i], &icol[i]);
  }
  scanf("%*[^\n] ");

  /* Read algorithmic parameters */
  scanf("%" NAG_IFMT " %lf %*[^\n]", &lfillg, &dtolg);

  /* nag_enum_name_to_value (x04nac): Converts NAG enum member name to value */
  scanf("%39s %*[^\n]", nag_enum_arg);
  pstrag = (Nag_SparseNsym_Piv)nag_enum_name_to_value(nag_enum_arg);

  /* nag_enum_name_to_value (x04nac): Converts NAG enum member name to value */
  scanf("%39s %*[^\n]", nag_enum_arg);
  milug = (Nag_SparseNsym_Fact)nag_enum_name_to_value(nag_enum_arg);

  /* Read algorithmic parameters */
  scanf("%" NAG_IFMT " %" NAG_IFMT " %*[^\n]", &nb, &nover);

  if (nb < 1) {
    printf("Value read for nb is out of range\n");
    exit_status = -4;
    goto END;
  }

  /* Allocate arrays */
  dtol = NAG_ALLOC(nb, double);
  istb = NAG_ALLOC(nb + 1, Integer);
  lfill = NAG_ALLOC(nb, Integer);
  npivm = NAG_ALLOC(nb, Integer);

  pstrat = (Nag_SparseNsym_Piv *)NAG_ALLOC(nb, Nag_SparseNsym_Piv);
  milu = (Nag_SparseNsym_Fact *)NAG_ALLOC(nb, Nag_SparseNsym_Fact);

  if ((!dtol) || (!istb) || (!lfill) || (!npivm) || (!pstrat) || (!milu)) {
    printf("Allocation failure!\n");
    exit_status = -1;
    goto END;
  }

  /* Initialize arrays */
  for (i = 0; i < nb; i++) {
    dtol[i] = 0.0;
    istb[i] = 0;
    lfill[i] = 0;
    npivm[i] = 0;
  }
  istb[nb] = 0;

  /* Define diagonal block indices.
   * In this example use blocks of MB consecutive rows and initialize
   * assuming no overlap.
   */
  mb = (n + nb - 1) / nb;
  for (k = 0; k < nb; k++) {
    istb[k] = k * mb + 1;
  }
  istb[nb] = n + 1;

  for (i = 0; i < n; i++) {
    indb[i] = i + 1;
  }

  /* Modify INDB and ISTB to account for overlap. */
  overlap(&n, &nnz, irow, icol, &nb, istb, indb, &lindb, &nover, iwork);

  /* Output matrix and blocking details */
  printf(" Original Matrix\n");
  printf(" n     = %4" NAG_IFMT "\n", n);
  printf(" nnz   = %4" NAG_IFMT "\n", nnz);
  printf(" nb    = %4" NAG_IFMT "\n", nb);

  for (k = 0; k < nb; k++) {
    printf(" Block = %4" NAG_IFMT ",%12s = %4" NAG_IFMT ",", k + 1, "order",
           istb[k + 1] - istb[k]);
    minval = indb[istb[k] - 1];
    for (j = istb[k]; j < istb[k + 1] - 1; j++) {
      minval = MIN(minval, indb[j]);
    }
    printf("%13s = %4" NAG_IFMT "\n", "start row", minval);
  }
  printf("\n");

  /* Set algorithmic parameters for each block from global values */
  for (k = 0; k < nb; k++) {
    lfill[k] = lfillg;
    dtol[k] = dtolg;
    pstrat[k] = pstrag;
    milu[k] = milug;
  }

  /* Initialize fail */
  INIT_FAIL(fail);

  /* Calculate factorization
   *
   * nag_sparse_real_gen_precon_bdilu (f11dfc). Calculates incomplete LU
   * factorization of local or overlapping diagonal blocks, mostly used
   * as incomplete LU preconditioner for real sparse matrix.
   */
  nag_sparse_real_gen_precon_bdilu(n, nnz, a, la, irow, icol, nb, istb, indb,
                                   lindb, lfill, dtol, pstrat, milu, ipivp,
                                   ipivq, istr, idiag, &nnzc, npivm, &fail);

  if (fail.code != NE_NOERROR) {
    printf("Error from nag_sparse_real_gen_precon_bdilu (f11dfc).\n%s\n\n",
           fail.message);
    exit_status = -2;
    goto END;
  }

  /* Output details of the factorization */
  printf(" Factorization\n");
  printf(" nnzc  = %4" NAG_IFMT "\n\n", nnzc);
  printf(" Elements of factorization\n");
  printf("        i    j           c(i,j)   Index\n");

  for (k = 0; k < nb; k++) {
    printf("  C_%1" NAG_IFMT "  --------------------------------\n", k + 1);

    /* Elements of the k-th block */
    for (i = istr[istb[k] - 1] - 1; i < istr[istb[k + 1] - 1] - 1; i++) {
      printf("%9" NAG_IFMT " %4" NAG_IFMT " %16.5e %7" NAG_IFMT "\n", irow[i],
             icol[i], a[i], i + 1);
    }
  }

  k = 0;
  maxval_ret = npivm[k];
  for (k = 1; k < nb; k++) {
    maxval_ret = MAX(maxval_ret, npivm[k]);
  }

  printf("\n Details of factorized blocks\n");
  if (maxval_ret > 0) {

    /* Including pivoting details. */
    printf("  k   i    istr(i)   idiag(I)    indb(i)  ipivp(i)  ipivq(i)\n");
    for (k = 0; k < nb; k++) {
      i = istb[k] - 1;
      printf("%3" NAG_IFMT " %3" NAG_IFMT " %10" NAG_IFMT " ", k + 1, i + 1,
             istr[i]);
      printf("%10" NAG_IFMT " %10" NAG_IFMT " %10" NAG_IFMT " %10" NAG_IFMT
             "\n",
             idiag[i], indb[i], ipivp[i], ipivq[i]);

      for (i = istb[k]; i < istb[k + 1] - 1; i++) {
        printf("%3" NAG_IFMT " %10" NAG_IFMT " %10" NAG_IFMT " ", i + 1,
               istr[i], idiag[i]);
        printf("%10" NAG_IFMT " %10" NAG_IFMT " %10" NAG_IFMT "\n", indb[i],
               ipivp[i], ipivq[i]);
      }
      printf(" -----------------------------------------------------\n");
    }
  } else {

    /* No pivoting on any block. */
    printf("  k   i     istr(i)   idiag(i)    indb(i)\n");
    for (k = 0; k < nb; k++) {
      i = istb[k] - 1;
      printf("%3" NAG_IFMT " %3" NAG_IFMT " %10" NAG_IFMT " ", k + 1, i + 1,
             istr[i]);
      printf("%10" NAG_IFMT " %10" NAG_IFMT "\n", idiag[i], indb[i]);

      for (i = istb[k]; i < istb[k + 1] - 1; i++) {
        printf("%7" NAG_IFMT " %10" NAG_IFMT " %10" NAG_IFMT " %10" NAG_IFMT
               "\n",
               i + 1, istr[i], idiag[i], indb[i]);
      }
      printf(" ---------------------------------------\n");
    }
  }

END:
  NAG_FREE(a);
  NAG_FREE(irow);
  NAG_FREE(icol);
  NAG_FREE(idiag);
  NAG_FREE(indb);
  NAG_FREE(ipivp);
  NAG_FREE(ipivq);
  NAG_FREE(istr);
  NAG_FREE(dtol);
  NAG_FREE(istb);
  NAG_FREE(lfill);
  NAG_FREE(npivm);
  NAG_FREE(pstrat);
  NAG_FREE(milu);
  NAG_FREE(iwork);

  return exit_status;
}

/* ************************************************************************** */

static void overlap(Integer *n, Integer *nnz, Integer *irow, Integer *icol,
                    Integer *nb, Integer *istb, Integer *indb, Integer *lindb,
                    Integer *nover, Integer *iwork) {
  /* Purpose
   * =======
   *
   * This routine takes a set of row indices INDB defining the diagonal blocks
   * to be used in nag_sparse_real_gen_precon_bdilu (f11dfc) to define a block
   * Jacobi or additive Schwarz preconditioner, and expands them to allow for
   * NOVER levels of overlap.
   *
   * The pointer array ISTB is also updated accordingly, so that the returned
   * values of ISTB and INDB can be passed to
   * nag_sparse_real_gen_precon_bdilu (f11dfc) to define overlapping diagonal
   * blocks.
   *
   * ----------------------------------------------------------------------- */

  /* Scalars */
  Integer i, ik, ind, iover, j, k, l, n21, nadd, row;

  /* Find the number of nonzero elements in each row of the matrix A, and start
   * address of each row. Store the start addresses in iwork(n,...,2*n-1).
   */

  for (i = 0; i < (*n); i++) {
    iwork[i] = 0;
  }

  for (i = 0; i < (*nnz); i++) {
    iwork[irow[i] - 1] = iwork[irow[i] - 1] + 1;
  }
  iwork[(*n)] = 1;

  for (i = 0; i < (*n); i++) {
    iwork[(*n) + i + 1] = iwork[(*n) + i] + iwork[i];
  }

  /* Loop over blocks. */
  for (k = 0; k < (*nb); k++) {

    /* Initialize marker array. */
    for (j = 0; j < (*n); j++) {
      iwork[j] = 0;
    }

    /* Mark the rows already in block K in the workspace array. */
    for (l = istb[k]; l < istb[k + 1]; l++) {
      iwork[indb[l - 1] - 1] = 1;
    }

    /* Loop over levels of overlap. */
    for (iover = 1; iover <= (*nover); iover++) {

      /* Initialize counter of new row indices to be added. */
      ind = 0;

      /* Loop over the rows currently in the diagonal block. */
      for (l = istb[k]; l < istb[k + 1]; l++) {
        row = indb[l - 1];

        /* Loop over nonzero elements in row ROW. */
        for (i = iwork[(*n) + row - 1]; i < iwork[(*n) + row]; i++) {

          /* If the column index of the nonzero element is not in the
           * existing set for this block, store it to be added later, and
           * mark it in the marker array.
           */
          if (iwork[icol[i - 1] - 1] == 0) {
            iwork[icol[i - 1] - 1] = 1;
            iwork[2 * (*n) + 1 + ind] = icol[i - 1];
            ind = ind + 1;
          }
        }
      }

      /* Shift the indices in INDB and add the new entries for block K.
       * Change ISTB accordingly.
       */
      nadd = ind;
      if (istb[(*nb)] + nadd - 1 > (*lindb)) {
        printf("**** lindb too small, lindb = %" NAG_IFMT " ****\n", *lindb);
        exit(-1);
      }

      for (i = istb[(*nb)] - 1; i >= istb[k + 1]; i--) {
        indb[i + nadd - 1] = indb[i - 1];
      }

      n21 = 2 * (*n) + 1;
      ik = istb[k + 1] - 1;

      for (j = 0; j < nadd; j++) {
        indb[ik + j] = iwork[n21 + j];
      }

      for (j = k + 1; j < (*nb) + 1; j++) {
        istb[j] = istb[j] + nadd;
      }
    }
  }
  return;
}