Subversion Repositories slepc-dev

/*

   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

   SLEPc - Scalable Library for Eigenvalue Problem Computations

   Copyright (c) 2002-2010, Universidad Politecnica de Valencia, Spain

   This file is part of SLEPc.

   SLEPc is free software: you can redistribute it and/or modify it under  the

   terms of version 3 of the GNU Lesser General Public License as published by

   the Free Software Foundation.

   SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY

   WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS

   FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for

   more details.

   You  should have received a copy of the GNU Lesser General  Public  License

   along with SLEPc. If not, see <http://www.gnu.org/licenses/>.

   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

*/

#ifndef __MATDENSE_H

#define __MATDENSE_H

#include <slepcmatdense.h>

typedef struct _MatDenseOps *MatDenseOps;

struct _MatDenseOps {

  /* 0*/

  PetscErrorCode (*getarray)(MatDense,PetscScalar**);

  PetscErrorCode (*restorearray)(MatDense,PetscScalar**);

  PetscErrorCode (*getarrayread)(MatDense,const PetscScalar**);

  PetscErrorCode (*restorearrayread)(MatDense,const PetscScalar**);

  PetscErrorCode (*duplicate)(MatDense,MatDenseDuplicateOption,MatDense*);

  /* 5 */

  PetscErrorCode (*axpy)(MatDense,PetscScalar,MatDense);

  PetscErrorCode (*copy)(MatDense,MatDense);

  PetscErrorCode (*setexplicit)(MatDense);

  PetscErrorCode (*blas_axpy)(PetscInt,PetscScalar,MatDense,PetscInt,PetscInt,MatDense,PetscInt,PetscInt);

  PetscErrorCode (*blas_copy)(PetscInt,MatDense,PetscInt,PetscInt,MatDense,PetscInt,PetscInt);

  /* 10 */

  PetscErrorCode (*destroy)(MatDense);

  PetscErrorCode (*view)(MatDense,PetscViewer);

  PetscErrorCode (*setfromoptions)(MatDense);

  PetscErrorCode (*matmult)(MatDense,PetscScalar,PetscScalar,MatDense,PetscBool,MatDense,PetscBool);

  PetscErrorCode (*matmult_blas)(MatDense,PetscScalar,PetscScalar,MatDense,PetscBool,MatDense,PetscBool);

  /* 15 */

  PetscErrorCode (*setsizes)(MatDense,PetscInt,PetscInt,PetscInt,PetscInt);

  PetscErrorCode (*setuppreallocation)(MatDense);

  PetscErrorCode (*aresiblings)(MatDense,MatDense,PetscBool*);

  PetscErrorCode (*serialize)(MatDense,PetscInt*,PetscScalar*);

  PetscErrorCode (*deserialize)(MatDense,PetscInt,PetscScalar*);

  PetscErrorCode (*create)(MatDense);  

};

struct _p_MatDense {

  PETSCHEADER(struct _MatDenseOps);

  void                   *data;            /* implementation-specific data */

  PetscInt               ld;               /* Lapack leading dimension of data */

  PetscInt               Mmax,Nmax;        /* indicates the largest dimensions of data possible */

  PetscInt               m0,n0,m,n;        /* indicates the current displacement and dimensions */

  PetscBool              is_allocated;     /* indicates where is the last valid copy of the data */

  PetscBool              is_hermitian,is_triangular,is_impl; /* indicates properties of the matrix and how it is stored */

  PetscInt               matmult_buffersize;

                                           /* suggested size of the operator in bytes for storing the result in MatDenseMatMult_Siblings */

  PetscBool              use_impl;         /* indicates if optimized functions for Hermitian or triangular matrix will be used  */

  PetscBool              use_mpi_queue;    /* indicates if the synchronous MPI operations are queued */

  PetscInt               n_getarray;       /* number of unrestored GetArray operations */

  PetscBool              is_pending;       /* indicates if a reduction is been performing */

};

/*MC

   PetscObjectQueryPolymorphicFunction1 - Returns in R the best function for the

   operation F, considering the type of A.

   Synopsis:

   PetscObjectQueryPolymorphicFunction(PetscObject A,field,const char *N,void *(*R)(void),PetscBool err)

   Not Collective

   Input Parameters:

+  A - PetscObject that participate in the operation

.  field - name of the field in structure ops that contains the function pointer

.  N - name of routine

-  err - if PETSC_TRUE, PetscError is called when any function is found

   Output Parameters:

.  R - the function pointer

   Level: development

M*/

#define PetscObjectQueryPolymorphicFunction1(A,F,N,R,E) { \

  if ((A)->ops->F) { \

    *(R) = (A)->ops->F; \

  } else {  \

    /* dispatch based on the type of A and B */ \

    char           name[256]; \

    PetscInt       i; \

    PetscErrorCode ierr; \

    for (i=0, *(R)=PETSC_NULL; !*(R) && i<2; i++) { \

      ierr = PetscStrcpy(name,N "_");CHKERRQ(ierr); \

      if (i == 0) { ierr = PetscStrcat(name,((PetscObject)(A))->type_name);CHKERRQ(ierr); } \

      else { ierr = PetscStrcat(name,"*");CHKERRQ(ierr); } \

      ierr = PetscStrcat(name,"_C");CHKERRQ(ierr); /* e.g., multname = "MatMatMult_seqdense_seqaij_C" */ \

      ierr = PetscObjectQueryFunction((PetscObject)(A),name,(void (**)(void))(R));CHKERRQ(ierr); \

    } \

    if (!*(R) && (E) == PETSC_TRUE) SETERRQ1(((PetscObject)(A))->comm,PETSC_ERR_ARG_INCOMP,N " requires compatible matrix, instead of %s",((PetscObject)(A))->type_name); \

  } \

}

