int main(int argc,char **args)
{
Mat Cdense,B,C,Ct;
Vec d;
PetscInt i,j,m = 5,n,nrows,ncols;
const PetscInt *rows,*cols;
IS isrows,iscols;
PetscErrorCode ierr;
PetscScalar *v;
PetscMPIInt rank,size;
PetscReal Cnorm;
PetscBool flg,mats_view=PETSC_FALSE;
ierr = PetscInitialize(&argc,&args,(char*)0,help);
if (ierr) return ierr;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);
CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-m",&m,NULL);
CHKERRQ(ierr);
n = m;
ierr = PetscOptionsGetInt(NULL,NULL,"-n",&n,NULL);
CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,NULL,"-mats_view",&mats_view);
CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&C);
CHKERRQ(ierr);
ierr = MatSetSizes(C,m,n,PETSC_DECIDE,PETSC_DECIDE);
CHKERRQ(ierr);
ierr = MatSetType(C,MATELEMENTAL);
CHKERRQ(ierr);
ierr = MatSetFromOptions(C);
CHKERRQ(ierr);
ierr = MatSetUp(C);
CHKERRQ(ierr);
ierr = MatGetOwnershipIS(C,&isrows,&iscols);
CHKERRQ(ierr);
ierr = ISGetLocalSize(isrows,&nrows);
CHKERRQ(ierr);
ierr = ISGetIndices(isrows,&rows);
CHKERRQ(ierr);
ierr = ISGetLocalSize(iscols,&ncols);
CHKERRQ(ierr);
ierr = ISGetIndices(iscols,&cols);
CHKERRQ(ierr);
ierr = PetscMalloc1(nrows*ncols,&v);
CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
PetscRandom rand;
PetscScalar rval;
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rand);
CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rand);
CHKERRQ(ierr);
for (i=0; i<nrows; i++) {
for (j=0; j<ncols; j++) {
ierr = PetscRandomGetValue(rand,&rval);
CHKERRQ(ierr);
v[i*ncols+j] = rval;
}
}
ierr = PetscRandomDestroy(&rand);
CHKERRQ(ierr);
#else
for (i=0; i<nrows; i++) {
for (j=0; j<ncols; j++) {
v[i*ncols+j] = (PetscReal)(10000*rank+100*rows[i]+cols[j]);
}
}
#endif
ierr = MatSetValues(C,nrows,rows,ncols,cols,v,INSERT_VALUES);
CHKERRQ(ierr);
ierr = ISRestoreIndices(isrows,&rows);
CHKERRQ(ierr);
ierr = ISRestoreIndices(iscols,&cols);
CHKERRQ(ierr);
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = ISDestroy(&isrows);
CHKERRQ(ierr);
ierr = ISDestroy(&iscols);
CHKERRQ(ierr);
/* Test MatView(), MatDuplicate() and out-of-place MatConvert() */
ierr = MatDuplicate(C,MAT_COPY_VALUES,&B);
CHKERRQ(ierr);
if (mats_view) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Duplicated C:\n");
CHKERRQ(ierr);
ierr = MatView(B,PETSC_VIEWER_STDOUT_WORLD);
CHKERRQ(ierr);
}
ierr = MatDestroy(&B);
CHKERRQ(ierr);
ierr = MatConvert(C,MATMPIDENSE,MAT_INITIAL_MATRIX,&Cdense);
CHKERRQ(ierr);
ierr = MatMultEqual(C,Cdense,5,&flg);
CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMETYPE,"Cdense != C. MatConvert() fails");
/* Test MatNorm() */
ierr = MatNorm(C,NORM_1,&Cnorm);
CHKERRQ(ierr);
/* Test MatTranspose(), MatZeroEntries() and MatGetDiagonal() */
ierr = MatTranspose(C,MAT_INITIAL_MATRIX,&Ct);
CHKERRQ(ierr);
ierr = MatConjugate(Ct);
CHKERRQ(ierr);
if (mats_view) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"C's Transpose Conjugate:\n");
CHKERRQ(ierr);
ierr = MatView(Ct,PETSC_VIEWER_STDOUT_WORLD);
CHKERRQ(ierr);
}
ierr = MatZeroEntries(Ct);
CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&d);
CHKERRQ(ierr);
ierr = VecSetSizes(d,m>n ? n : m,PETSC_DECIDE);
CHKERRQ(ierr);
ierr = VecSetFromOptions(d);
CHKERRQ(ierr);
ierr = MatGetDiagonal(C,d);
CHKERRQ(ierr);
if (mats_view) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Diagonal of C:\n");
CHKERRQ(ierr);
ierr = VecView(d,PETSC_VIEWER_STDOUT_WORLD);
CHKERRQ(ierr);
}
if (m>n) {
ierr = MatDiagonalScale(C,NULL,d);
CHKERRQ(ierr);
} else {
ierr = MatDiagonalScale(C,d,NULL);
CHKERRQ(ierr);
}
if (mats_view) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Diagonal Scaled C:\n");
CHKERRQ(ierr);
ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);
CHKERRQ(ierr);
}
/* Test MatAXPY(), MatAYPX() and in-place MatConvert() */
ierr = MatCreate(PETSC_COMM_WORLD,&B);
CHKERRQ(ierr);
ierr = MatSetSizes(B,m,n,PETSC_DECIDE,PETSC_DECIDE);
CHKERRQ(ierr);
ierr = MatSetType(B,MATELEMENTAL);
CHKERRQ(ierr);
ierr = MatSetFromOptions(B);
CHKERRQ(ierr);
ierr = MatSetUp(B);
CHKERRQ(ierr);
ierr = MatGetOwnershipIS(B,&isrows,&iscols);
CHKERRQ(ierr);
ierr = ISGetLocalSize(isrows,&nrows);
CHKERRQ(ierr);
ierr = ISGetIndices(isrows,&rows);
CHKERRQ(ierr);
ierr = ISGetLocalSize(iscols,&ncols);
CHKERRQ(ierr);
ierr = ISGetIndices(iscols,&cols);
CHKERRQ(ierr);
for (i=0; i<nrows; i++) {
for (j=0; j<ncols; j++) {
v[i*ncols+j] = (PetscReal)(1000*rows[i]+cols[j]);
}
}
ierr = MatSetValues(B,nrows,rows,ncols,cols,v,INSERT_VALUES);
CHKERRQ(ierr);
ierr = PetscFree(v);
CHKERRQ(ierr);
ierr = ISRestoreIndices(isrows,&rows);
CHKERRQ(ierr);
ierr = ISRestoreIndices(iscols,&cols);
CHKERRQ(ierr);
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = MatAXPY(B,2.5,C,SAME_NONZERO_PATTERN);
CHKERRQ(ierr);
ierr = MatAYPX(B,3.75,C,SAME_NONZERO_PATTERN);
CHKERRQ(ierr);
ierr = MatConvert(B,MATDENSE,MAT_INPLACE_MATRIX,&B);
CHKERRQ(ierr);
if (mats_view) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"B after MatAXPY and MatAYPX:\n");
CHKERRQ(ierr);
ierr = MatView(B,PETSC_VIEWER_STDOUT_WORLD);
CHKERRQ(ierr);
}
ierr = ISDestroy(&isrows);
CHKERRQ(ierr);
ierr = ISDestroy(&iscols);
CHKERRQ(ierr);
ierr = MatDestroy(&B);
CHKERRQ(ierr);
/* Test MatMatTransposeMult(): B = C*C^T */
ierr = MatMatTransposeMult(C,C,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B);
CHKERRQ(ierr);
if (mats_view) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"C MatMatTransposeMult C:\n");
CHKERRQ(ierr);
ierr = MatView(B,PETSC_VIEWER_STDOUT_WORLD);
CHKERRQ(ierr);
}
ierr = MatDestroy(&Cdense);
CHKERRQ(ierr);
ierr = PetscFree(v);
CHKERRQ(ierr);
ierr = MatDestroy(&B);
CHKERRQ(ierr);
ierr = MatDestroy(&C);
CHKERRQ(ierr);
ierr = MatDestroy(&Ct);
CHKERRQ(ierr);
ierr = VecDestroy(&d);
CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
/*@
SVDSetUp - Sets up all the internal data structures necessary for the
execution of the singular value solver.
Collective on SVD
Input Parameter:
. svd - singular value solver context
Level: advanced
Notes:
This function need not be called explicitly in most cases, since SVDSolve()
calls it. It can be useful when one wants to measure the set-up time
separately from the solve time.
.seealso: SVDCreate(), SVDSolve(), SVDDestroy()
@*/
PetscErrorCode SVDSetUp(SVD svd)
{
PetscErrorCode ierr;
PetscBool expltrans,flg;
PetscInt M,N,k;
SlepcSC sc;
Vec *T;
PetscFunctionBegin;
PetscValidHeaderSpecific(svd,SVD_CLASSID,1);
if (svd->setupcalled) PetscFunctionReturn(0);
ierr = PetscLogEventBegin(SVD_SetUp,svd,0,0,0);CHKERRQ(ierr);
/* reset the convergence flag from the previous solves */
svd->reason = SVD_CONVERGED_ITERATING;
/* Set default solver type (SVDSetFromOptions was not called) */
if (!((PetscObject)svd)->type_name) {
ierr = SVDSetType(svd,SVDCROSS);CHKERRQ(ierr);
}
if (!svd->ds) { ierr = SVDGetDS(svd,&svd->ds);CHKERRQ(ierr); }
ierr = DSReset(svd->ds);CHKERRQ(ierr);
if (!((PetscObject)svd->rand)->type_name) {
ierr = PetscRandomSetFromOptions(svd->rand);CHKERRQ(ierr);
}
/* check matrix */
if (!svd->OP) SETERRQ(PetscObjectComm((PetscObject)svd),PETSC_ERR_ARG_WRONGSTATE,"SVDSetOperator must be called first");
/* determine how to handle the transpose */
expltrans = PETSC_TRUE;
if (svd->impltrans) expltrans = PETSC_FALSE;
else {
ierr = MatHasOperation(svd->OP,MATOP_TRANSPOSE,&flg);CHKERRQ(ierr);
if (!flg) expltrans = PETSC_FALSE;
else {
ierr = PetscObjectTypeCompare((PetscObject)svd,SVDLAPACK,&flg);CHKERRQ(ierr);
if (flg) expltrans = PETSC_FALSE;
}
}
/* build transpose matrix */
ierr = MatDestroy(&svd->A);CHKERRQ(ierr);
ierr = MatDestroy(&svd->AT);CHKERRQ(ierr);
ierr = MatGetSize(svd->OP,&M,&N);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)svd->OP);CHKERRQ(ierr);
if (expltrans) {
if (M>=N) {
svd->A = svd->OP;
ierr = MatTranspose(svd->OP,MAT_INITIAL_MATRIX,&svd->AT);CHKERRQ(ierr);
ierr = MatConjugate(svd->AT);CHKERRQ(ierr);
} else {
ierr = MatTranspose(svd->OP,MAT_INITIAL_MATRIX,&svd->A);CHKERRQ(ierr);
ierr = MatConjugate(svd->A);CHKERRQ(ierr);
svd->AT = svd->OP;
}
} else {
if (M>=N) {
svd->A = svd->OP;
svd->AT = NULL;
} else {
svd->A = NULL;
svd->AT = svd->OP;
}
}
/* swap initial vectors if necessary */
if (M<N) {
T=svd->ISL; svd->ISL=svd->IS; svd->IS=T;
k=svd->ninil; svd->ninil=svd->nini; svd->nini=k;
}
if (svd->ncv > PetscMin(M,N)) svd->ncv = PetscMin(M,N);
if (svd->nsv > PetscMin(M,N)) svd->nsv = PetscMin(M,N);
if (svd->ncv && svd->nsv > svd->ncv) SETERRQ(PetscObjectComm((PetscObject)svd),PETSC_ERR_ARG_OUTOFRANGE,"nsv bigger than ncv");
/* call specific solver setup */
ierr = (*svd->ops->setup)(svd);CHKERRQ(ierr);
/* set tolerance if not yet set */
if (svd->tol==PETSC_DEFAULT) svd->tol = SLEPC_DEFAULT_TOL;
/* fill sorting criterion context */
ierr = DSGetSlepcSC(svd->ds,&sc);CHKERRQ(ierr);
sc->comparison = (svd->which==SVD_LARGEST)? SlepcCompareLargestReal: SlepcCompareSmallestReal;
sc->comparisonctx = NULL;
sc->map = NULL;
sc->mapobj = NULL;
/* process initial vectors */
if (svd->nini<0) {
k = -svd->nini;
if (k>svd->ncv) SETERRQ(PetscObjectComm((PetscObject)svd),1,"The number of initial vectors is larger than ncv");
ierr = BVInsertVecs(svd->V,0,&k,svd->IS,PETSC_TRUE);CHKERRQ(ierr);
ierr = SlepcBasisDestroy_Private(&svd->nini,&svd->IS);CHKERRQ(ierr);
svd->nini = k;
}
if (svd->ninil<0) {
k = 0;
if (svd->leftbasis) {
k = -svd->ninil;
if (k>svd->ncv) SETERRQ(PetscObjectComm((PetscObject)svd),1,"The number of left initial vectors is larger than ncv");
ierr = BVInsertVecs(svd->U,0,&k,svd->ISL,PETSC_TRUE);CHKERRQ(ierr);
} else {
ierr = PetscInfo(svd,"Ignoring initial left vectors\n");CHKERRQ(ierr);
}
ierr = SlepcBasisDestroy_Private(&svd->ninil,&svd->ISL);CHKERRQ(ierr);
svd->ninil = k;
}
ierr = PetscLogEventEnd(SVD_SetUp,svd,0,0,0);CHKERRQ(ierr);
svd->setupcalled = 1;
PetscFunctionReturn(0);
}
static void PETScMatvecGenColumnMajor(void *x, PRIMME_INT ldx, void *y, PRIMME_INT ldy,
int blockSize, int trans, Mat matrix, MPI_Comm comm) {
PetscInt m, n, mLocal, nLocal;
PetscErrorCode ierr;
Mat X, Y, X0, Y0;
int xcompact, ycompact;
if (blockSize == 1) {
PETScMatvecGenNoBlock(x, ldx, y, ldy, blockSize, trans, matrix, comm);
return;
}
assert(sizeof(PetscScalar) == sizeof(SCALAR));
ierr = MatGetSize(matrix, &m, &n); CHKERRABORT(comm, ierr);
ierr = MatGetLocalSize(matrix, &mLocal, &nLocal); CHKERRABORT(comm, ierr);
if (trans == 0) {
ierr = MatCreateDense(comm,nLocal,PETSC_DECIDE,n,blockSize,x,&X);CHKERRABORT(comm, ierr);
ierr = MatCreateDense(comm,mLocal,PETSC_DECIDE,m,blockSize,y,&Y);CHKERRABORT(comm, ierr);
xcompact = nLocal == ldx;
ycompact = mLocal == ldy;
}
else {
ierr = MatCreateDense(comm,mLocal,PETSC_DECIDE,m,blockSize,x,&X);CHKERRABORT(comm, ierr);
ierr = MatCreateDense(comm,nLocal,PETSC_DECIDE,n,blockSize,y,&Y);CHKERRABORT(comm, ierr);
xcompact = mLocal == ldx;
ycompact = nLocal == ldy;
}
ierr = MatDenseGetLocalMatrix(X, &X0);CHKERRABORT(comm, ierr);
ierr = MatSeqDenseSetLDA(X0, (PetscInt)ldx);CHKERRABORT(comm, ierr);
ierr = MatDenseGetLocalMatrix(Y, &Y0);CHKERRABORT(comm, ierr);
ierr = MatSeqDenseSetLDA(Y0, (PetscInt)ldy);CHKERRABORT(comm, ierr);
/* MatMatMult doesn't support X to be non-contiguous */
if (xcompact) {
X0 = X;
}
else {
ierr = MatDuplicate(X, MAT_COPY_VALUES, &X0);CHKERRABORT(comm, ierr);
}
if (trans == 0) {
if (ycompact) {
ierr = MatMatMult(matrix, X0, MAT_REUSE_MATRIX, PETSC_DEFAULT, &Y); CHKERRABORT(comm, ierr);
}
else {
ierr = MatMatMult(matrix, X0, MAT_INITIAL_MATRIX, PETSC_DEFAULT, &Y0); CHKERRABORT(comm, ierr);
ierr = MatCopy(Y0, Y, SAME_NONZERO_PATTERN); CHKERRABORT(comm, ierr);
ierr = MatDestroy(&Y0); CHKERRABORT(comm, ierr);
}
}
else {
/* A^H*X is not implemented in PETSc, do instead (A^T*X^c)^c */
ierr = MatConjugate(X0); CHKERRABORT(comm, ierr);
if (ycompact) {
ierr = MatTransposeMatMult(matrix, X0, MAT_REUSE_MATRIX, PETSC_DEFAULT, &Y); CHKERRABORT(comm, ierr);
}
else {
ierr = MatTransposeMatMult(matrix, X0, MAT_INITIAL_MATRIX, PETSC_DEFAULT, &Y0); CHKERRABORT(comm, ierr);
ierr = MatCopy(Y0, Y, SAME_NONZERO_PATTERN); CHKERRABORT(comm, ierr);
ierr = MatDestroy(&Y0); CHKERRABORT(comm, ierr);
}
ierr = MatConjugate(Y); CHKERRABORT(comm, ierr);
if (xcompact) {
ierr = MatConjugate(X0); CHKERRABORT(comm, ierr);
}
}
if (!xcompact) {
ierr = MatDestroy(&X0);CHKERRABORT(comm, ierr);
}
ierr = MatDestroy(&X);CHKERRABORT(comm, ierr);
ierr = MatDestroy(&Y);CHKERRABORT(comm, ierr);
}
