xref: /petsc/src/tao/matrix/adamat.c (revision 2286efddd54511ab18e8e2adb1e023c4bf8f0b92)

#include <petsc/private/matimpl.h> /*I  "petscmat.h"  I*/

static PetscErrorCode MatCreateADA(Mat, Vec, Vec, Mat *);

typedef struct {
  Mat      A;
  Vec      D1;
  Vec      D2;
  Vec      W;
  Vec      W2;
  Vec      ADADiag;
  PetscInt GotDiag;
} _p_TaoMatADACtx;
typedef _p_TaoMatADACtx *TaoMatADACtx;

static PetscErrorCode MatMult_ADA(Mat mat, Vec a, Vec y)
{
  TaoMatADACtx ctx;
  PetscReal    one = 1.0;

  PetscFunctionBegin;
  PetscCall(MatShellGetContext(mat, &ctx));
  PetscCall(MatMult(ctx->A, a, ctx->W));
  if (ctx->D1) PetscCall(VecPointwiseMult(ctx->W, ctx->D1, ctx->W));
  PetscCall(MatMultTranspose(ctx->A, ctx->W, y));
  if (ctx->D2) {
    PetscCall(VecPointwiseMult(ctx->W2, ctx->D2, a));
    PetscCall(VecAXPY(y, one, ctx->W2));
  }
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatMultTranspose_ADA(Mat mat, Vec a, Vec y)
{
  PetscFunctionBegin;
  PetscCall(MatMult_ADA(mat, a, y));
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatDiagonalSet_ADA(Mat M, Vec D, InsertMode mode)
{
  TaoMatADACtx ctx;
  PetscReal    zero = 0.0, one = 1.0;

  PetscFunctionBegin;
  PetscCheck(mode != INSERT_VALUES, PetscObjectComm((PetscObject)M), PETSC_ERR_SUP, "Cannot insert diagonal entries of this matrix type, can only add");
  PetscCall(MatShellGetContext(M, &ctx));
  if (!ctx->D2) {
    PetscCall(VecDuplicate(D, &ctx->D2));
    PetscCall(VecSet(ctx->D2, zero));
  }
  PetscCall(VecAXPY(ctx->D2, one, D));
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatDestroy_ADA(Mat mat)
{
  TaoMatADACtx ctx;

  PetscFunctionBegin;
  PetscCall(MatShellGetContext(mat, &ctx));
  PetscCall(VecDestroy(&ctx->W));
  PetscCall(VecDestroy(&ctx->W2));
  PetscCall(VecDestroy(&ctx->ADADiag));
  PetscCall(MatDestroy(&ctx->A));
  PetscCall(VecDestroy(&ctx->D1));
  PetscCall(VecDestroy(&ctx->D2));
  PetscCall(PetscFree(ctx));
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatView_ADA(Mat mat, PetscViewer viewer)
{
  PetscFunctionBegin;
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatShift_ADA(Mat Y, PetscReal a)
{
  TaoMatADACtx ctx;

  PetscFunctionBegin;
  PetscCall(MatShellGetContext(Y, &ctx));
  PetscCall(VecShift(ctx->D2, a));
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatDuplicate_ADA(Mat mat, MatDuplicateOption op, Mat *M)
{
  TaoMatADACtx ctx;
  Mat          A2;
  Vec          D1b = NULL, D2b;

  PetscFunctionBegin;
  PetscCall(MatShellGetContext(mat, &ctx));
  PetscCall(MatDuplicate(ctx->A, op, &A2));
  if (ctx->D1) {
    PetscCall(VecDuplicate(ctx->D1, &D1b));
    PetscCall(VecCopy(ctx->D1, D1b));
  }
  PetscCall(VecDuplicate(ctx->D2, &D2b));
  PetscCall(VecCopy(ctx->D2, D2b));
  PetscCall(MatCreateADA(A2, D1b, D2b, M));
  if (ctx->D1) PetscCall(PetscObjectDereference((PetscObject)D1b));
  PetscCall(PetscObjectDereference((PetscObject)D2b));
  PetscCall(PetscObjectDereference((PetscObject)A2));
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatEqual_ADA(Mat A, Mat B, PetscBool *flg)
{
  TaoMatADACtx ctx1, ctx2;

  PetscFunctionBegin;
  PetscCall(MatShellGetContext(A, &ctx1));
  PetscCall(MatShellGetContext(B, &ctx2));
  PetscCall(VecEqual(ctx1->D2, ctx2->D2, flg));
  if (*flg == PETSC_TRUE) PetscCall(VecEqual(ctx1->D1, ctx2->D1, flg));
  if (*flg == PETSC_TRUE) PetscCall(MatEqual(ctx1->A, ctx2->A, flg));
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatScale_ADA(Mat mat, PetscReal a)
{
  TaoMatADACtx ctx;

  PetscFunctionBegin;
  PetscCall(MatShellGetContext(mat, &ctx));
  PetscCall(VecScale(ctx->D1, a));
  if (ctx->D2) PetscCall(VecScale(ctx->D2, a));
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatTranspose_ADA(Mat mat, MatReuse reuse, Mat *B)
{
  TaoMatADACtx ctx;

  PetscFunctionBegin;
  if (reuse == MAT_REUSE_MATRIX) PetscCall(MatTransposeCheckNonzeroState_Private(mat, *B));
  PetscCall(MatShellGetContext(mat, &ctx));
  if (reuse == MAT_INITIAL_MATRIX) {
    PetscCall(MatDuplicate(mat, MAT_COPY_VALUES, B));
  } else if (reuse == MAT_REUSE_MATRIX) {
    PetscCall(MatCopy(mat, *B, SAME_NONZERO_PATTERN));
  } else SETERRQ(PetscObjectComm((PetscObject)mat), PETSC_ERR_SUP, "Does not support inplace transpose");
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatADAComputeDiagonal(Mat mat)
{
  PetscInt     i, m, n, low, high;
  PetscScalar *dtemp, *dptr;
  TaoMatADACtx ctx;

  PetscFunctionBegin;
  PetscCall(MatShellGetContext(mat, &ctx));
  PetscCall(MatGetOwnershipRange(mat, &low, &high));
  PetscCall(MatGetSize(mat, &m, &n));

  PetscCall(PetscMalloc1(n, &dtemp));
  for (i = 0; i < n; i++) {
    PetscCall(MatGetColumnVector(ctx->A, ctx->W, i));
    PetscCall(VecPointwiseMult(ctx->W, ctx->W, ctx->W));
    PetscCall(VecDotBegin(ctx->D1, ctx->W, dtemp + i));
  }
  for (i = 0; i < n; i++) PetscCall(VecDotEnd(ctx->D1, ctx->W, dtemp + i));

  PetscCall(VecGetArray(ctx->ADADiag, &dptr));
  for (i = low; i < high; i++) dptr[i - low] = dtemp[i];
  PetscCall(VecRestoreArray(ctx->ADADiag, &dptr));
  PetscCall(PetscFree(dtemp));
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatGetDiagonal_ADA(Mat mat, Vec v)
{
  PetscReal    one = 1.0;
  TaoMatADACtx ctx;

  PetscFunctionBegin;
  PetscCall(MatShellGetContext(mat, &ctx));
  PetscCall(MatADAComputeDiagonal(mat));
  PetscCall(VecCopy(ctx->ADADiag, v));
  if (ctx->D2) PetscCall(VecAXPY(v, one, ctx->D2));
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatCreateSubMatrix_ADA(Mat mat, IS isrow, IS iscol, MatReuse cll, Mat *newmat)
{
  PetscInt     low, high;
  IS           ISrow;
  Vec          D1, D2;
  Mat          Atemp;
  TaoMatADACtx ctx;
  PetscBool    isequal;

  PetscFunctionBegin;
  PetscCall(ISEqual(isrow, iscol, &isequal));
  PetscCheck(isequal, PETSC_COMM_SELF, PETSC_ERR_SUP, "Only for identical column and row indices");
  PetscCall(MatShellGetContext(mat, &ctx));

  PetscCall(MatGetOwnershipRange(ctx->A, &low, &high));
  PetscCall(ISCreateStride(PetscObjectComm((PetscObject)mat), high - low, low, 1, &ISrow));
  PetscCall(MatCreateSubMatrix(ctx->A, ISrow, iscol, cll, &Atemp));
  PetscCall(ISDestroy(&ISrow));

  if (ctx->D1) {
    PetscCall(VecDuplicate(ctx->D1, &D1));
    PetscCall(VecCopy(ctx->D1, D1));
  } else {
    D1 = NULL;
  }

  if (ctx->D2) {
    Vec D2sub;

    PetscCall(VecGetSubVector(ctx->D2, isrow, &D2sub));
    PetscCall(VecDuplicate(D2sub, &D2));
    PetscCall(VecCopy(D2sub, D2));
    PetscCall(VecRestoreSubVector(ctx->D2, isrow, &D2sub));
  } else {
    D2 = NULL;
  }

  PetscCall(MatCreateADA(Atemp, D1, D2, newmat));
  PetscCall(MatShellGetContext(*newmat, &ctx));
  PetscCall(PetscObjectDereference((PetscObject)Atemp));
  if (ctx->D1) PetscCall(PetscObjectDereference((PetscObject)D1));
  if (ctx->D2) PetscCall(PetscObjectDereference((PetscObject)D2));
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatCreateSubMatrices_ADA(Mat A, PetscInt n, IS *irow, IS *icol, MatReuse scall, Mat **B)
{
  PetscInt i;

  PetscFunctionBegin;
  if (scall == MAT_INITIAL_MATRIX) PetscCall(PetscCalloc1(n + 1, B));
  for (i = 0; i < n; i++) PetscCall(MatCreateSubMatrix_ADA(A, irow[i], icol[i], scall, &(*B)[i]));
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatGetColumnVector_ADA(Mat mat, Vec Y, PetscInt col)
{
  PetscInt    low, high;
  PetscScalar zero = 0.0, one = 1.0;

  PetscFunctionBegin;
  PetscCall(VecSet(Y, zero));
  PetscCall(VecGetOwnershipRange(Y, &low, &high));
  if (col >= low && col < high) PetscCall(VecSetValue(Y, col, one, INSERT_VALUES));
  PetscCall(VecAssemblyBegin(Y));
  PetscCall(VecAssemblyEnd(Y));
  PetscCall(MatMult_ADA(mat, Y, Y));
  PetscFunctionReturn(PETSC_SUCCESS);
}

PETSC_INTERN PetscErrorCode MatConvert_ADA(Mat mat, MatType newtype, Mat *NewMat)
{
  PetscMPIInt  size;
  PetscBool    sametype, issame, isdense, isseqdense;
  TaoMatADACtx ctx;

  PetscFunctionBegin;
  PetscCall(MatShellGetContext(mat, &ctx));
  PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)mat), &size));

  PetscCall(PetscObjectTypeCompare((PetscObject)mat, newtype, &sametype));
  PetscCall(PetscObjectTypeCompare((PetscObject)mat, MATSAME, &issame));
  PetscCall(PetscObjectTypeCompare((PetscObject)mat, MATMPIDENSE, &isdense));
  PetscCall(PetscObjectTypeCompare((PetscObject)mat, MATSEQDENSE, &isseqdense));

  if (sametype || issame) {
    PetscCall(MatDuplicate(mat, MAT_COPY_VALUES, NewMat));
  } else if (isdense) {
    PetscInt           i, j, low, high, m, n, M, N;
    const PetscScalar *dptr;
    Vec                X;

    PetscCall(VecDuplicate(ctx->D2, &X));
    PetscCall(MatGetSize(mat, &M, &N));
    PetscCall(MatGetLocalSize(mat, &m, &n));
    PetscCall(MatCreateDense(PetscObjectComm((PetscObject)mat), m, m, N, N, NULL, NewMat));
    PetscCall(MatGetOwnershipRange(*NewMat, &low, &high));
    for (i = 0; i < M; i++) {
      PetscCall(MatGetColumnVector_ADA(mat, X, i));
      PetscCall(VecGetArrayRead(X, &dptr));
      for (j = 0; j < high - low; j++) PetscCall(MatSetValue(*NewMat, low + j, i, dptr[j], INSERT_VALUES));
      PetscCall(VecRestoreArrayRead(X, &dptr));
    }
    PetscCall(MatAssemblyBegin(*NewMat, MAT_FINAL_ASSEMBLY));
    PetscCall(MatAssemblyEnd(*NewMat, MAT_FINAL_ASSEMBLY));
    PetscCall(VecDestroy(&X));
  } else if (isseqdense && size == 1) {
    PetscInt           i, j, low, high, m, n, M, N;
    const PetscScalar *dptr;
    Vec                X;

    PetscCall(VecDuplicate(ctx->D2, &X));
    PetscCall(MatGetSize(mat, &M, &N));
    PetscCall(MatGetLocalSize(mat, &m, &n));
    PetscCall(MatCreateSeqDense(PetscObjectComm((PetscObject)mat), N, N, NULL, NewMat));
    PetscCall(MatGetOwnershipRange(*NewMat, &low, &high));
    for (i = 0; i < M; i++) {
      PetscCall(MatGetColumnVector_ADA(mat, X, i));
      PetscCall(VecGetArrayRead(X, &dptr));
      for (j = 0; j < high - low; j++) PetscCall(MatSetValue(*NewMat, low + j, i, dptr[j], INSERT_VALUES));
      PetscCall(VecRestoreArrayRead(X, &dptr));
    }
    PetscCall(MatAssemblyBegin(*NewMat, MAT_FINAL_ASSEMBLY));
    PetscCall(MatAssemblyEnd(*NewMat, MAT_FINAL_ASSEMBLY));
    PetscCall(VecDestroy(&X));
  } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "No support to convert objects to that type");
  PetscFunctionReturn(PETSC_SUCCESS);
}

static PetscErrorCode MatNorm_ADA(Mat mat, NormType type, PetscReal *norm)
{
  TaoMatADACtx ctx;

  PetscFunctionBegin;
  PetscCall(MatShellGetContext(mat, &ctx));
  if (type == NORM_FROBENIUS) {
    *norm = 1.0;
  } else if (type == NORM_1 || type == NORM_INFINITY) {
    *norm = 1.0;
  } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "No two norm");
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*
   MatCreateADA - Creates a matrix M=A^T D1 A + D2 where D1, D2 are diagonal

   Collective

   Input Parameters:
+  mat - matrix of arbitrary type
.  d1 - A vector defining a diagonal matrix
-  d2 - A vector defining a diagonal matrix

   Output Parameter:
.  J - New matrix whose operations are defined in terms of mat, D1, and D2.

   Level: developer

   Note:
   The user provides the input data and is responsible for destroying
   this data after matrix `J` has been destroyed.

.seealso: `Mat`, `MatCreate()`
*/
static PetscErrorCode MatCreateADA(Mat mat, Vec d1, Vec d2, Mat *J)
{
  MPI_Comm     comm = PetscObjectComm((PetscObject)mat);
  TaoMatADACtx ctx;
  PetscInt     nloc, n;

  PetscFunctionBegin;
  PetscCall(PetscNew(&ctx));
  ctx->A  = mat;
  ctx->D1 = d1;
  ctx->D2 = d2;
  if (d1) {
    PetscCall(VecDuplicate(d1, &ctx->W));
    PetscCall(PetscObjectReference((PetscObject)d1));
  } else {
    ctx->W = NULL;
  }
  if (d2) {
    PetscCall(VecDuplicate(d2, &ctx->W2));
    PetscCall(VecDuplicate(d2, &ctx->ADADiag));
    PetscCall(PetscObjectReference((PetscObject)d2));
  } else {
    ctx->W2      = NULL;
    ctx->ADADiag = NULL;
  }

  ctx->GotDiag = 0;
  PetscCall(PetscObjectReference((PetscObject)mat));

  PetscCall(VecGetLocalSize(d2, &nloc));
  PetscCall(VecGetSize(d2, &n));

  PetscCall(MatCreateShell(comm, nloc, nloc, n, n, ctx, J));
  PetscCall(MatShellSetManageScalingShifts(*J));
  PetscCall(MatShellSetOperation(*J, MATOP_MULT, (PetscErrorCodeFn *)MatMult_ADA));
  PetscCall(MatShellSetOperation(*J, MATOP_DESTROY, (PetscErrorCodeFn *)MatDestroy_ADA));
  PetscCall(MatShellSetOperation(*J, MATOP_VIEW, (PetscErrorCodeFn *)MatView_ADA));
  PetscCall(MatShellSetOperation(*J, MATOP_MULT_TRANSPOSE, (PetscErrorCodeFn *)MatMultTranspose_ADA));
  PetscCall(MatShellSetOperation(*J, MATOP_DIAGONAL_SET, (PetscErrorCodeFn *)MatDiagonalSet_ADA));
  PetscCall(MatShellSetOperation(*J, MATOP_SHIFT, (PetscErrorCodeFn *)MatShift_ADA));
  PetscCall(MatShellSetOperation(*J, MATOP_EQUAL, (PetscErrorCodeFn *)MatEqual_ADA));
  PetscCall(MatShellSetOperation(*J, MATOP_SCALE, (PetscErrorCodeFn *)MatScale_ADA));
  PetscCall(MatShellSetOperation(*J, MATOP_TRANSPOSE, (PetscErrorCodeFn *)MatTranspose_ADA));
  PetscCall(MatShellSetOperation(*J, MATOP_GET_DIAGONAL, (PetscErrorCodeFn *)MatGetDiagonal_ADA));
  PetscCall(MatShellSetOperation(*J, MATOP_CREATE_SUBMATRICES, (PetscErrorCodeFn *)MatCreateSubMatrices_ADA));
  PetscCall(MatShellSetOperation(*J, MATOP_NORM, (PetscErrorCodeFn *)MatNorm_ADA));
  PetscCall(MatShellSetOperation(*J, MATOP_DUPLICATE, (PetscErrorCodeFn *)MatDuplicate_ADA));
  PetscCall(MatShellSetOperation(*J, MATOP_CREATE_SUBMATRIX, (PetscErrorCodeFn *)MatCreateSubMatrix_ADA));

  PetscCall(MatSetOption(*J, MAT_SYMMETRIC, PETSC_TRUE));
  PetscFunctionReturn(PETSC_SUCCESS);
}