/*MC

   PetscObjectQueryPolymorphicFunction - Returns in R the best function for the

   operation F, considering the types of A and B.

   Synopsis:

   PetscObjectQueryPolymorphicFunction(PetscObject A,PetscObject B,field,const char *N,void *(*R)(void),PetscBool err)

   Not Collective

   Input Parameters:

+  A,B - PetscObjects that participate in the operation

.  field - name of the field in structure ops that contains the function pointer

.  N - name of routine

-  err - if PETSC_TRUE, PetscError is called when any function is found

   Output Parameters:

.  R - the function pointer

   Level: development

M*/

#define PetscObjectQueryPolymorphicFunction(A,B,F,N,R,E) { \

  if ((A)->ops->F == (B)->ops->F && (A)->ops->F) { \

    *(R) = (A)->ops->F; \

  } else {  \

    /* dispatch based on the type of A and B */ \

    char           name[256]; \

    PetscInt       i; \

    PetscErrorCode ierr; \

    for (i=0, *(R)=PETSC_NULL; !*(R) && i<3; i++) { \

      ierr = PetscStrcpy(name,N "_");CHKERRQ(ierr); \

      if (!(i & 1)) { ierr = PetscStrcat(name,((PetscObject)(A))->type_name);CHKERRQ(ierr); } \

      else { ierr = PetscStrcat(name,"*");CHKERRQ(ierr); } \

      ierr = PetscStrcat(name,"_");CHKERRQ(ierr); \

      if (!(i & 2)) { ierr = PetscStrcat(name,((PetscObject)(B))->type_name);CHKERRQ(ierr); } \

      else { ierr = PetscStrcat(name,"*");CHKERRQ(ierr); } \

      ierr = PetscStrcat(name,"_C");CHKERRQ(ierr); /* e.g., multname = "MatMatMult_seqdense_seqaij_C" */ \

      ierr = PetscObjectQueryFunction((PetscObject)(A),name,(void (**)(void))(R));CHKERRQ(ierr); \

      if (!*(R)) { \

        ierr = PetscObjectQueryFunction((PetscObject)(B),name,(void (**)(void))(R));CHKERRQ(ierr); \

      } \

    } \

    if (!*(R) && (E) == PETSC_TRUE) SETERRQ2(((PetscObject)(A))->comm,PETSC_ERR_ARG_INCOMP,N " requires compatible matrices, instead of %s and %s",((PetscObject)(A))->type_name,((PetscObject)(B))->type_name); \

  } \

}

PetscErrorCode  MatDensePerformReduction(MatDense A,MPI_Op op,PetscBool immediate);

#undef __FUNCT__  

#define __FUNCT__ "PetscCheckMatDenseForRead"

PETSC_STATIC_INLINE PetscErrorCode PetscCheckMatDenseForRead(MatDense A)

{

  PetscErrorCode  ierr;

  PetscFunctionBegin;

  if (!(A->is_allocated == PETSC_TRUE)) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix");

  if (A->is_pending && A->n_getarray == 0) {

    ierr = MatDensePerformReduction(PETSC_NULL,PETSC_NULL,PETSC_TRUE);CHKERRQ(ierr);

  }

  PetscFunctionReturn(0);

}

#undef __FUNCT__  

#define __FUNCT__ "PetscCheckMatDenseForWrite"

PETSC_STATIC_INLINE PetscErrorCode PetscCheckMatDenseForWrite(MatDense A)

{

  PetscErrorCode  ierr;

  ierr = MatDenseSetUpPreallocation(A);CHKERRQ(ierr);

  if (!(A->is_allocated == PETSC_TRUE)) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix");

  if (A->is_pending && A->n_getarray == 0) {

    ierr = MatDensePerformReduction(PETSC_NULL,PETSC_NULL,PETSC_TRUE);CHKERRQ(ierr);

  }

  PetscFunctionReturn(0);

}

#undef __FUNCT__  

#define __FUNCT__ "PetscCheckMatDenseForUpdate"

PETSC_STATIC_INLINE PetscErrorCode PetscCheckMatDenseForUpdate(MatDense A)

{

  PetscErrorCode  ierr;

  ierr = MatDenseSetUpPreallocation(A);CHKERRQ(ierr);

  if (!(A->is_allocated == PETSC_TRUE)) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix");

  if (A->is_pending && A->n_getarray == 0) {

    ierr = MatDensePerformReduction(PETSC_NULL,PETSC_NULL,PETSC_TRUE);CHKERRQ(ierr);

  }

  PetscFunctionReturn(0);

}

#define MatDenseIsHermitian(A) (A->is_hermitian == PETSC_TRUE)

#define MatDenseIsTriangular(A) (A->is_triangular == PETSC_TRUE)

#define MatDenseIsImplicit(A) (A->is_impl == PETSC_TRUE)

#define MatDenseIsImplicitHermitian(A) (MatDenseIsHermitian(A) && MatDenseIsImplicit(A))

#define MatDenseIsExplicitHermitian(A) (MatDenseIsHermitian(A) && !MatDenseIsImplicit(A))

#define MatDenseIsImplicitTriangular(A) (MatDenseIsTriangular(A) && MatDenseIsImplicit(A))

#define MatDenseIsExplicitTriangular(A) (MatDenseIsTriangular(A) && !MatDenseIsImplicit(A))

#define MatDenseIsSimple(A) (!MatDenseIsHermitian(A) && !MatDenseIsTriangular(A))

PetscErrorCode MatDenseRegisterAll(const char *path);

extern PetscLogEvent    MATDENSE_Duplicate,MATDENSE_SetUpPreallocation,MATDENSE_MatMult,MATDENSE_Copy,MATDENSE_AXPY,MATDENSE_View,MATDENSE_Convert,MATDENSE_BlasMatMult;

#endif