/*
SNESVIComputeJacobian - Computes the jacobian of the semismooth function.The Jacobian for the semismooth function is an element of the B-subdifferential of the Fischer-Burmeister function for complementarity problems.
Input Parameters:
. Da - Diagonal shift vector for the semismooth jacobian.
. Db - Row scaling vector for the semismooth jacobian.
Output Parameters:
. jac - semismooth jacobian
. jac_pre - optional preconditioning matrix
Notes:
The semismooth jacobian matrix is given by
jac = Da + Db*jacfun
where Db is the row scaling matrix stored as a vector,
Da is the diagonal perturbation matrix stored as a vector
and jacfun is the jacobian of the original nonlinear function.
*/
PetscErrorCode SNESVIComputeJacobian(Mat jac, Mat jac_pre,Vec Da, Vec Db)
{
PetscErrorCode ierr;
/* Do row scaling and add diagonal perturbation */
ierr = MatDiagonalScale(jac,Db,NULL);CHKERRQ(ierr);
ierr = MatDiagonalSet(jac,Da,ADD_VALUES);CHKERRQ(ierr);
if (jac != jac_pre) { /* If jac and jac_pre are different */
ierr = MatDiagonalScale(jac_pre,Db,NULL);CHKERRQ(ierr);
ierr = MatDiagonalSet(jac_pre,Da,ADD_VALUES);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat A;
Vec x;
PetscErrorCode ierr;
PetscViewer fd; /* viewer */
char file[PETSC_MAX_PATH_LEN]; /* input file name */
PetscReal norm;
PetscBool flg;
PetscInitialize(&argc,&args,(char*)0,help);
/* Determine file from which we read the matrix A */
ierr = PetscOptionsGetString(NULL,"-f",file,PETSC_MAX_PATH_LEN,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_WORLD,1,"Must indicate binary file with the -f option");
/* Load matrix A */
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file,FILE_MODE_READ,&fd);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatLoad(A,fd);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&fd);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&x,NULL);CHKERRQ(ierr);
ierr = MatGetDiagonal(A,x);CHKERRQ(ierr);
ierr = VecScale(x,-1.0);CHKERRQ(ierr);
ierr = MatDiagonalSet(A,x,ADD_VALUES);CHKERRQ(ierr);
ierr = MatGetDiagonal(A,x);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm %g\n",(double)norm);CHKERRQ(ierr);
/* Free data structures */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
void PetscSparseStorage::setToDiagonal( OoqpVector& vec_in )
{
int ierr;
PetscVector & vec = dynamic_cast<PetscVector &>(vec_in);
ierr = MatZeroEntries( M ); assert( ierr == 0);
ierr = MatDiagonalSet( M, vec.pv, INSERT_VALUES );
}
PetscErrorCode MatDiagonalSet_SMF(Mat M, Vec D,InsertMode is)
{
MatSubMatFreeCtx ctx;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MatShellGetContext(M,(void **)&ctx);CHKERRQ(ierr);
ierr = MatDiagonalSet(ctx->A,D,is);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc, char **argv)
{
PetscErrorCode ierr;
Mat A;
KSP ksp;
PC pc;
IS zero, one;
MatNullSpace nullsp;
Vec x, b;
MPI_Comm comm;
PetscInitialize(&argc, &argv, NULL, NULL);
comm = PETSC_COMM_WORLD;
ierr = MatCreate(comm, &A);CHKERRQ(ierr);
ierr = MatSetSizes(A, 4, 4, PETSC_DECIDE, PETSC_DECIDE);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatCreateVecs(A, &x, &b);CHKERRQ(ierr);
ierr = VecSet(x, 2.0);CHKERRQ(ierr);
ierr = VecSet(b, 12.0);CHKERRQ(ierr);
ierr = MatDiagonalSet(A, x, INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = ISCreateStride(comm, 2, 0, 1, &zero);CHKERRQ(ierr);
ierr = ISCreateStride(comm, 2, 2, 1, &one);CHKERRQ(ierr);
ierr = MatNullSpaceCreate(comm, PETSC_TRUE, 0, NULL, &nullsp);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)zero, "nullspace",(PetscObject)nullsp);CHKERRQ(ierr);
ierr = KSPCreate(comm, &ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp, A, A);CHKERRQ(ierr);
ierr = KSPSetUp(ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = PCFieldSplitSetIS(pc, "0", zero);
ierr = PCFieldSplitSetIS(pc, "1", one);
ierr = KSPSolve(ksp, b, x);CHKERRQ(ierr);
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nullsp);CHKERRQ(ierr);
ierr = ISDestroy(&zero);CHKERRQ(ierr);
ierr = ISDestroy(&one);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
PetscFinalize();
return 0;
}
PetscErrorCode Tao_SSLS_FunctionGradient(TaoLineSearch ls, Vec X, PetscReal *fcn, Vec G, void *ptr)
{
Tao tao = (Tao)ptr;
TAO_SSLS *ssls = (TAO_SSLS *)tao->data;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = TaoComputeConstraints(tao, X, tao->constraints);CHKERRQ(ierr);
ierr = VecFischer(X,tao->constraints,tao->XL,tao->XU,ssls->ff);CHKERRQ(ierr);
ierr = VecNorm(ssls->ff,NORM_2,&ssls->merit);CHKERRQ(ierr);
*fcn = 0.5*ssls->merit*ssls->merit;
ierr = TaoComputeJacobian(tao,tao->solution,tao->jacobian,tao->jacobian_pre);CHKERRQ(ierr);
ierr = MatDFischer(tao->jacobian, tao->solution, tao->constraints,tao->XL, tao->XU, ssls->t1, ssls->t2,ssls->da, ssls->db);CHKERRQ(ierr);
ierr = MatDiagonalScale(tao->jacobian,ssls->db,NULL);CHKERRQ(ierr);
ierr = MatDiagonalSet(tao->jacobian,ssls->da,ADD_VALUES);CHKERRQ(ierr);
ierr = MatMultTranspose(tao->jacobian,ssls->ff,G);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
K is the discretiziation of the Laplacian
G is the discretization of the gradient
Computes Jacobian of K u + diag(u) G u which is given by
K + diag(u)G + diag(Gu)
*/
PetscErrorCode RHSJacobian(TS ts,PetscReal t,Vec globalin,Mat A, Mat B,void *ctx)
{
PetscErrorCode ierr;
AppCtx *appctx = (AppCtx*)ctx;
Vec Gglobalin;
PetscFunctionBegin;
/* A = diag(u) G */
ierr = MatCopy(appctx->SEMop.grad,A,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatDiagonalScale(A,globalin,NULL);CHKERRQ(ierr);
/* A = A + diag(Gu) */
ierr = VecDuplicate(globalin,&Gglobalin);CHKERRQ(ierr);
ierr = MatMult(appctx->SEMop.grad,globalin,Gglobalin);CHKERRQ(ierr);
ierr = MatDiagonalSet(A,Gglobalin,ADD_VALUES);CHKERRQ(ierr);
ierr = VecDestroy(&Gglobalin);CHKERRQ(ierr);
/* A = K - A */
ierr = MatScale(A,-1.0);CHKERRQ(ierr);
ierr = MatAXPY(A,0.0,appctx->SEMop.keptstiff,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Builds
B Y1 X1 Bt
and creates a ksp when C=0, otherwise it builds
B Y1 X1 Bt - C
*/
PetscErrorCode BSSCR_PCScGtKGUseStandardBBtOperator( PC pc )
{
PC_SC_GtKG ctx = (PC_SC_GtKG)pc->data;
PetscReal fill;
Mat diag_mat,C;
Vec diag;
PetscInt M,N, m,n;
MPI_Comm comm;
PetscInt nnz_I, nnz_G;
MatType mtype;
const char *prefix;
Mat BBt;
KSP ksp;
PetscTruth ivalue, flg, has_cnst_nullsp;
BSSCR_BSSCR_pc_error_ScGtKG( pc, __func__ );
/* Assemble BBt */
MatGetSize( ctx->Bt, &M, &N );
MatGetLocalSize( ctx->Bt, &m, &n );
MatGetVecs( ctx->Bt, PETSC_NULL, &diag );
/* Define diagonal matrix Y1 X1 */
VecPointwiseMult( diag, ctx->Y1, ctx->X1 );
PetscObjectGetComm( (PetscObject)ctx->F, &comm );
MatCreate( comm, &diag_mat );
MatSetSizes( diag_mat, m,m , M, M );
#if (((PETSC_VERSION_MAJOR==3) && (PETSC_VERSION_MINOR>=3)) || (PETSC_VERSION_MAJOR>3) )
MatSetUp(diag_mat);
#endif
MatGetType( ctx->Bt, &mtype );
MatSetType( diag_mat, mtype );
MatDiagonalSet( diag_mat, diag, INSERT_VALUES );
/* Build operator B Y1 X1 Bt */
BSSCR_BSSCR_get_number_nonzeros_AIJ_ScGtKG( diag_mat, &nnz_I );
BSSCR_BSSCR_get_number_nonzeros_AIJ_ScGtKG( ctx->Bt, &nnz_G );
/*
Not sure the best way to estimate the fill factor.
BBt is a laplacian on the pressure space.
This might tell us something useful...
*/
fill = (PetscReal)(nnz_G)/(PetscReal)( nnz_I );
MatPtAP( diag_mat, ctx->Bt, MAT_INITIAL_MATRIX, fill, &BBt );
Stg_MatDestroy(&diag_mat );
Stg_VecDestroy(&diag );
C = ctx->C;
if( C !=PETSC_NULL ) {
MatAXPY( BBt, -1.0, C, DIFFERENT_NONZERO_PATTERN );
}
/* Build the solver */
KSPCreate( ((PetscObject)pc)->comm, &ksp );
Stg_KSPSetOperators( ksp, BBt, BBt, SAME_NONZERO_PATTERN );
PCGetOptionsPrefix( pc,&prefix );
KSPSetOptionsPrefix( ksp, prefix );
KSPAppendOptionsPrefix( ksp, "pc_gtkg_" ); /* -pc_GtKG_ksp_type <type>, -ksp_GtKG_pc_type <type> */
BSSCR_PCScGtKGSetKSP( pc, ksp );
BSSCR_MatContainsConstNullSpace( BBt, NULL, &has_cnst_nullsp );
if( has_cnst_nullsp == PETSC_TRUE ) {
BSSCR_PCScGtKGAttachNullSpace( pc );
}
PetscOptionsGetTruth( PETSC_NULL, "-pc_gtkg_monitor", &ivalue, &flg );
BSSCR_PCScGtKGSetSubKSPMonitor( pc, ivalue );
Stg_KSPDestroy(&ksp);
Stg_MatDestroy(&BBt);
PetscFunctionReturn(0);
}
void _Stokes_SLE_PenaltySolver_Solve( void* solver,void* stokesSLE ) {
Stokes_SLE_PenaltySolver* self = (Stokes_SLE_PenaltySolver*)solver;
Stokes_SLE* sle = (Stokes_SLE*)stokesSLE;
/* Create shortcuts to stuff needed on sle */
Mat kMatrix = sle->kStiffMat->matrix;
Mat gradMat = sle->gStiffMat->matrix;
Mat divMat = NULL;
Mat C_Mat = sle->cStiffMat->matrix;
Vec uVec = sle->uSolnVec->vector;
Vec pVec = sle->pSolnVec->vector;
Vec fVec = sle->fForceVec->vector;
Vec hVec = sle->hForceVec->vector;
Vec hTempVec;
Vec fTempVec;
Vec penalty;
Mat GTrans, kHat;
KSP ksp_v;
double negOne=-1.0;
double one=1.0;
Mat C_InvMat;
Vec diagC;
PC pc;
int rank;
MPI_Comm_rank( MPI_COMM_WORLD, &rank );
Journal_DPrintf( self->debug, "In %s():\n", __func__ );
VecDuplicate( hVec, &hTempVec );
VecDuplicate( fVec, &fTempVec );
VecDuplicate( pVec, &diagC );
if( sle->dStiffMat == NULL ) {
Journal_DPrintf( self->debug, "Div matrix == NULL : Problem is assumed to be symmetric. ie Div = GTrans \n");
#if( PETSC_VERSION_MAJOR <= 2 )
MatTranspose( gradMat, >rans );
#else
MatTranspose( gradMat, MAT_INITIAL_MATRIX, >rans );
#endif
divMat = GTrans;
}
else {
MatType type;
PetscInt size[2];
MatGetType( sle->dStiffMat->matrix, &type );
MatGetLocalSize( sle->dStiffMat->matrix, size + 0, size + 1 );
/* make a copy we can play with */
MatCreate( sle->comm, >rans );
MatSetSizes( GTrans, size[0], size[1], PETSC_DECIDE, PETSC_DECIDE );
MatSetType( GTrans, type );
#if (((PETSC_VERSION_MAJOR==3) && (PETSC_VERSION_MINOR>=3)) || (PETSC_VERSION_MAJOR>3) )
MatSetUp(GTrans);
#endif
MatCopy( sle->dStiffMat->matrix, GTrans, DIFFERENT_NONZERO_PATTERN );
divMat = GTrans;
}
Stokes_SLE_PenaltySolver_MakePenalty( self, sle, &penalty );
/* Create CInv */
MatGetDiagonal( C_Mat, diagC );
VecReciprocal( diagC );
VecPointwiseMult( diagC, penalty, diagC );
{ /* Print the maximum and minimum penalties in my system. */
PetscInt idx;
PetscReal min, max;
VecMin( diagC, &idx, &min );
VecMax( diagC, &idx, &max );
if( rank == 0 ) {
printf( "PENALTY RANGE:\n" );
printf( " MIN: %e\n", min );
printf( " MAX: %e\n", max );
}
}
MatDiagonalSet( C_Mat, diagC, INSERT_VALUES );
C_InvMat = C_Mat; /* Use pointer CInv since C has been inverted */
/* Build RHS : rhs = f - GCInv h */
MatMult( C_InvMat, hVec, hTempVec ); /* hTempVec = C_InvMat * hVec */
VecScale( hTempVec, -1.0 );
MatMult( gradMat, hTempVec, fTempVec );
#if 0
VecPointwiseMult( fTempVec, penalty, fTempVec );
{ /* Print the maximum and minimum penalties in my system. */
PetscInt idx;
PetscReal min, max;
VecMin( fTempVec, &idx, &min );
VecMax( fTempVec, &idx, &max );
printf( "PENALTY RANGE:\n" );
printf( " MIN: %e\n", min );
printf( " MAX: %e\n", max );
}
#endif
VecAXPY( fTempVec, 1.0, fVec );
/*MatMultAdd( gradMat, hTempVec, fVec, fTempVec );*/
/* Build G CInv GTrans */
/* MatTranspose( gradMat, >rans ); */
/* since CInv is diagonal we can just scale mat entries by the diag vector */
MatDiagonalScale( divMat, diagC, PETSC_NULL ); /* Div = CInve Div */
MatMatMult( gradMat, divMat, MAT_INITIAL_MATRIX, PETSC_DEFAULT, &kHat );
/*MatDiagonalScale( kHat, penalty, PETSC_NULL );*/
MatScale( kHat, -1.0 );
MatAXPY( kMatrix, 1.0, kHat, SAME_NONZERO_PATTERN );
/* Setup solver context and make sure that it uses a direct solver */
KSPCreate( sle->comm, &ksp_v );
Stg_KSPSetOperators( ksp_v, kMatrix, kMatrix, DIFFERENT_NONZERO_PATTERN );
KSPSetType( ksp_v, KSPPREONLY );
KSPGetPC( ksp_v, &pc );
PCSetType( pc, PCLU );
KSPSetFromOptions( ksp_v );
KSPSolve( ksp_v, fTempVec, uVec );
/* Recover p */
if( sle->dStiffMat == NULL ) {
/* since Div was modified when C is diagonal, re build the transpose */
if( GTrans != PETSC_NULL )
Stg_MatDestroy(>rans );
#if( PETSC_VERSION_MAJOR <= 2 )
MatTranspose( gradMat, >rans );
#else
MatTranspose( gradMat, MAT_INITIAL_MATRIX, >rans );
#endif
divMat = GTrans;
}
else {
/* never modified Div_null so set divMat to point back to it */
divMat = sle->dStiffMat->matrix;
}
MatMult( divMat, uVec, hTempVec ); /* hTemp = Div v */
VecAYPX( hTempVec, negOne, hVec ); /* hTemp = H - hTemp : hTemp = H - Div v */
MatMult( C_InvMat, hTempVec, pVec ); /* p = CInv hTemp : p = CInv ( H - Div v ) */
Stg_MatDestroy(&kHat );
if( fTempVec != PETSC_NULL ) Stg_VecDestroy(&fTempVec );
if( hTempVec != PETSC_NULL ) Stg_VecDestroy(&hTempVec );
if( diagC != PETSC_NULL ) Stg_VecDestroy(&diagC );
if( ksp_v != PETSC_NULL ) Stg_KSPDestroy(&ksp_v );
if( GTrans != PETSC_NULL ) Stg_MatDestroy(>rans );
}
void PETSC_STDCALL matdiagonalset_(Mat Y,Vec D,InsertMode *is, int *__ierr ){
*__ierr = MatDiagonalSet(
(Mat)PetscToPointer((Y) ),
(Vec)PetscToPointer((D) ),*is);
}
int main(int argc,char **argv)
{
Mat A1,A2; /* problem matrices */
EPS eps; /* eigenproblem solver context */
PetscScalar value[3];
PetscReal tol=1000*PETSC_MACHINE_EPSILON,v;
Vec d;
PetscInt n=30,i,Istart,Iend,col[3];
PetscBool FirstBlock=PETSC_FALSE,LastBlock=PETSC_FALSE;
PetscRandom myrand;
PetscErrorCode ierr;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nTridiagonal with random diagonal, n=%D\n\n",n);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create matrix tridiag([-1 0 -1])
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A1);CHKERRQ(ierr);
ierr = MatSetSizes(A1,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A1);CHKERRQ(ierr);
ierr = MatSetUp(A1);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A1,&Istart,&Iend);CHKERRQ(ierr);
if (Istart==0) FirstBlock=PETSC_TRUE;
if (Iend==n) LastBlock=PETSC_TRUE;
value[0]=-1.0; value[1]=0.0; value[2]=-1.0;
for (i=(FirstBlock? Istart+1: Istart); i<(LastBlock? Iend-1: Iend); i++) {
col[0]=i-1; col[1]=i; col[2]=i+1;
ierr = MatSetValues(A1,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
if (LastBlock) {
i=n-1; col[0]=n-2; col[1]=n-1;
ierr = MatSetValues(A1,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
if (FirstBlock) {
i=0; col[0]=0; col[1]=1; value[0]=0.0; value[1]=-1.0;
ierr = MatSetValues(A1,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create two matrices by filling the diagonal with rand values
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDuplicate(A1,MAT_COPY_VALUES,&A2);CHKERRQ(ierr);
ierr = MatGetVecs(A1,NULL,&d);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&myrand);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(myrand);CHKERRQ(ierr);
ierr = PetscRandomSetInterval(myrand,0.0,1.0);CHKERRQ(ierr);
for (i=0; i<n; i++) {
ierr = PetscRandomGetValueReal(myrand,&v);CHKERRQ(ierr);
ierr = VecSetValue(d,i,v,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(d);CHKERRQ(ierr);
ierr = VecAssemblyEnd(d);CHKERRQ(ierr);
ierr = MatDiagonalSet(A1,d,INSERT_VALUES);CHKERRQ(ierr);
for (i=0; i<n; i++) {
ierr = PetscRandomGetValueReal(myrand,&v);CHKERRQ(ierr);
ierr = VecSetValue(d,i,v,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(d);CHKERRQ(ierr);
ierr = VecAssemblyEnd(d);CHKERRQ(ierr);
ierr = MatDiagonalSet(A2,d,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecDestroy(&d);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&myrand);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = EPSCreate(PETSC_COMM_WORLD,&eps);CHKERRQ(ierr);
ierr = EPSSetProblemType(eps,EPS_HEP);CHKERRQ(ierr);
ierr = EPSSetTolerances(eps,tol,PETSC_DEFAULT);CHKERRQ(ierr);
ierr = EPSSetOperators(eps,A1,NULL);CHKERRQ(ierr);
ierr = EPSSetFromOptions(eps);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve first eigenproblem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = EPSSolve(eps);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," - - - First matrix - - -\n");CHKERRQ(ierr);
ierr = EPSPrintSolution(eps,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve second eigenproblem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = EPSSetOperators(eps,A2,NULL);CHKERRQ(ierr);
ierr = EPSSolve(eps);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," - - - Second matrix - - -\n");CHKERRQ(ierr);
ierr = EPSPrintSolution(eps,NULL);CHKERRQ(ierr);
ierr = EPSDestroy(&eps);CHKERRQ(ierr);
ierr = MatDestroy(&A1);CHKERRQ(ierr);
ierr = MatDestroy(&A2);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
int SolarEigenvaluesSolver(Mat M, Vec epsCurrent, Vec epspmlQ, Mat D)
{
PetscErrorCode ierr;
EPS eps;
PetscInt nconv;
Mat B;
int nrow, ncol;
ierr=MatGetSize(M,&nrow, &ncol); CHKERRQ(ierr);
ierr=MatCreateAIJ(PETSC_COMM_WORLD, PETSC_DECIDE, PETSC_DECIDE, nrow, ncol, 2, NULL, 2, NULL, &B); CHKERRQ(ierr);
ierr=PetscObjectSetName((PetscObject)B, "epsmatrix"); CHKERRQ(ierr);
if (D==PETSC_NULL)
{ // for purely real epsC, no absorption;
ierr=MatDiagonalSet(B,epsCurrent,INSERT_VALUES); CHKERRQ(ierr);
MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
}
else
{
Vec epsC;
VecDuplicate(epsCurrent, &epsC);
ierr = VecPointwiseMult(epsC, epsCurrent,epspmlQ); CHKERRQ(ierr);
MatSetTwoDiagonals(B, epsC, D, 1.0);
VecDestroy(&epsC);
}
PetscPrintf(PETSC_COMM_WORLD,"!!!---computing eigenvalues---!!! \n");
ierr=EPSCreate(PETSC_COMM_WORLD, &eps); CHKERRQ(ierr);
ierr=EPSSetOperators(eps, M, B); CHKERRQ(ierr);
//ierr=EPSSetProblemType(eps,EPS_PGNHEP);CHKERRQ(ierr);
EPSSetFromOptions(eps);
PetscLogDouble t1, t2, tpast;
ierr = PetscTime(&t1);CHKERRQ(ierr);
ierr=EPSSolve(eps); CHKERRQ(ierr);
EPSGetConverged(eps, &nconv); CHKERRQ(ierr);
{
ierr = PetscTime(&t2);CHKERRQ(ierr);
tpast = t2 - t1;
int rank;
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if(rank==0)
PetscPrintf(PETSC_COMM_SELF,"---The eigensolver time is %f s \n",tpast);
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"Number of converged eigenpairs: %d\n\n",nconv);CHKERRQ(ierr);
double *krarray, *kiarray, *errorarray;
krarray = (double *) malloc(sizeof(double)*nconv);
kiarray = (double *) malloc(sizeof(double)*nconv);
errorarray =(double *) malloc(sizeof(double)*nconv);
int ni;
for(ni=0; ni<nconv; ni++)
{
ierr=EPSGetEigenpair(eps,ni, krarray+ni,kiarray+ni,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
ierr = EPSComputeRelativeError(eps,ni,errorarray+ni);CHKERRQ(ierr);
ierr=EPSComputeRelativeError(eps, ni, errorarray+ni );
}
PetscPrintf(PETSC_COMM_WORLD, "Now print the eigenvalues: \n");
for(ni=0; ni<nconv; ni++)
PetscPrintf(PETSC_COMM_WORLD," %g%+gi,", krarray[ni], kiarray[ni]);
PetscPrintf(PETSC_COMM_WORLD, "\n\nNow print the normalized eigenvalues: \n");
for(ni=0; ni<nconv; ni++)
PetscPrintf(PETSC_COMM_WORLD," %g%+gi,", sqrt(krarray[ni]+pow(omega,2))/(2*PI),kiarray[ni]);
PetscPrintf(PETSC_COMM_WORLD, "\n\nstart printing erros");
for(ni=0; ni<nconv; ni++)
PetscPrintf(PETSC_COMM_WORLD," %g,", errorarray[ni]);
PetscPrintf(PETSC_COMM_WORLD,"\n\n Finish EPS Solving !!! \n\n");
/*-- destroy vectors and free space --*/
EPSDestroy(&eps);
MatDestroy(&B);
free(krarray);
free(kiarray);
free(errorarray);
PetscFunctionReturn(0);
}
PetscErrorCode test_solve(void)
{
Mat A11, A12,A21,A22, A, tmp[2][2];
KSP ksp;
PC pc;
Vec b,x, f,h, diag, x1,x2;
Vec tmp_x[2],*_tmp_x;
int n, np, i,j;
PetscErrorCode ierr;
PetscFunctionBeginUser;
PetscPrintf(PETSC_COMM_WORLD, "%s \n", PETSC_FUNCTION_NAME);
n = 3;
np = 2;
/* Create matrices */
/* A11 */
ierr = VecCreate(PETSC_COMM_WORLD, &diag);CHKERRQ(ierr);
ierr = VecSetSizes(diag, PETSC_DECIDE, n);CHKERRQ(ierr);
ierr = VecSetFromOptions(diag);CHKERRQ(ierr);
ierr = VecSet(diag, (1.0/10.0));CHKERRQ(ierr); /* so inverse = diag(10) */
/* As a test, create a diagonal matrix for A11 */
ierr = MatCreate(PETSC_COMM_WORLD, &A11);CHKERRQ(ierr);
ierr = MatSetSizes(A11, PETSC_DECIDE, PETSC_DECIDE, n, n);CHKERRQ(ierr);
ierr = MatSetType(A11, MATAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(A11, n, NULL);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(A11, np, NULL,np, NULL);CHKERRQ(ierr);
ierr = MatDiagonalSet(A11, diag, INSERT_VALUES);CHKERRQ(ierr);
ierr = VecDestroy(&diag);CHKERRQ(ierr);
/* A12 */
ierr = MatCreate(PETSC_COMM_WORLD, &A12);CHKERRQ(ierr);
ierr = MatSetSizes(A12, PETSC_DECIDE, PETSC_DECIDE, n, np);CHKERRQ(ierr);
ierr = MatSetType(A12, MATAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(A12, np, NULL);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(A12, np, NULL,np, NULL);CHKERRQ(ierr);
for (i=0; i<n; i++) {
for (j=0; j<np; j++) {
ierr = MatSetValue(A12, i,j, (PetscScalar)(i+j*n), INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatSetValue(A12, 2,1, (PetscScalar)(4), INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A12, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A12, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* A21 */
ierr = MatTranspose(A12, MAT_INITIAL_MATRIX, &A21);CHKERRQ(ierr);
A22 = NULL;
/* Create block matrix */
tmp[0][0] = A11;
tmp[0][1] = A12;
tmp[1][0] = A21;
tmp[1][1] = A22;
ierr = MatCreateNest(PETSC_COMM_WORLD,2,NULL,2,NULL,&tmp[0][0],&A);CHKERRQ(ierr);
ierr = MatNestSetVecType(A,VECNEST);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Create vectors */
ierr = MatCreateVecs(A12, &h, &f);CHKERRQ(ierr);
ierr = VecSet(f, 1.0);CHKERRQ(ierr);
ierr = VecSet(h, 0.0);CHKERRQ(ierr);
/* Create block vector */
tmp_x[0] = f;
tmp_x[1] = h;
ierr = VecCreateNest(PETSC_COMM_WORLD,2,NULL,tmp_x,&b);CHKERRQ(ierr);
ierr = VecAssemblyBegin(b);CHKERRQ(ierr);
ierr = VecAssemblyEnd(b);CHKERRQ(ierr);
ierr = VecDuplicate(b, &x);CHKERRQ(ierr);
ierr = KSPCreate(PETSC_COMM_WORLD, &ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp, A, A);CHKERRQ(ierr);
ierr = KSPSetType(ksp, "gmres");CHKERRQ(ierr);
ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr);
ierr = PCSetType(pc, "none");CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = KSPSolve(ksp, b, x);CHKERRQ(ierr);
ierr = VecNestGetSubVecs(x,NULL,&_tmp_x);CHKERRQ(ierr);
x1 = _tmp_x[0];
x2 = _tmp_x[1];
PetscPrintf(PETSC_COMM_WORLD, "x1 \n");
PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_ASCII_INFO_DETAIL);CHKERRQ(ierr);
ierr = VecView(x1, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
PetscPrintf(PETSC_COMM_WORLD, "x2 \n");
ierr = VecView(x2, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = MatDestroy(&A11);CHKERRQ(ierr);
ierr = MatDestroy(&A12);CHKERRQ(ierr);
ierr = MatDestroy(&A21);CHKERRQ(ierr);
ierr = VecDestroy(&f);CHKERRQ(ierr);
ierr = VecDestroy(&h);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* Only isolated vertices get a 1 on the diagonal */
PetscErrorCode CreateGraph(MPI_Comm comm, PetscInt testnum, Mat *A)
{
Mat G;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MatCreate(comm, &G);CHKERRQ(ierr);
/* The identity matrix */
switch (testnum) {
case 0:
{
Vec D;
ierr = MatSetSizes(G, PETSC_DETERMINE, PETSC_DETERMINE, 5, 5);CHKERRQ(ierr);
ierr = MatSetUp(G);CHKERRQ(ierr);
ierr = MatCreateVecs(G, &D, NULL);CHKERRQ(ierr);
ierr = VecSet(D, 1.0);CHKERRQ(ierr);
ierr = MatDiagonalSet(G, D, INSERT_VALUES);CHKERRQ(ierr);
ierr = VecDestroy(&D);CHKERRQ(ierr);
}
break;
case 1:
{
PetscScalar vals[3] = {1.0, 1.0, 1.0};
PetscInt cols[3];
PetscInt rStart, rEnd, row;
ierr = MatSetSizes(G, PETSC_DETERMINE, PETSC_DETERMINE, 5, 5);CHKERRQ(ierr);
ierr = MatSetFromOptions(G);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(G, 2, NULL);CHKERRQ(ierr);
ierr = MatSetUp(G);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(G, &rStart, &rEnd);CHKERRQ(ierr);
row = 0;
cols[0] = 0; cols[1] = 1;
if ((row >= rStart) && (row < rEnd)) {ierr = MatSetValues(G, 1, &row, 2, cols, vals, INSERT_VALUES);CHKERRQ(ierr);}
row = 1;
cols[0] = 0; cols[1] = 1;
if ((row >= rStart) && (row < rEnd)) {ierr = MatSetValues(G, 1, &row, 2, cols, vals, INSERT_VALUES);CHKERRQ(ierr);}
row = 2;
cols[0] = 2; cols[1] = 3;
if ((row >= rStart) && (row < rEnd)) {ierr = MatSetValues(G, 1, &row, 2, cols, vals, INSERT_VALUES);CHKERRQ(ierr);}
row = 3;
cols[0] = 3; cols[1] = 4;
if ((row >= rStart) && (row < rEnd)) {ierr = MatSetValues(G, 1, &row, 2, cols, vals, INSERT_VALUES);CHKERRQ(ierr);}
row = 4;
cols[0] = 4; cols[1] = 2;
if ((row >= rStart) && (row < rEnd)) {ierr = MatSetValues(G, 1, &row, 2, cols, vals, INSERT_VALUES);CHKERRQ(ierr);}
ierr = MatAssemblyBegin(G, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(G, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
break;
case 2:
{
PetscScalar vals[3] = {1.0, 1.0, 1.0};
PetscInt cols[3];
PetscInt rStart, rEnd, row;
ierr = MatSetSizes(G, PETSC_DETERMINE, PETSC_DETERMINE, 5, 5);CHKERRQ(ierr);
ierr = MatSetFromOptions(G);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(G, 2, NULL);CHKERRQ(ierr);
ierr = MatSetUp(G);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(G, &rStart, &rEnd);CHKERRQ(ierr);
row = 0;
cols[0] = 0; cols[1] = 4;
if ((row >= rStart) && (row < rEnd)) {ierr = MatSetValues(G, 1, &row, 2, cols, vals, INSERT_VALUES);CHKERRQ(ierr);}
row = 1;
cols[0] = 1; cols[1] = 2;
if ((row >= rStart) && (row < rEnd)) {ierr = MatSetValues(G, 1, &row, 2, cols, vals, INSERT_VALUES);CHKERRQ(ierr);}
row = 2;
cols[0] = 2; cols[1] = 3;
if ((row >= rStart) && (row < rEnd)) {ierr = MatSetValues(G, 1, &row, 2, cols, vals, INSERT_VALUES);CHKERRQ(ierr);}
row = 3;
cols[0] = 3; cols[1] = 1;
if ((row >= rStart) && (row < rEnd)) {ierr = MatSetValues(G, 1, &row, 2, cols, vals, INSERT_VALUES);CHKERRQ(ierr);}
row = 4;
cols[0] = 0; cols[1] = 4;
if ((row >= rStart) && (row < rEnd)) {ierr = MatSetValues(G, 1, &row, 2, cols, vals, INSERT_VALUES);CHKERRQ(ierr);}
ierr = MatAssemblyBegin(G, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(G, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
break;
default:
SETERRQ1(comm, PETSC_ERR_PLIB, "Unknown test %d", testnum);
}
*A = G;
PetscFunctionReturn(0);
}
static PetscErrorCode TaoSolve_BQPIP(Tao tao)
{
TAO_BQPIP *qp = (TAO_BQPIP*)tao->data;
PetscErrorCode ierr;
PetscInt iter=0,its;
PetscReal d1,d2,ksptol,sigma;
PetscReal sigmamu;
PetscReal dstep,pstep,step=0;
PetscReal gap[4];
TaoConvergedReason reason;
PetscFunctionBegin;
qp->dobj = 0.0;
qp->pobj = 1.0;
qp->gap = 10.0;
qp->rgap = 1.0;
qp->mu = 1.0;
qp->sigma = 1.0;
qp->dinfeas = 1.0;
qp->psteplength = 0.0;
qp->dsteplength = 0.0;
/* Tighten infinite bounds, things break when we don't do this
-- see test_bqpip.c
*/
ierr = VecSet(qp->XU,1.0e20);CHKERRQ(ierr);
ierr = VecSet(qp->XL,-1.0e20);CHKERRQ(ierr);
ierr = VecPointwiseMax(qp->XL,qp->XL,tao->XL);CHKERRQ(ierr);
ierr = VecPointwiseMin(qp->XU,qp->XU,tao->XU);CHKERRQ(ierr);
ierr = TaoComputeObjectiveAndGradient(tao,tao->solution,&qp->c,qp->C0);CHKERRQ(ierr);
ierr = TaoComputeHessian(tao,tao->solution,tao->hessian,tao->hessian_pre);CHKERRQ(ierr);
ierr = MatMult(tao->hessian, tao->solution, qp->Work);CHKERRQ(ierr);
ierr = VecDot(tao->solution, qp->Work, &d1);CHKERRQ(ierr);
ierr = VecAXPY(qp->C0, -1.0, qp->Work);CHKERRQ(ierr);
ierr = VecDot(qp->C0, tao->solution, &d2);CHKERRQ(ierr);
qp->c -= (d1/2.0+d2);
ierr = MatGetDiagonal(tao->hessian, qp->HDiag);CHKERRQ(ierr);
ierr = QPIPSetInitialPoint(qp,tao);CHKERRQ(ierr);
ierr = QPIPComputeResidual(qp,tao);CHKERRQ(ierr);
/* Enter main loop */
while (1){
/* Check Stopping Condition */
ierr = TaoMonitor(tao,iter++,qp->pobj,PetscSqrtScalar(qp->gap + qp->dinfeas),
qp->pinfeas, step, &reason);CHKERRQ(ierr);
if (reason != TAO_CONTINUE_ITERATING) break;
/*
Dual Infeasibility Direction should already be in the right
hand side from computing the residuals
*/
ierr = QPIPComputeNormFromCentralPath(qp,&d1);CHKERRQ(ierr);
if (iter > 0 && (qp->rnorm>5*qp->mu || d1*d1>qp->m*qp->mu*qp->mu) ) {
sigma=1.0;sigmamu=qp->mu;
sigma=0.0;sigmamu=0;
} else {
sigma=0.0;sigmamu=0;
}
ierr = VecSet(qp->DZ, sigmamu);CHKERRQ(ierr);
ierr = VecSet(qp->DS, sigmamu);CHKERRQ(ierr);
if (sigmamu !=0){
ierr = VecPointwiseDivide(qp->DZ, qp->DZ, qp->G);CHKERRQ(ierr);
ierr = VecPointwiseDivide(qp->DS, qp->DS, qp->T);CHKERRQ(ierr);
ierr = VecCopy(qp->DZ,qp->RHS2);CHKERRQ(ierr);
ierr = VecAXPY(qp->RHS2, 1.0, qp->DS);CHKERRQ(ierr);
} else {
ierr = VecZeroEntries(qp->RHS2);CHKERRQ(ierr);
}
/*
Compute the Primal Infeasiblitiy RHS and the
Diagonal Matrix to be added to H and store in Work
*/
ierr = VecPointwiseDivide(qp->DiagAxpy, qp->Z, qp->G);CHKERRQ(ierr);
ierr = VecPointwiseMult(qp->GZwork, qp->DiagAxpy, qp->R3);CHKERRQ(ierr);
ierr = VecAXPY(qp->RHS, -1.0, qp->GZwork);CHKERRQ(ierr);
ierr = VecPointwiseDivide(qp->TSwork, qp->S, qp->T);CHKERRQ(ierr);
ierr = VecAXPY(qp->DiagAxpy, 1.0, qp->TSwork);CHKERRQ(ierr);
ierr = VecPointwiseMult(qp->TSwork, qp->TSwork, qp->R5);CHKERRQ(ierr);
ierr = VecAXPY(qp->RHS, -1.0, qp->TSwork);CHKERRQ(ierr);
ierr = VecAXPY(qp->RHS2, 1.0, qp->RHS);CHKERRQ(ierr);
/* Determine the solving tolerance */
ksptol = qp->mu/10.0;
ksptol = PetscMin(ksptol,0.001);
ierr = MatDiagonalSet(tao->hessian, qp->DiagAxpy, ADD_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(tao->hessian,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(tao->hessian,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = KSPSetOperators(tao->ksp, tao->hessian, tao->hessian_pre);CHKERRQ(ierr);
ierr = KSPSolve(tao->ksp, qp->RHS, tao->stepdirection);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(tao->ksp,&its);CHKERRQ(ierr);
tao->ksp_its+=its;
ierr = VecScale(qp->DiagAxpy, -1.0);CHKERRQ(ierr);
ierr = MatDiagonalSet(tao->hessian, qp->DiagAxpy, ADD_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(tao->hessian,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(tao->hessian,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = VecScale(qp->DiagAxpy, -1.0);CHKERRQ(ierr);
ierr = QPComputeStepDirection(qp,tao);CHKERRQ(ierr);
ierr = QPStepLength(qp); CHKERRQ(ierr);
/* Calculate New Residual R1 in Work vector */
ierr = MatMult(tao->hessian, tao->stepdirection, qp->RHS2);CHKERRQ(ierr);
ierr = VecAXPY(qp->RHS2, 1.0, qp->DS);CHKERRQ(ierr);
ierr = VecAXPY(qp->RHS2, -1.0, qp->DZ);CHKERRQ(ierr);
ierr = VecAYPX(qp->RHS2, qp->dsteplength, tao->gradient);CHKERRQ(ierr);
ierr = VecNorm(qp->RHS2, NORM_2, &qp->dinfeas);CHKERRQ(ierr);
ierr = VecDot(qp->DZ, qp->DG, gap);CHKERRQ(ierr);
ierr = VecDot(qp->DS, qp->DT, gap+1);CHKERRQ(ierr);
qp->rnorm=(qp->dinfeas+qp->psteplength*qp->pinfeas)/(qp->m+qp->n);
pstep = qp->psteplength; dstep = qp->dsteplength;
step = PetscMin(qp->psteplength,qp->dsteplength);
sigmamu= ( pstep*pstep*(gap[0]+gap[1]) +
(1 - pstep + pstep*sigma)*qp->gap )/qp->m;
if (qp->predcorr && step < 0.9){
if (sigmamu < qp->mu){
sigmamu=sigmamu/qp->mu;
sigmamu=sigmamu*sigmamu*sigmamu;
} else {sigmamu = 1.0;}
sigmamu = sigmamu*qp->mu;
/* Compute Corrector Step */
ierr = VecPointwiseMult(qp->DZ, qp->DG, qp->DZ);CHKERRQ(ierr);
ierr = VecScale(qp->DZ, -1.0);CHKERRQ(ierr);
ierr = VecShift(qp->DZ, sigmamu);CHKERRQ(ierr);
ierr = VecPointwiseDivide(qp->DZ, qp->DZ, qp->G);CHKERRQ(ierr);
ierr = VecPointwiseMult(qp->DS, qp->DS, qp->DT);CHKERRQ(ierr);
ierr = VecScale(qp->DS, -1.0);CHKERRQ(ierr);
ierr = VecShift(qp->DS, sigmamu);CHKERRQ(ierr);
ierr = VecPointwiseDivide(qp->DS, qp->DS, qp->T);CHKERRQ(ierr);
ierr = VecCopy(qp->DZ, qp->RHS2);CHKERRQ(ierr);
ierr = VecAXPY(qp->RHS2, -1.0, qp->DS);CHKERRQ(ierr);
ierr = VecAXPY(qp->RHS2, 1.0, qp->RHS);CHKERRQ(ierr);
/* Approximately solve the linear system */
ierr = MatDiagonalSet(tao->hessian, qp->DiagAxpy, ADD_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(tao->hessian,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(tao->hessian,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = KSPSolve(tao->ksp, qp->RHS2, tao->stepdirection);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(tao->ksp,&its);CHKERRQ(ierr);
tao->ksp_its+=its;
ierr = MatDiagonalSet(tao->hessian, qp->HDiag, INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(tao->hessian,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(tao->hessian,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = QPComputeStepDirection(qp,tao);CHKERRQ(ierr);
ierr = QPStepLength(qp);CHKERRQ(ierr);
} /* End Corrector step */
/* Take the step */
pstep = qp->psteplength; dstep = qp->dsteplength;
ierr = VecAXPY(qp->Z, dstep, qp->DZ);CHKERRQ(ierr);
ierr = VecAXPY(qp->S, dstep, qp->DS);CHKERRQ(ierr);
ierr = VecAXPY(tao->solution, dstep, tao->stepdirection);CHKERRQ(ierr);
ierr = VecAXPY(qp->G, dstep, qp->DG);CHKERRQ(ierr);
ierr = VecAXPY(qp->T, dstep, qp->DT);CHKERRQ(ierr);
/* Compute Residuals */
ierr = QPIPComputeResidual(qp,tao);CHKERRQ(ierr);
/* Evaluate quadratic function */
ierr = MatMult(tao->hessian, tao->solution, qp->Work);CHKERRQ(ierr);
ierr = VecDot(tao->solution, qp->Work, &d1);CHKERRQ(ierr);
ierr = VecDot(tao->solution, qp->C0, &d2);CHKERRQ(ierr);
ierr = VecDot(qp->G, qp->Z, gap);CHKERRQ(ierr);
ierr = VecDot(qp->T, qp->S, gap+1);CHKERRQ(ierr);
qp->pobj=d1/2.0 + d2+qp->c;
/* Compute the duality gap */
qp->gap = (gap[0]+gap[1]);
qp->dobj = qp->pobj - qp->gap;
if (qp->m>0) qp->mu=qp->gap/(qp->m);
qp->rgap=qp->gap/( PetscAbsReal(qp->dobj) + PetscAbsReal(qp->pobj) + 1.0 );
} /* END MAIN LOOP */
PetscFunctionReturn(0);
}
static PetscErrorCode TaoSolve_ASILS(Tao tao)
{
TAO_SSLS *asls = (TAO_SSLS *)tao->data;
PetscReal psi,ndpsi, normd, innerd, t=0;
PetscInt iter=0, nf;
PetscErrorCode ierr;
TaoConvergedReason reason;
TaoLineSearchConvergedReason ls_reason;
PetscFunctionBegin;
/* Assume that Setup has been called!
Set the structure for the Jacobian and create a linear solver. */
ierr = TaoComputeVariableBounds(tao);CHKERRQ(ierr);
ierr = TaoLineSearchSetObjectiveAndGradientRoutine(tao->linesearch,Tao_ASLS_FunctionGradient,tao);CHKERRQ(ierr);
ierr = TaoLineSearchSetObjectiveRoutine(tao->linesearch,Tao_SSLS_Function,tao);CHKERRQ(ierr);
/* Calculate the function value and fischer function value at the
current iterate */
ierr = TaoLineSearchComputeObjectiveAndGradient(tao->linesearch,tao->solution,&psi,asls->dpsi);CHKERRQ(ierr);
ierr = VecNorm(asls->dpsi,NORM_2,&ndpsi);CHKERRQ(ierr);
while (1) {
/* Check the termination criteria */
ierr = PetscInfo3(tao,"iter %D, merit: %g, ||dpsi||: %g\n",iter, (double)asls->merit, (double)ndpsi);CHKERRQ(ierr);
ierr = TaoMonitor(tao, iter++, asls->merit, ndpsi, 0.0, t, &reason);CHKERRQ(ierr);
if (TAO_CONTINUE_ITERATING != reason) break;
/* We are going to solve a linear system of equations. We need to
set the tolerances for the solve so that we maintain an asymptotic
rate of convergence that is superlinear.
Note: these tolerances are for the reduced system. We really need
to make sure that the full system satisfies the full-space conditions.
This rule gives superlinear asymptotic convergence
asls->atol = min(0.5, asls->merit*sqrt(asls->merit));
asls->rtol = 0.0;
This rule gives quadratic asymptotic convergence
asls->atol = min(0.5, asls->merit*asls->merit);
asls->rtol = 0.0;
Calculate a free and fixed set of variables. The fixed set of
variables are those for the d_b is approximately equal to zero.
The definition of approximately changes as we approach the solution
to the problem.
No one rule is guaranteed to work in all cases. The following
definition is based on the norm of the Jacobian matrix. If the
norm is large, the tolerance becomes smaller. */
ierr = MatNorm(tao->jacobian,NORM_1,&asls->identifier);CHKERRQ(ierr);
asls->identifier = PetscMin(asls->merit, 1e-2) / (1 + asls->identifier);
ierr = VecSet(asls->t1,-asls->identifier);CHKERRQ(ierr);
ierr = VecSet(asls->t2, asls->identifier);CHKERRQ(ierr);
ierr = ISDestroy(&asls->fixed);CHKERRQ(ierr);
ierr = ISDestroy(&asls->free);CHKERRQ(ierr);
ierr = VecWhichBetweenOrEqual(asls->t1, asls->db, asls->t2, &asls->fixed);CHKERRQ(ierr);
ierr = ISComplementVec(asls->fixed,asls->t1, &asls->free);CHKERRQ(ierr);
ierr = ISGetSize(asls->fixed,&nf);CHKERRQ(ierr);
ierr = PetscInfo1(tao,"Number of fixed variables: %D\n", nf);CHKERRQ(ierr);
/* We now have our partition. Now calculate the direction in the
fixed variable space. */
ierr = TaoVecGetSubVec(asls->ff, asls->fixed, tao->subset_type, 0.0, &asls->r1);
ierr = TaoVecGetSubVec(asls->da, asls->fixed, tao->subset_type, 1.0, &asls->r2);
ierr = VecPointwiseDivide(asls->r1,asls->r1,asls->r2);CHKERRQ(ierr);
ierr = VecSet(tao->stepdirection,0.0);CHKERRQ(ierr);
ierr = VecISAXPY(tao->stepdirection, asls->fixed,1.0,asls->r1);CHKERRQ(ierr);
/* Our direction in the Fixed Variable Set is fixed. Calculate the
information needed for the step in the Free Variable Set. To
do this, we need to know the diagonal perturbation and the
right hand side. */
ierr = TaoVecGetSubVec(asls->da, asls->free, tao->subset_type, 0.0, &asls->r1);CHKERRQ(ierr);
ierr = TaoVecGetSubVec(asls->ff, asls->free, tao->subset_type, 0.0, &asls->r2);CHKERRQ(ierr);
ierr = TaoVecGetSubVec(asls->db, asls->free, tao->subset_type, 1.0, &asls->r3);CHKERRQ(ierr);
ierr = VecPointwiseDivide(asls->r1,asls->r1, asls->r3);CHKERRQ(ierr);
ierr = VecPointwiseDivide(asls->r2,asls->r2, asls->r3);CHKERRQ(ierr);
/* r1 is the diagonal perturbation
r2 is the right hand side
r3 is no longer needed
Now need to modify r2 for our direction choice in the fixed
variable set: calculate t1 = J*d, take the reduced vector
of t1 and modify r2. */
ierr = MatMult(tao->jacobian, tao->stepdirection, asls->t1);CHKERRQ(ierr);
ierr = TaoVecGetSubVec(asls->t1,asls->free,tao->subset_type,0.0,&asls->r3);CHKERRQ(ierr);
ierr = VecAXPY(asls->r2, -1.0, asls->r3);CHKERRQ(ierr);
/* Calculate the reduced problem matrix and the direction */
if (!asls->w && (tao->subset_type == TAO_SUBSET_MASK || tao->subset_type == TAO_SUBSET_MATRIXFREE)) {
ierr = VecDuplicate(tao->solution, &asls->w);CHKERRQ(ierr);
}
ierr = TaoMatGetSubMat(tao->jacobian, asls->free, asls->w, tao->subset_type,&asls->J_sub);CHKERRQ(ierr);
if (tao->jacobian != tao->jacobian_pre) {
ierr = TaoMatGetSubMat(tao->jacobian_pre, asls->free, asls->w, tao->subset_type, &asls->Jpre_sub);CHKERRQ(ierr);
} else {
ierr = MatDestroy(&asls->Jpre_sub);CHKERRQ(ierr);
asls->Jpre_sub = asls->J_sub;
ierr = PetscObjectReference((PetscObject)(asls->Jpre_sub));CHKERRQ(ierr);
}
ierr = MatDiagonalSet(asls->J_sub, asls->r1,ADD_VALUES);CHKERRQ(ierr);
ierr = TaoVecGetSubVec(tao->stepdirection, asls->free, tao->subset_type, 0.0, &asls->dxfree);CHKERRQ(ierr);
ierr = VecSet(asls->dxfree, 0.0);CHKERRQ(ierr);
/* Calculate the reduced direction. (Really negative of Newton
direction. Therefore, rest of the code uses -d.) */
ierr = KSPReset(tao->ksp);
ierr = KSPSetOperators(tao->ksp, asls->J_sub, asls->Jpre_sub);CHKERRQ(ierr);
ierr = KSPSolve(tao->ksp, asls->r2, asls->dxfree);CHKERRQ(ierr);
/* Add the direction in the free variables back into the real direction. */
ierr = VecISAXPY(tao->stepdirection, asls->free, 1.0,asls->dxfree);CHKERRQ(ierr);
/* Check the real direction for descent and if not, use the negative
gradient direction. */
ierr = VecNorm(tao->stepdirection, NORM_2, &normd);CHKERRQ(ierr);
ierr = VecDot(tao->stepdirection, asls->dpsi, &innerd);CHKERRQ(ierr);
if (innerd <= asls->delta*pow(normd, asls->rho)) {
ierr = PetscInfo1(tao,"Gradient direction: %5.4e.\n", (double)innerd);CHKERRQ(ierr);
ierr = PetscInfo1(tao, "Iteration %D: newton direction not descent\n", iter);CHKERRQ(ierr);
ierr = VecCopy(asls->dpsi, tao->stepdirection);CHKERRQ(ierr);
ierr = VecDot(asls->dpsi, tao->stepdirection, &innerd);CHKERRQ(ierr);
}
ierr = VecScale(tao->stepdirection, -1.0);CHKERRQ(ierr);
innerd = -innerd;
/* We now have a correct descent direction. Apply a linesearch to
find the new iterate. */
ierr = TaoLineSearchSetInitialStepLength(tao->linesearch, 1.0);CHKERRQ(ierr);
ierr = TaoLineSearchApply(tao->linesearch, tao->solution, &psi,asls->dpsi, tao->stepdirection, &t, &ls_reason);CHKERRQ(ierr);
ierr = VecNorm(asls->dpsi, NORM_2, &ndpsi);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode _BlockSolve( void* solver, void* _stokesSLE ) {
Stokes_SLE* stokesSLE = (Stokes_SLE*)_stokesSLE;
StokesBlockKSPInterface* Solver = (StokesBlockKSPInterface*)solver;
/* Create shortcuts to stuff needed on sle */
Mat K;
Mat G;
Mat Gt;
Mat D;
Mat C;
Mat approxS;
Vec u;
Vec p;
Vec f;
Vec h;
Mat stokes_P;
Mat stokes_A;
Vec stokes_x;
Vec stokes_b;
Mat a[2][2];
Vec x[2];
Vec b[2];
KSP stokes_ksp;
PC stokes_pc;
PetscTruth sym,flg;
PetscErrorCode ierr;
PetscInt N,n;
SBKSP_GetStokesOperators( stokesSLE, &K,&G,&D,&C, &approxS, &f,&h, &u,&p );
/* create Gt */
if( !D ) {
ierr = MatTranspose( G, MAT_INITIAL_MATRIX, &Gt);CHKERRQ(ierr);
sym = PETSC_TRUE;
Solver->DIsSym = sym;
}
else {
Gt = D;
sym = PETSC_FALSE;
Solver->DIsSym = sym;
}
flg=PETSC_FALSE;
PetscOptionsHasName(PETSC_NULL,"-use_petsc_ksp",&flg);
if (flg) {
if( !C ) {
/* Everything in this bracket, dependent on !C, is to build
a matrix with diagonals of 0 for C the previous comment ways
need a 'zero' matrix to keep fieldsplit happy in petsc? */
MatType mtype;
Vec V;
//MatGetSize( G, &M, &N );
VecGetSize(p, &N);
VecGetLocalSize( p, &n );
MatCreate( PetscObjectComm((PetscObject) K), &C );
MatSetSizes( C, PETSC_DECIDE ,PETSC_DECIDE, N, N );
#if (((PETSC_VERSION_MAJOR==3) && (PETSC_VERSION_MINOR>=3)) || (PETSC_VERSION_MAJOR>3) )
MatSetUp(C);
#endif
MatGetType( G, &mtype );
MatSetType( C, mtype );
MatGetVecs( G, &V, PETSC_NULL );
VecSet(V, 0.0);
//VecSet(h, 1.0);
ierr = VecAssemblyBegin( V );CHKERRQ(ierr);
ierr = VecAssemblyEnd ( V );CHKERRQ(ierr);
ierr = MatDiagonalSet(C,V,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin( C, MAT_FINAL_ASSEMBLY );CHKERRQ(ierr);
ierr = MatAssemblyEnd ( C, MAT_FINAL_ASSEMBLY );CHKERRQ(ierr);
}
}
a[0][0]=K; a[0][1]=G;
a[1][0]=Gt; a[1][1]=C;
ierr = MatCreateNest(PetscObjectComm((PetscObject) K), 2, NULL, 2, NULL, (Mat *)a, &stokes_A);CHKERRQ(ierr);
ierr = MatAssemblyBegin( stokes_A, MAT_FINAL_ASSEMBLY );CHKERRQ(ierr);
ierr = MatAssemblyEnd( stokes_A, MAT_FINAL_ASSEMBLY );CHKERRQ(ierr);
x[0]=u;
x[1]=p;
ierr = VecCreateNest(PetscObjectComm((PetscObject) u), 2, NULL, x, &stokes_x);CHKERRQ(ierr);
ierr = VecAssemblyBegin( stokes_x );CHKERRQ(ierr);
ierr = VecAssemblyEnd( stokes_x);CHKERRQ(ierr);
b[0]=f;
b[1]=h;
ierr = VecCreateNest(PetscObjectComm((PetscObject) f), 2, NULL, b, &stokes_b);CHKERRQ(ierr);
ierr = VecAssemblyBegin( stokes_b );CHKERRQ(ierr);
ierr = VecAssemblyEnd( stokes_b);CHKERRQ(ierr);
/* if( approxS ) { */
/* a[0][0]=K; a[0][1]=G; */
/* a[1][0]=NULL; a[1][1]=approxS; */
/* ierr = MatCreateNest(PetscObjectComm((PetscObject) K), 2, NULL, 2, NULL, (Mat *)a, &stokes_P);CHKERRQ(ierr); */
/* ierr = MatAssemblyBegin( stokes_P, MAT_FINAL_ASSEMBLY );CHKERRQ(ierr); */
/* ierr = MatAssemblyEnd( stokes_P, MAT_FINAL_ASSEMBLY );CHKERRQ(ierr); */
/* } */
/* else { */
stokes_P = stokes_A;
/* } */
/* probably should make a Destroy function for these two */
/* Update options from file and/or string here so we can change things on the fly */
//PetscOptionsInsertFile(PETSC_COMM_WORLD, Solver->optionsFile, PETSC_FALSE);
//PetscOptionsInsertString(Solver->optionsString);
ierr = KSPCreate( PETSC_COMM_WORLD, &stokes_ksp );CHKERRQ(ierr);
Stg_KSPSetOperators( stokes_ksp, stokes_A, stokes_P, SAME_NONZERO_PATTERN );
ierr = KSPSetType( stokes_ksp, "bsscr" );/* i.e. making this the default solver : calls KSPCreate_XXX */CHKERRQ(ierr);
ierr = KSPGetPC( stokes_ksp, &stokes_pc );CHKERRQ(ierr);
ierr = PCSetType( stokes_pc, PCNONE );CHKERRQ(ierr);
ierr = KSPSetInitialGuessNonzero( stokes_ksp, PETSC_TRUE );CHKERRQ(ierr);
ierr = KSPSetFromOptions( stokes_ksp );CHKERRQ(ierr);
/*
Doing this so the KSP Solver has access to the StgFEM Multigrid struct (PETScMGSolver).
As well as any custom stuff on the Stokes_SLE struct
*/
if( stokes_ksp->data ){/* then ksp->data has been created in a KSpSetUp_XXX function */
/* testing for our KSP types that need the data that is on Solver... */
/* for the moment then, this function not completely agnostic about our KSPs */
//if(!strcmp("bsscr",stokes_ksp->type_name)){/* if is bsscr then set up the data on the ksp */
flg=PETSC_FALSE;
PetscOptionsHasName(PETSC_NULL,"-use_petsc_ksp",&flg);
if (!flg) {
((KSP_COMMON*)(stokes_ksp->data))->st_sle = Solver->st_sle;
((KSP_COMMON*)(stokes_ksp->data))->mg = Solver->mg;
((KSP_COMMON*)(stokes_ksp->data))->DIsSym = Solver->DIsSym;
((KSP_COMMON*)(stokes_ksp->data))->preconditioner = Solver->preconditioner;
((KSP_COMMON*)(stokes_ksp->data))->solver = Solver;
}
}
ierr = KSPSolve( stokes_ksp, stokes_b, stokes_x );CHKERRQ(ierr);
Stg_KSPDestroy(&stokes_ksp );
//if( ((StokesBlockKSPInterface*)stokesSLE->solver)->preconditioner )
if(stokes_P != stokes_A) { Stg_MatDestroy(&stokes_P ); }
Stg_MatDestroy(&stokes_A );
Stg_VecDestroy(&stokes_x);
Stg_VecDestroy(&stokes_b);
if(!D){ Stg_MatDestroy(&Gt); }
if(C && (stokesSLE->cStiffMat->matrix != C) ){ Stg_MatDestroy(&C); }
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat A,RHS,C,F,X,S;
Vec u,x,b;
Vec xschur,bschur,uschur;
IS is_schur;
PetscErrorCode ierr;
PetscMPIInt size;
PetscInt isolver=0,size_schur,m,n,nfact,nsolve,nrhs;
PetscReal norm,tol=PETSC_SQRT_MACHINE_EPSILON;
PetscRandom rand;
PetscBool data_provided,herm,symm,use_lu;
PetscReal sratio = 5.1/12.;
PetscViewer fd; /* viewer */
char solver[256];
char file[PETSC_MAX_PATH_LEN]; /* input file name */
PetscInitialize(&argc,&args,(char*)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD, &size);CHKERRQ(ierr);
if (size > 1) SETERRQ(PETSC_COMM_WORLD,1,"This is a uniprocessor test");
/* Determine which type of solver we want to test for */
herm = PETSC_FALSE;
symm = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,NULL,"-symmetric_solve",&symm,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,NULL,"-hermitian_solve",&herm,NULL);CHKERRQ(ierr);
if (herm) symm = PETSC_TRUE;
/* Determine file from which we read the matrix A */
ierr = PetscOptionsGetString(NULL,NULL,"-f",file,PETSC_MAX_PATH_LEN,&data_provided);CHKERRQ(ierr);
if (!data_provided) { /* get matrices from PETSc distribution */
sprintf(file,PETSC_DIR);
ierr = PetscStrcat(file,"/share/petsc/datafiles/matrices/");CHKERRQ(ierr);
if (symm) {
#if defined (PETSC_USE_COMPLEX)
ierr = PetscStrcat(file,"hpd-complex-");CHKERRQ(ierr);
#else
ierr = PetscStrcat(file,"spd-real-");CHKERRQ(ierr);
#endif
} else {
#if defined (PETSC_USE_COMPLEX)
ierr = PetscStrcat(file,"nh-complex-");CHKERRQ(ierr);
#else
ierr = PetscStrcat(file,"ns-real-");CHKERRQ(ierr);
#endif
}
#if defined(PETSC_USE_64BIT_INDICES)
ierr = PetscStrcat(file,"int64-");CHKERRQ(ierr);
#else
ierr = PetscStrcat(file,"int32-");CHKERRQ(ierr);
#endif
#if defined (PETSC_USE_REAL_SINGLE)
ierr = PetscStrcat(file,"float32");CHKERRQ(ierr);
#else
ierr = PetscStrcat(file,"float64");CHKERRQ(ierr);
#endif
}
/* Load matrix A */
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file,FILE_MODE_READ,&fd);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatLoad(A,fd);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&fd);CHKERRQ(ierr);
ierr = MatGetSize(A,&m,&n);CHKERRQ(ierr);
if (m != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ, "This example is not intended for rectangular matrices (%d, %d)", m, n);
/* Create dense matrix C and X; C holds true solution with identical colums */
nrhs = 2;
ierr = PetscOptionsGetInt(NULL,NULL,"-nrhs",&nrhs,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,m,PETSC_DECIDE,PETSC_DECIDE,nrhs);CHKERRQ(ierr);
ierr = MatSetType(C,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatSetUp(C);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rand);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rand);CHKERRQ(ierr);
ierr = MatSetRandom(C,rand);CHKERRQ(ierr);
ierr = MatDuplicate(C,MAT_DO_NOT_COPY_VALUES,&X);CHKERRQ(ierr);
/* Create vectors */
ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr);
ierr = VecSetSizes(x,n,PETSC_DECIDE);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&b);CHKERRQ(ierr);
ierr = VecDuplicate(x,&u);CHKERRQ(ierr); /* save the true solution */
ierr = PetscOptionsGetInt(NULL,NULL,"-solver",&isolver,NULL);CHKERRQ(ierr);
switch (isolver) {
#if defined(PETSC_HAVE_MUMPS)
case 0:
ierr = PetscStrcpy(solver,MATSOLVERMUMPS);CHKERRQ(ierr);
break;
#endif
#if defined(PETSC_HAVE_MKL_PARDISO)
case 1:
ierr = PetscStrcpy(solver,MATSOLVERMKL_PARDISO);CHKERRQ(ierr);
break;
#endif
default:
ierr = PetscStrcpy(solver,MATSOLVERPETSC);CHKERRQ(ierr);
break;
}
#if defined (PETSC_USE_COMPLEX)
if (isolver == 0 && symm && !data_provided) { /* MUMPS (5.0.0) does not have support for hermitian matrices, so make them symmetric */
PetscScalar im = PetscSqrtScalar((PetscScalar)-1.);
PetscScalar val = -1.0;
val = val + im;
ierr = MatSetValue(A,1,0,val,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
#endif
ierr = PetscOptionsGetReal(NULL,NULL,"-schur_ratio",&sratio,NULL);CHKERRQ(ierr);
if (sratio < 0. || sratio > 1.) {
SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ, "Invalid ratio for schur degrees of freedom %f", sratio);
}
size_schur = (PetscInt)(sratio*m);
ierr = PetscPrintf(PETSC_COMM_SELF,"Solving with %s: nrhs %d, sym %d, herm %d, size schur %d, size mat %d\n",solver,nrhs,symm,herm,size_schur,m);CHKERRQ(ierr);
/* Test LU/Cholesky Factorization */
use_lu = PETSC_FALSE;
if (!symm) use_lu = PETSC_TRUE;
#if defined (PETSC_USE_COMPLEX)
if (isolver == 1) use_lu = PETSC_TRUE;
#endif
if (herm && !use_lu) { /* test also conversion routines inside the solver packages */
ierr = MatSetOption(A,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatConvert(A,MATSEQSBAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
}
if (use_lu) {
ierr = MatGetFactor(A,solver,MAT_FACTOR_LU,&F);CHKERRQ(ierr);
} else {
if (herm) {
ierr = MatSetOption(A,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatSetOption(A,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
} else {
ierr = MatSetOption(A,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatSetOption(A,MAT_SPD,PETSC_FALSE);CHKERRQ(ierr);
}
ierr = MatGetFactor(A,solver,MAT_FACTOR_CHOLESKY,&F);CHKERRQ(ierr);
}
ierr = ISCreateStride(PETSC_COMM_SELF,size_schur,m-size_schur,1,&is_schur);CHKERRQ(ierr);
ierr = MatFactorSetSchurIS(F,is_schur);CHKERRQ(ierr);
ierr = ISDestroy(&is_schur);CHKERRQ(ierr);
if (use_lu) {
ierr = MatLUFactorSymbolic(F,A,NULL,NULL,NULL);CHKERRQ(ierr);
} else {
ierr = MatCholeskyFactorSymbolic(F,A,NULL,NULL);CHKERRQ(ierr);
}
for (nfact = 0; nfact < 3; nfact++) {
Mat AD;
if (!nfact) {
ierr = VecSetRandom(x,rand);CHKERRQ(ierr);
if (symm && herm) {
ierr = VecAbs(x);CHKERRQ(ierr);
}
ierr = MatDiagonalSet(A,x,ADD_VALUES);CHKERRQ(ierr);
}
if (use_lu) {
ierr = MatLUFactorNumeric(F,A,NULL);CHKERRQ(ierr);
} else {
ierr = MatCholeskyFactorNumeric(F,A,NULL);CHKERRQ(ierr);
}
ierr = MatFactorCreateSchurComplement(F,&S);CHKERRQ(ierr);
ierr = MatCreateVecs(S,&xschur,&bschur);CHKERRQ(ierr);
ierr = VecDuplicate(xschur,&uschur);CHKERRQ(ierr);
if (nfact == 1) {
ierr = MatFactorInvertSchurComplement(F);CHKERRQ(ierr);
}
for (nsolve = 0; nsolve < 2; nsolve++) {
ierr = VecSetRandom(x,rand);CHKERRQ(ierr);
ierr = VecCopy(x,u);CHKERRQ(ierr);
if (nsolve) {
ierr = MatMult(A,x,b);CHKERRQ(ierr);
ierr = MatSolve(F,b,x);CHKERRQ(ierr);
} else {
ierr = MatMultTranspose(A,x,b);CHKERRQ(ierr);
ierr = MatSolveTranspose(F,b,x);CHKERRQ(ierr);
}
/* Check the error */
ierr = VecAXPY(u,-1.0,x);CHKERRQ(ierr); /* u <- (-1.0)x + u */
ierr = VecNorm(u,NORM_2,&norm);CHKERRQ(ierr);
if (norm > tol) {
PetscReal resi;
if (nsolve) {
ierr = MatMult(A,x,u);CHKERRQ(ierr); /* u = A*x */
} else {
ierr = MatMultTranspose(A,x,u);CHKERRQ(ierr); /* u = A*x */
}
ierr = VecAXPY(u,-1.0,b);CHKERRQ(ierr); /* u <- (-1.0)b + u */
ierr = VecNorm(u,NORM_2,&resi);CHKERRQ(ierr);
if (nsolve) {
ierr = PetscPrintf(PETSC_COMM_SELF,"(f %d, s %d) MatSolve error: Norm of error %g, residual %f\n",nfact,nsolve,norm,resi);CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_SELF,"(f %d, s %d) MatSolveTranspose error: Norm of error %g, residual %f\n",nfact,nsolve,norm,resi);CHKERRQ(ierr);
}
}
ierr = VecSetRandom(xschur,rand);CHKERRQ(ierr);
ierr = VecCopy(xschur,uschur);CHKERRQ(ierr);
if (nsolve) {
ierr = MatMult(S,xschur,bschur);CHKERRQ(ierr);
ierr = MatFactorSolveSchurComplement(F,bschur,xschur);CHKERRQ(ierr);
} else {
ierr = MatMultTranspose(S,xschur,bschur);CHKERRQ(ierr);
ierr = MatFactorSolveSchurComplementTranspose(F,bschur,xschur);CHKERRQ(ierr);
}
/* Check the error */
ierr = VecAXPY(uschur,-1.0,xschur);CHKERRQ(ierr); /* u <- (-1.0)x + u */
ierr = VecNorm(uschur,NORM_2,&norm);CHKERRQ(ierr);
if (norm > tol) {
PetscReal resi;
if (nsolve) {
ierr = MatMult(S,xschur,uschur);CHKERRQ(ierr); /* u = A*x */
} else {
ierr = MatMultTranspose(S,xschur,uschur);CHKERRQ(ierr); /* u = A*x */
}
ierr = VecAXPY(uschur,-1.0,bschur);CHKERRQ(ierr); /* u <- (-1.0)b + u */
ierr = VecNorm(uschur,NORM_2,&resi);CHKERRQ(ierr);
if (nsolve) {
ierr = PetscPrintf(PETSC_COMM_SELF,"(f %d, s %d) MatFactorSolveSchurComplement error: Norm of error %g, residual %f\n",nfact,nsolve,norm,resi);CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_SELF,"(f %d, s %d) MatFactorSolveSchurComplementTranspose error: Norm of error %g, residual %f\n",nfact,nsolve,norm,resi);CHKERRQ(ierr);
}
}
}
ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&AD);
if (!nfact) {
ierr = MatMatMult(AD,C,MAT_INITIAL_MATRIX,2.0,&RHS);CHKERRQ(ierr);
} else {
ierr = MatMatMult(AD,C,MAT_REUSE_MATRIX,2.0,&RHS);CHKERRQ(ierr);
}
ierr = MatDestroy(&AD);CHKERRQ(ierr);
for (nsolve = 0; nsolve < 2; nsolve++) {
ierr = MatMatSolve(F,RHS,X);CHKERRQ(ierr);
/* Check the error */
ierr = MatAXPY(X,-1.0,C,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatNorm(X,NORM_FROBENIUS,&norm);CHKERRQ(ierr);
if (norm > tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"(f %D, s %D) MatMatSolve: Norm of error %g\n",nfact,nsolve,norm);CHKERRQ(ierr);
}
}
ierr = MatDestroy(&S);CHKERRQ(ierr);
ierr = VecDestroy(&xschur);CHKERRQ(ierr);
ierr = VecDestroy(&bschur);CHKERRQ(ierr);
ierr = VecDestroy(&uschur);CHKERRQ(ierr);
}
/* Free data structures */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&F);CHKERRQ(ierr);
ierr = MatDestroy(&X);CHKERRQ(ierr);
ierr = MatDestroy(&RHS);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rand);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
/*
I should not modify setup called!!
This is handled via petsc.
*/
PetscErrorCode BSSCR_PCSetUp_GtKG( PC pc )
{
PC_GtKG ctx = (PC_GtKG)pc->data;
PetscReal fill;
Mat Ident;
Vec diag;
PetscInt M,N, m,n;
MPI_Comm comm;
PetscInt nnz_I, nnz_G;
const MatType mtype;
const char *prefix;
PetscTruth wasSetup;
if( ctx->K == PETSC_NULL ) {
Stg_SETERRQ( PETSC_ERR_SUP, "gtkg: K not set" );
}
if( ctx->G == PETSC_NULL ) {
Stg_SETERRQ( PETSC_ERR_SUP, "gtkg: G not set" );
}
PetscObjectGetComm( (PetscObject)ctx->K, &comm );
/* Check for existence of objects and trash any which exist */
if( ctx->form_GtG == PETSC_TRUE && ctx->GtG != PETSC_NULL ) {
Stg_MatDestroy(&ctx->GtG );
ctx->GtG = PETSC_NULL;
}
if( ctx->s != PETSC_NULL ) {
Stg_VecDestroy(&ctx->s );
ctx->s = PETSC_NULL;
}
if( ctx->X != PETSC_NULL ) {
Stg_VecDestroy(&ctx->X );
ctx->X = PETSC_NULL;
}
if( ctx->t != PETSC_NULL ) {
Stg_VecDestroy(&ctx->t );
ctx->t = PETSC_NULL;
}
if( ctx->inv_diag_M != PETSC_NULL ) {
Stg_VecDestroy(&ctx->inv_diag_M );
ctx->inv_diag_M = PETSC_NULL;
}
/* Create vectors */
MatGetVecs( ctx->K, &ctx->s, &ctx->X );
MatGetVecs( ctx->G, &ctx->t, PETSC_NULL );
if( ctx->M != PETSC_NULL ) {
MatGetVecs( ctx->K, &ctx->inv_diag_M, PETSC_NULL );
MatGetDiagonal( ctx->M, ctx->inv_diag_M );
VecReciprocal( ctx->inv_diag_M );
/* change the pc_apply routines */
pc->ops->apply = BSSCR_BSSCR_PCApply_GtKG_diagonal_scaling;
pc->ops->applytranspose = BSSCR_BSSCR_PCApplyTranspose_GtKG_diagonal_scaling;
}
/* Assemble GtG */
MatGetSize( ctx->G, &M, &N );
MatGetLocalSize( ctx->G, &m, &n );
MatGetVecs( ctx->G, PETSC_NULL, &diag );
VecSet( diag, 1.0 );
MatCreate( comm, &Ident );
MatSetSizes( Ident, m,m , M, M );
#if (((PETSC_VERSION_MAJOR==3) && (PETSC_VERSION_MINOR>=3)) || (PETSC_VERSION_MAJOR>3) )
MatSetUp(Ident);
#endif
MatGetType( ctx->G, &mtype );
MatSetType( Ident, mtype );
if( ctx->M == PETSC_NULL ) {
MatDiagonalSet( Ident, diag, INSERT_VALUES );
}
else {
MatDiagonalSet( Ident, ctx->inv_diag_M, INSERT_VALUES );
}
BSSCR_get_number_nonzeros_AIJ( Ident, &nnz_I );
BSSCR_get_number_nonzeros_AIJ( ctx->G, &nnz_G );
//fill = 1.0;
/*
Not sure the best way to estimate the fill factor.
GtG is a laplacian on the pressure space.
This might tell us something useful...
*/
fill = (PetscReal)(nnz_G)/(PetscReal)( nnz_I );
MatPtAP( Ident, ctx->G, MAT_INITIAL_MATRIX, fill, &ctx->GtG );
Stg_MatDestroy(&Ident);
Stg_VecDestroy(&diag );
Stg_KSPSetOperators( ctx->ksp, ctx->GtG, ctx->GtG, SAME_NONZERO_PATTERN );
if (!pc->setupcalled) {
wasSetup = PETSC_FALSE;
PCGetOptionsPrefix( pc,&prefix );
KSPSetOptionsPrefix( ctx->ksp, prefix );
KSPAppendOptionsPrefix( ctx->ksp, "pc_gtkg_" ); /* -pc_GtKG_ksp_type <type>, -ksp_GtKG_pc_type <type> */
}
else {
wasSetup = PETSC_TRUE;
}
// if (!wasSetup && pc->setfromoptionscalled) {
if (!wasSetup) {
KSPSetFromOptions(ctx->ksp);
}
PetscFunctionReturn(0);
}
