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); }