extern PetscErrorCode MatLMVMAllocateVectors(Mat m, Vec v)
{
PetscErrorCode ierr;
MatLMVMCtx *ctx;
PetscBool same;
PetscFunctionBegin;
PetscValidHeaderSpecific(m,MAT_CLASSID,1);
PetscValidHeaderSpecific(v,VEC_CLASSID,2);
ierr = PetscObjectTypeCompare((PetscObject)m,MATSHELL,&same);CHKERRQ(ierr);
if (!same) SETERRQ(PETSC_COMM_SELF,1,"Matrix m is not type MatLMVM");
ierr = MatShellGetContext(m,(void**)&ctx);CHKERRQ(ierr);
/* Perform allocations */
ierr = VecDuplicateVecs(v,ctx->lm+1,&ctx->S);CHKERRQ(ierr);
ierr = VecDuplicateVecs(v,ctx->lm+1,&ctx->Y);CHKERRQ(ierr);
ierr = VecDuplicate(v,&ctx->D);CHKERRQ(ierr);
ierr = VecDuplicate(v,&ctx->U);CHKERRQ(ierr);
ierr = VecDuplicate(v,&ctx->V);CHKERRQ(ierr);
ierr = VecDuplicate(v,&ctx->W);CHKERRQ(ierr);
ierr = VecDuplicate(v,&ctx->P);CHKERRQ(ierr);
ierr = VecDuplicate(v,&ctx->Q);CHKERRQ(ierr);
ctx->allocated = PETSC_TRUE;
PetscFunctionReturn(0);
}
PetscErrorCode MatPoissonCreate(MPI_Comm comm, int rank, int *dim, unsigned flag, Vec vx, Vec vy, Mat *A) {
PetscErrorCode ierr;
MatPoisson *c;
int n;
PetscFunctionBegin;
ierr = PetscMalloc(sizeof(MatPoisson), &c); CHKERRQ(ierr);
ierr = PetscMalloc(rank * sizeof(int), &(c->dim)); CHKERRQ(ierr);
ierr = PetscMalloc(rank * sizeof(Mat *), &(c->A)); CHKERRQ(ierr);
c->rank = rank;
for (int i=0; i < rank; i++) {
c->dim[i] = dim[i];
ierr = MatCreateCheb(comm, rank, i, dim, flag, vx, vy, &(c->A[i])); CHKERRQ(ierr);
}
ierr = VecDuplicateVecs(vx, rank, &c->u); CHKERRQ(ierr);
ierr = VecDuplicateVecs(vx, rank, &c->v); CHKERRQ(ierr);
ierr = VecGetSize(vx, &n); CHKERRQ(ierr);
ierr = MatCreateShell(comm, n, n, n, n, c, A); CHKERRQ(ierr);
ierr = MatShellSetOperation(*A, MATOP_MULT, (void(*)(void))MatPoissonMult); CHKERRQ(ierr);
ierr = MatShellSetOperation(*A, MATOP_DESTROY, (void(*)(void))MatPoissonDestroy); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatSetUp_LMVM(Mat B)
{
Mat_LMVM *lmvm = (Mat_LMVM*)B->data;
PetscErrorCode ierr;
PetscInt m, n, M, N;
PetscMPIInt size;
MPI_Comm comm = PetscObjectComm((PetscObject)B);
PetscFunctionBegin;
ierr = MatGetSize(B, &M, &N);CHKERRQ(ierr);
if (M == 0 && N == 0) SETERRQ(comm, PETSC_ERR_ORDER, "MatSetSizes() must be called before MatSetUp()");
if (!lmvm->allocated) {
ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
if (size == 1) {
ierr = VecCreateSeq(comm, N, &lmvm->Xprev);CHKERRQ(ierr);
ierr = VecCreateSeq(comm, M, &lmvm->Fprev);CHKERRQ(ierr);
} else {
ierr = MatGetLocalSize(B, &m, &n);CHKERRQ(ierr);
ierr = VecCreateMPI(comm, n, N, &lmvm->Xprev);CHKERRQ(ierr);
ierr = VecCreateMPI(comm, m, M, &lmvm->Fprev);CHKERRQ(ierr);
}
if (lmvm->m > 0) {
ierr = VecDuplicateVecs(lmvm->Xprev, lmvm->m, &lmvm->S);CHKERRQ(ierr);
ierr = VecDuplicateVecs(lmvm->Fprev, lmvm->m, &lmvm->Y);CHKERRQ(ierr);
}
lmvm->allocated = PETSC_TRUE;
B->preallocated = PETSC_TRUE;
B->assembled = PETSC_TRUE;
}
PetscFunctionReturn(0);
}
static PetscErrorCode SNESSetUp_QN(SNES snes)
{
SNES_QN *qn = (SNES_QN*)snes->data;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecDuplicateVecs(snes->vec_sol, qn->m, &qn->U);CHKERRQ(ierr);
ierr = VecDuplicateVecs(snes->vec_sol, qn->m, &qn->V);CHKERRQ(ierr);
ierr = PetscMalloc3(qn->m, PetscScalar, &qn->alpha,
qn->m, PetscScalar, &qn->beta,
qn->m, PetscScalar, &qn->dXtdF);CHKERRQ(ierr);
if (qn->singlereduction) {
ierr = PetscMalloc3(qn->m*qn->m, PetscScalar, &qn->dXdFmat,
qn->m, PetscScalar, &qn->dFtdX,
qn->m, PetscScalar, &qn->YtdX);CHKERRQ(ierr);
}
ierr = SNESSetWorkVecs(snes,4);CHKERRQ(ierr);
/* set up the line search */
if (qn->scale_type == SNES_QN_SCALE_JACOBIAN) {
ierr = SNESSetUpMatrices(snes);CHKERRQ(ierr);
}
if (snes->pcside == PC_LEFT && snes->functype == SNES_FUNCTION_DEFAULT) {snes->functype = SNES_FUNCTION_UNPRECONDITIONED;}
PetscFunctionReturn(0);
}
static PetscErrorCode TSRKTableauSetUp(TS ts)
{
TS_RK *rk = (TS_RK*)ts->data;
RKTableau tab = rk->tableau;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscMalloc1(tab->s,&rk->work);CHKERRQ(ierr);
ierr = VecDuplicateVecs(ts->vec_sol,tab->s,&rk->Y);CHKERRQ(ierr);
ierr = VecDuplicateVecs(ts->vec_sol,tab->s,&rk->YdotRHS);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
KSPGetVecs - Gets a number of work vectors.
Input Parameters:
+ ksp - iterative context
. rightn - number of right work vectors
- leftn - number of left work vectors to allocate
Output Parameter:
+ right - the array of vectors created
- left - the array of left vectors
Note: The right vector has as many elements as the matrix has columns. The left
vector has as many elements as the matrix has rows.
Level: advanced
.seealso: MatGetVecs()
@*/
PetscErrorCode KSPGetVecs(KSP ksp,PetscInt rightn, Vec **right,PetscInt leftn,Vec **left)
{
PetscErrorCode ierr;
Vec vecr,vecl;
PetscFunctionBegin;
if (rightn) {
if (!right) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_ARG_INCOMP,"You asked for right vectors but did not pass a pointer to hold them");
if (ksp->vec_sol) vecr = ksp->vec_sol;
else {
if (ksp->dm) {
ierr = DMGetGlobalVector(ksp->dm,&vecr);CHKERRQ(ierr);
} else {
Mat mat;
if (!ksp->pc) {ierr = KSPGetPC(ksp,&ksp->pc);CHKERRQ(ierr);}
ierr = PCGetOperators(ksp->pc,&mat,NULL,NULL);CHKERRQ(ierr);
ierr = MatGetVecs(mat,&vecr,NULL);CHKERRQ(ierr);
}
}
ierr = VecDuplicateVecs(vecr,rightn,right);CHKERRQ(ierr);
if (!ksp->vec_sol) {
if (ksp->dm) {
ierr = DMRestoreGlobalVector(ksp->dm,&vecr);CHKERRQ(ierr);
} else {
ierr = VecDestroy(&vecr);CHKERRQ(ierr);
}
}
}
if (leftn) {
if (!left) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_ARG_INCOMP,"You asked for left vectors but did not pass a pointer to hold them");
if (ksp->vec_rhs) vecl = ksp->vec_rhs;
else {
if (ksp->dm) {
ierr = DMGetGlobalVector(ksp->dm,&vecl);CHKERRQ(ierr);
} else {
Mat mat;
if (!ksp->pc) {ierr = KSPGetPC(ksp,&ksp->pc);CHKERRQ(ierr);}
ierr = PCGetOperators(ksp->pc,&mat,NULL,NULL);CHKERRQ(ierr);
ierr = MatGetVecs(mat,NULL,&vecl);CHKERRQ(ierr);
}
}
ierr = VecDuplicateVecs(vecl,leftn,left);CHKERRQ(ierr);
if (!ksp->vec_rhs) {
if (ksp->dm) {
ierr = DMRestoreGlobalVector(ksp->dm,&vecl);CHKERRQ(ierr);
} else {
ierr = VecDestroy(&vecl);CHKERRQ(ierr);
}
}
}
PetscFunctionReturn(0);
}
static PetscErrorCode TSAdjointSetUp_Theta(TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecDuplicateVecs(ts->vecs_sensi[0],ts->numcost,&th->VecsDeltaLam);CHKERRQ(ierr);
if(ts->vecs_sensip) {
ierr = VecDuplicateVecs(ts->vecs_sensip[0],ts->numcost,&th->VecsDeltaMu);CHKERRQ(ierr);
}
ierr = VecDuplicateVecs(ts->vecs_sensi[0],ts->numcost,&th->VecsSensiTemp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode KSPSetUp_LCD(KSP ksp)
{
KSP_LCD *lcd = (KSP_LCD*)ksp->data;
PetscErrorCode ierr;
PetscInt restart = lcd->restart;
PetscFunctionBegin;
/* get work vectors needed by LCD */
ierr = KSPSetWorkVecs(ksp,2);CHKERRQ(ierr);
ierr = VecDuplicateVecs(ksp->work[0],restart+1,&lcd->P);CHKERRQ(ierr);
ierr = VecDuplicateVecs(ksp->work[0], restart + 1, &lcd->Q);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)ksp,2*(restart+2)*sizeof(Vec));CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSAdjointSetUp_RK(TS ts)
{
TS_RK *rk = (TS_RK*)ts->data;
RKTableau tab = rk->tableau;
PetscInt s = tab->s;
PetscErrorCode ierr;
PetscFunctionBegin;
if (ts->adjointsetupcalled++) PetscFunctionReturn(0);
ierr = VecDuplicateVecs(ts->vecs_sensi[0],s*ts->numcost,&rk->VecDeltaLam);CHKERRQ(ierr);
if(ts->vecs_sensip) {
ierr = VecDuplicateVecs(ts->vecs_sensip[0],s*ts->numcost,&rk->VecDeltaMu);CHKERRQ(ierr);
}
ierr = VecDuplicateVecs(ts->vecs_sensi[0],ts->numcost,&rk->VecSensiTemp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode CheckMatrices(Mat A,Mat B,Vec left,Vec right,Vec X,Vec Y,Vec X1,Vec Y1)
{
PetscErrorCode ierr;
Vec *ltmp,*rtmp;
PetscFunctionBegin;
ierr = VecDuplicateVecs(right,2,&rtmp);CHKERRQ(ierr);
ierr = VecDuplicateVecs(left,2,<mp);CHKERRQ(ierr);
ierr = MatScale(A,PETSC_PI);CHKERRQ(ierr);
ierr = MatScale(B,PETSC_PI);CHKERRQ(ierr);
ierr = MatDiagonalScale(A,left,right);CHKERRQ(ierr);
ierr = MatDiagonalScale(B,left,right);CHKERRQ(ierr);
ierr = MatMult(A,X,ltmp[0]);CHKERRQ(ierr);
ierr = MatMult(B,X,ltmp[1]);CHKERRQ(ierr);
ierr = Compare2(ltmp,"MatMult");CHKERRQ(ierr);
ierr = MatMultTranspose(A,Y,rtmp[0]);CHKERRQ(ierr);
ierr = MatMultTranspose(B,Y,rtmp[1]);CHKERRQ(ierr);
ierr = Compare2(rtmp,"MatMultTranspose");CHKERRQ(ierr);
ierr = VecCopy(Y1,ltmp[0]);CHKERRQ(ierr);
ierr = VecCopy(Y1,ltmp[1]);CHKERRQ(ierr);
ierr = MatMultAdd(A,X,ltmp[0],ltmp[0]);CHKERRQ(ierr);
ierr = MatMultAdd(B,X,ltmp[1],ltmp[1]);CHKERRQ(ierr);
ierr = Compare2(ltmp,"MatMultAdd v2==v3");CHKERRQ(ierr);
ierr = MatMultAdd(A,X,Y1,ltmp[0]);CHKERRQ(ierr);
ierr = MatMultAdd(B,X,Y1,ltmp[1]);CHKERRQ(ierr);
ierr = Compare2(ltmp,"MatMultAdd v2!=v3");CHKERRQ(ierr);
ierr = VecCopy(X1,rtmp[0]);CHKERRQ(ierr);
ierr = VecCopy(X1,rtmp[1]);CHKERRQ(ierr);
ierr = MatMultTransposeAdd(A,Y,rtmp[0],rtmp[0]);CHKERRQ(ierr);
ierr = MatMultTransposeAdd(B,Y,rtmp[1],rtmp[1]);CHKERRQ(ierr);
ierr = Compare2(rtmp,"MatMultTransposeAdd v2==v3");CHKERRQ(ierr);
ierr = MatMultTransposeAdd(A,Y,X1,rtmp[0]);CHKERRQ(ierr);
ierr = MatMultTransposeAdd(B,Y,X1,rtmp[1]);CHKERRQ(ierr);
ierr = Compare2(rtmp,"MatMultTransposeAdd v2!=v3");CHKERRQ(ierr);
ierr = VecDestroyVecs(2,<mp);CHKERRQ(ierr);
ierr = VecDestroyVecs(2,&rtmp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc, char **argv)
{
PetscErrorCode ierr;
Vec *V,t;
PetscInt i,j,reps,n=15,k=6;
PetscRandom rctx;
PetscScalar *val_dot,*val_mdot,*tval_dot,*tval_mdot;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = PetscOptionsGetInt(NULL,NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-k",&k,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Test with %D random vectors of length %D",k,n);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n",k,n);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&t);CHKERRQ(ierr);
ierr = VecSetSizes(t,n,PETSC_DECIDE);CHKERRQ(ierr);
ierr = VecSetFromOptions(t);CHKERRQ(ierr);
ierr = VecDuplicateVecs(t,k,&V);CHKERRQ(ierr);
ierr = VecSetRandom(t,rctx);CHKERRQ(ierr);
ierr = PetscMalloc1(k,&val_dot);CHKERRQ(ierr);
ierr = PetscMalloc1(k,&val_mdot);CHKERRQ(ierr);
ierr = PetscMalloc1(k,&tval_dot);CHKERRQ(ierr);
ierr = PetscMalloc1(k,&tval_mdot);CHKERRQ(ierr);
for (i=0; i<k; i++) { ierr = VecSetRandom(V[i],rctx);CHKERRQ(ierr); }
for (reps=0; reps<20; reps++) {
for (i=1; i<k; i++) {
ierr = VecMDot(t,i,V,val_mdot);CHKERRQ(ierr);
ierr = VecMTDot(t,i,V,tval_mdot);CHKERRQ(ierr);
for (j=0;j<i;j++) {
ierr = VecDot(t,V[j],&val_dot[j]);CHKERRQ(ierr);
ierr = VecTDot(t,V[j],&tval_dot[j]);CHKERRQ(ierr);
}
/* Check result */
for (j=0;j<i;j++) {
if (PetscAbsScalar(val_mdot[j] - val_dot[j])/PetscAbsScalar(val_dot[j]) > 1e-5) {
ierr = PetscPrintf(PETSC_COMM_WORLD, "[TEST FAILED] i=%D, j=%D, val_mdot[j]=%g, val_dot[j]=%g\n",i,j,(double)PetscAbsScalar(val_mdot[j]), (double)PetscAbsScalar(val_dot[j]));CHKERRQ(ierr);
break;
}
if (PetscAbsScalar(tval_mdot[j] - tval_dot[j])/PetscAbsScalar(tval_dot[j]) > 1e-5) {
ierr = PetscPrintf(PETSC_COMM_WORLD, "[TEST FAILED] i=%D, j=%D, tval_mdot[j]=%g, tval_dot[j]=%g\n",i,j,(double)PetscAbsScalar(tval_mdot[j]), (double)PetscAbsScalar(tval_dot[j]));CHKERRQ(ierr);
break;
}
}
}
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"Test completed successfully!\n",k,n);CHKERRQ(ierr);
ierr = PetscFree(val_dot);CHKERRQ(ierr);
ierr = PetscFree(val_mdot);CHKERRQ(ierr);
ierr = PetscFree(tval_dot);CHKERRQ(ierr);
ierr = PetscFree(tval_mdot);CHKERRQ(ierr);
ierr = VecDestroyVecs(k,&V);CHKERRQ(ierr);
ierr = VecDestroy(&t);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode KSPSetUp_GCR( KSP ksp )
{
KSP_GCR *ctx = (KSP_GCR*)ksp->data;
PetscErrorCode ierr;
Mat A;
PetscBool diagonalscale;
PetscFunctionBegin;
ierr = PCGetDiagonalScale(ksp->pc,&diagonalscale);CHKERRQ(ierr);
if (diagonalscale) SETERRQ1(((PetscObject)ksp)->comm,PETSC_ERR_SUP,"Krylov method %s does not support diagonal scaling",((PetscObject)ksp)->type_name);
ierr = KSPGetOperators( ksp, &A, 0, 0 );CHKERRQ(ierr);
ierr = MatGetVecs( A, &ctx->R, PETSC_NULL );CHKERRQ(ierr);
ierr = VecDuplicateVecs( ctx->R, ctx->restart, &ctx->VV );CHKERRQ(ierr);
ierr = VecDuplicateVecs( ctx->R, ctx->restart, &ctx->SS );CHKERRQ(ierr);
ierr = PetscMalloc( sizeof(PetscScalar)*ctx->restart, &ctx->val );CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode SNESSetUp_QN(SNES snes)
{
SNES_QN *qn = (SNES_QN*)snes->data;
PetscErrorCode ierr;
DM dm;
PetscFunctionBegin;
if (!snes->vec_sol) {
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(dm,&snes->vec_sol);CHKERRQ(ierr);
}
ierr = VecDuplicateVecs(snes->vec_sol, qn->m, &qn->U);CHKERRQ(ierr);
if (qn->type != SNES_QN_BROYDEN) ierr = VecDuplicateVecs(snes->vec_sol, qn->m, &qn->V);CHKERRQ(ierr);
ierr = PetscMalloc4(qn->m,&qn->alpha,qn->m,&qn->beta,qn->m,&qn->dXtdF,qn->m,&qn->lambda);CHKERRQ(ierr);
if (qn->singlereduction) {
ierr = PetscMalloc3(qn->m*qn->m,&qn->dXdFmat,qn->m,&qn->dFtdX,qn->m,&qn->YtdX);CHKERRQ(ierr);
}
ierr = SNESSetWorkVecs(snes,4);CHKERRQ(ierr);
/* set method defaults */
if (qn->scale_type == SNES_QN_SCALE_DEFAULT) {
if (qn->type == SNES_QN_BADBROYDEN) {
qn->scale_type = SNES_QN_SCALE_NONE;
} else {
qn->scale_type = SNES_QN_SCALE_SHANNO;
}
}
if (qn->restart_type == SNES_QN_RESTART_DEFAULT) {
if (qn->type == SNES_QN_LBFGS) {
qn->restart_type = SNES_QN_RESTART_POWELL;
} else {
qn->restart_type = SNES_QN_RESTART_PERIODIC;
}
}
if (qn->scale_type == SNES_QN_SCALE_JACOBIAN) {
ierr = SNESSetUpMatrices(snes);CHKERRQ(ierr);
}
if (snes->pcside == PC_LEFT && snes->functype == SNES_FUNCTION_DEFAULT) {snes->functype = SNES_FUNCTION_UNPRECONDITIONED;}
PetscFunctionReturn(0);
}
PetscErrorCode MatAllocate_LMVM(Mat B, Vec X, Vec F)
{
Mat_LMVM *lmvm = (Mat_LMVM*)B->data;
PetscErrorCode ierr;
PetscBool same, allocate = PETSC_FALSE;
PetscInt m, n, M, N;
VecType type;
PetscFunctionBegin;
if (lmvm->allocated) {
VecCheckMatCompatible(B, X, 2, F, 3);
ierr = VecGetType(X, &type);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)lmvm->Xprev, type, &same);CHKERRQ(ierr);
if (!same) {
/* Given X vector has a different type than allocated X-type data structures.
We need to destroy all of this and duplicate again out of the given vector. */
allocate = PETSC_TRUE;
ierr = MatLMVMReset(B, PETSC_TRUE);CHKERRQ(ierr);
}
} else {
allocate = PETSC_TRUE;
}
if (allocate) {
ierr = VecGetLocalSize(X, &n);CHKERRQ(ierr);
ierr = VecGetSize(X, &N);CHKERRQ(ierr);
ierr = VecGetLocalSize(F, &m);CHKERRQ(ierr);
ierr = VecGetSize(F, &M);CHKERRQ(ierr);
ierr = MatSetSizes(B, m, n, M, N);CHKERRQ(ierr);
ierr = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr);
ierr = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr);
ierr = VecDuplicate(X, &lmvm->Xprev);CHKERRQ(ierr);
ierr = VecDuplicate(F, &lmvm->Fprev);CHKERRQ(ierr);
if (lmvm->m > 0) {
ierr = VecDuplicateVecs(lmvm->Xprev, lmvm->m, &lmvm->S);CHKERRQ(ierr);
ierr = VecDuplicateVecs(lmvm->Fprev, lmvm->m, &lmvm->Y);CHKERRQ(ierr);
}
lmvm->allocated = PETSC_TRUE;
B->preallocated = PETSC_TRUE;
B->assembled = PETSC_TRUE;
}
PetscFunctionReturn(0);
}
PetscErrorCode KSPSetUp_AGMRES(KSP ksp)
{
PetscErrorCode ierr;
PetscInt hes;
PetscInt nloc;
KSP_AGMRES *agmres = (KSP_AGMRES*)ksp->data;
PetscInt neig = agmres->neig;
PetscInt max_k = agmres->max_k;
PetscInt N = MAXKSPSIZE;
PetscInt lwork = PetscMax(8 * N + 16, 4 * neig * (N - neig));
PetscFunctionBegin;
if (ksp->pc_side == PC_SYMMETRIC) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"no symmetric preconditioning for KSPAGMRES");
max_k = agmres->max_k;
N = MAXKSPSIZE;
/* Preallocate space during the call to KSPSetup_GMRES for the Krylov basis */
agmres->q_preallocate = PETSC_TRUE; /* No allocation on the fly */
/* Preallocate space to compute later the eigenvalues in GMRES */
ksp->calc_sings = PETSC_TRUE;
agmres->max_k = N; /* Set the augmented size to be allocated in KSPSetup_GMRES */
ierr = KSPSetUp_DGMRES(ksp);CHKERRQ(ierr);
agmres->max_k = max_k;
hes = (N + 1) * (N + 1);
/* Data for the Newton basis GMRES */
ierr = PetscMalloc4(max_k,PetscScalar,&agmres->Rshift,max_k,PetscScalar,&agmres->Ishift,hes,PetscScalar,&agmres->Rloc,((N+1)*4),PetscScalar,&agmres->wbufptr);CHKERRQ(ierr);
ierr = PetscMalloc7((N+1),PetscScalar,&agmres->Scale,(N+1),PetscScalar,&agmres->sgn,(N+1),PetscScalar,&agmres->tloc,(N+1),PetscScalar,&agmres->temp,(N+1),PetscScalar,&agmres->tau,lwork,PetscScalar,&agmres->work,(N+1),PetscScalar,&agmres->nrs);CHKERRQ(ierr);
ierr = PetscMemzero(agmres->Rshift, max_k*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(agmres->Ishift, max_k*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(agmres->Scale, (N+1)*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(agmres->Rloc, (N+1)*(N+1)*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(agmres->sgn, (N+1)*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(agmres->tloc, (N+1)*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(agmres->temp, (N+1)*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(agmres->wbufptr, (N+1)*4*sizeof(PetscScalar));CHKERRQ(ierr);
/* Allocate space for the vectors in the orthogonalized basis*/
ierr = VecGetLocalSize(agmres->vecs[0], &nloc);CHKERRQ(ierr);
ierr = PetscMalloc(nloc*(N+1)*sizeof(PetscScalar), &agmres->Qloc);CHKERRQ(ierr);
/* Init the ring of processors for the roddec orthogonalization */
ierr = KSPAGMRESRoddecInitNeighboor(ksp);CHKERRQ(ierr);
if (agmres->neig < 1) PetscFunctionReturn(0);
/* Allocate space for the deflation */
ierr = PetscMalloc(N*sizeof(PetscScalar), &agmres->select);CHKERRQ(ierr);
ierr = VecDuplicateVecs(VEC_V(0), N, &agmres->TmpU);CHKERRQ(ierr);
ierr = PetscMalloc2(N*N, PetscScalar, &agmres->MatEigL, N*N, PetscScalar, &agmres->MatEigR);CHKERRQ(ierr);
/* ierr = PetscMalloc6(N*N, PetscScalar, &agmres->Q, N*N, PetscScalar, &agmres->Z, N, PetscScalar, &agmres->wr, N, PetscScalar, &agmres->wi, N, PetscScalar, &agmres->beta, N, PetscScalar, &agmres->modul);CHKERRQ(ierr); */
ierr = PetscMalloc3(N*N, PetscScalar, &agmres->Q, N*N, PetscScalar, &agmres->Z, N, PetscScalar, &agmres->beta);CHKERRQ(ierr);
ierr = PetscMalloc2((N+1),PetscInt,&agmres->perm,(2*neig*N),PetscInt,&agmres->iwork);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
SNESDefaultGetWork - Gets a number of work vectors.
Input Parameters:
. snes - the SNES context
. nw - number of work vectors to allocate
Level: developer
Notes:
Call this only if no work vectors have been allocated
@*/
PetscErrorCode SNESDefaultGetWork(SNES snes,PetscInt nw)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (snes->work) {ierr = VecDestroyVecs(snes->nwork,&snes->work);CHKERRQ(ierr);}
snes->nwork = nw;
ierr = VecDuplicateVecs(snes->vec_sol,snes->nwork,&snes->work);CHKERRQ(ierr);
ierr = PetscLogObjectParents(snes,nw,snes->work);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
DMMGSetNullSpace - Indicates the null space in the linear operator (this is needed by the linear solver)
Collective on DMMG
Input Parameter:
+ dmmg - the context
. has_cnst - is the constant vector in the null space
. n - number of null vectors (excluding the possible constant vector)
- func - a function that fills an array of vectors with the null vectors (must be orthonormal), may be PETSC_NULL
Level: advanced
.seealso DMMGCreate(), DMMGDestroy, DMMGSetDM(), DMMGSolve(), MatNullSpaceCreate(), KSPSetNullSpace(), DMMGSetMatType()
@*/
PetscErrorCode PETSCSNES_DLLEXPORT DMMGSetNullSpace(DMMG *dmmg,PetscTruth has_cnst,PetscInt n,PetscErrorCode (*func)(DMMG,Vec[]))
{
PetscErrorCode ierr;
PetscInt i,j,nlevels = dmmg[0]->nlevels;
Vec *nulls = 0;
MatNullSpace nullsp;
KSP iksp;
PC pc,ipc;
PetscTruth ismg,isred;
PetscFunctionBegin;
if (!dmmg) SETERRQ(PETSC_ERR_ARG_NULL,"Passing null as DMMG");
if (!dmmg[0]->ksp) SETERRQ(PETSC_ERR_ORDER,"Must call AFTER DMMGSetKSP() or DMMGSetSNES()");
if ((n && !func) || (!n && func)) SETERRQ(PETSC_ERR_ARG_INCOMP,"Both n and func() must be set together");
if (n < 0) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Cannot have negative number of vectors in null space n = %D",n)
for (i=0; i<nlevels; i++) {
if (n) {
ierr = VecDuplicateVecs(dmmg[i]->b,n,&nulls);CHKERRQ(ierr);
ierr = (*func)(dmmg[i],nulls);CHKERRQ(ierr);
}
ierr = MatNullSpaceCreate(dmmg[i]->comm,has_cnst,n,nulls,&nullsp);CHKERRQ(ierr);
ierr = KSPSetNullSpace(dmmg[i]->ksp,nullsp);CHKERRQ(ierr);
for (j=i; j<nlevels; j++) {
ierr = KSPGetPC(dmmg[j]->ksp,&pc);CHKERRQ(ierr);
ierr = PetscTypeCompare((PetscObject)pc,PCMG,&ismg);CHKERRQ(ierr);
if (ismg) {
ierr = PCMGGetSmoother(pc,i,&iksp);CHKERRQ(ierr);
ierr = KSPSetNullSpace(iksp, nullsp);CHKERRQ(ierr);
}
}
ierr = MatNullSpaceDestroy(nullsp);CHKERRQ(ierr);
if (n) {
ierr = VecDestroyVecs(nulls,n);CHKERRQ(ierr);
}
}
/* make all the coarse grid solvers have LU shift since they are singular */
for (i=0; i<nlevels; i++) {
ierr = KSPGetPC(dmmg[i]->ksp,&pc);CHKERRQ(ierr);
ierr = PetscTypeCompare((PetscObject)pc,PCMG,&ismg);CHKERRQ(ierr);
if (ismg) {
ierr = PCMGGetSmoother(pc,0,&iksp);CHKERRQ(ierr);
ierr = KSPGetPC(iksp,&ipc);CHKERRQ(ierr);
ierr = PetscTypeCompare((PetscObject)ipc,PCREDUNDANT,&isred);CHKERRQ(ierr);
if (isred) {
ierr = PCRedundantGetPC(ipc,&ipc);CHKERRQ(ierr);
}
ierr = PCFactorSetShiftType(ipc,MAT_SHIFT_POSITIVE_DEFINITE);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
static PetscErrorCode TSSetUp_RK(TS ts)
{
TS_RK *rk = (TS_RK*)ts->data;
RKTableau tab;
PetscInt s;
PetscErrorCode ierr;
DM dm;
PetscFunctionBegin;
if (!rk->tableau) {
ierr = TSRKSetType(ts,TSRKDefault);CHKERRQ(ierr);
}
tab = rk->tableau;
s = tab->s;
ierr = VecDuplicateVecs(ts->vec_sol,s,&rk->Y);CHKERRQ(ierr);
ierr = VecDuplicateVecs(ts->vec_sol,s,&rk->YdotRHS);CHKERRQ(ierr);
ierr = PetscMalloc1(s,&rk->work);CHKERRQ(ierr);
ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
if (dm) {
ierr = DMCoarsenHookAdd(dm,DMCoarsenHook_TSRK,DMRestrictHook_TSRK,ts);CHKERRQ(ierr);
ierr = DMSubDomainHookAdd(dm,DMSubDomainHook_TSRK,DMSubDomainRestrictHook_TSRK,ts);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@
PEPSetWorkVecs - Sets a number of work vectors into a PEP object.
Collective on PEP
Input Parameters:
+ pep - polynomial eigensolver context
- nw - number of work vectors to allocate
Developers Note:
This is PETSC_EXTERN because it may be required by user plugin PEP
implementations.
Level: developer
@*/
PetscErrorCode PEPSetWorkVecs(PEP pep,PetscInt nw)
{
PetscErrorCode ierr;
Vec t;
PetscFunctionBegin;
if (pep->nwork != nw) {
ierr = VecDestroyVecs(pep->nwork,&pep->work);CHKERRQ(ierr);
pep->nwork = nw;
ierr = BVGetColumn(pep->V,0,&t);CHKERRQ(ierr);
ierr = VecDuplicateVecs(t,nw,&pep->work);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,0,&t);CHKERRQ(ierr);
ierr = PetscLogObjectParents(pep,nw,pep->work);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode SNESSetUp_LS(SNES snes)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (!snes->vec_sol_update) {
ierr = VecDuplicate(snes->vec_sol,&snes->vec_sol_update);CHKERRQ(ierr);
ierr = PetscLogObjectParent(snes,snes->vec_sol_update);CHKERRQ(ierr);
}
if (!snes->work) {
snes->nwork = 3;
ierr = VecDuplicateVecs(snes->vec_sol,snes->nwork,&snes->work);CHKERRQ(ierr);
ierr = PetscLogObjectParents(snes,snes->nwork,snes->work);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@C
SNESSetWorkVecs - Gets a number of work vectors.
Input Parameters:
. snes - the SNES context
. nw - number of work vectors to allocate
Level: developer
Developers Note: This is PETSC_EXTERN because it may be used by user written plugin SNES implementations
@*/
PetscErrorCode SNESSetWorkVecs(SNES snes,PetscInt nw)
{
DM dm;
Vec v;
PetscErrorCode ierr;
PetscFunctionBegin;
if (snes->work) {ierr = VecDestroyVecs(snes->nwork,&snes->work);CHKERRQ(ierr);}
snes->nwork = nw;
ierr = SNESGetDM(snes, &dm);CHKERRQ(ierr);
ierr = DMGetGlobalVector(dm, &v);CHKERRQ(ierr);
ierr = VecDuplicateVecs(v,snes->nwork,&snes->work);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(dm, &v);CHKERRQ(ierr);
ierr = PetscLogObjectParents(snes,nw,snes->work);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode interpPeriodicVector(PetscScalar tc, Vec *u, PetscScalar cyclePeriod,
PetscInt numPeriods, PetscScalar *tdp,
PeriodicVec *user, char *filename)
{
/* Function to interpolate a vector that is periodic in time with period cyclePeriod. */
/* tc is the current time and numPeriods is the number of instances per period */
/* at which data are available (to be read from files). */
/* IMPORTANT: Vectors u0 and u1 MUST have been created and preallocated before */
/* calling this routine. Use VecDuplicate to do this. */
#include <math.h>
PetscScalar t,t1;
PetscInt im,it0,it1;
/* static PetscInt iCurrTimeReadLast=-1; */
PetscErrorCode ierr;
PetscScalar alpha[2];
char tmpFile[PETSC_MAX_PATH_LEN];
PetscViewer fd;
if (user->firstTime) {
user->numPeriods = numPeriods;
ierr = VecDuplicateVecs(*u,numPeriods,&user->up);CHKERRQ(ierr);
for (im=0; im<numPeriods; im++) {
strcpy(tmpFile,"");
sprintf(tmpFile,"%s%02d",filename,im);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Reading vector from file %s\n", tmpFile);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,tmpFile,FILE_MODE_READ,&fd);CHKERRQ(ierr);
ierr = VecLoadIntoVector(fd,user->up[im]);CHKERRQ(ierr);
ierr = PetscViewerDestroy(fd);CHKERRQ(ierr);
}
user->firstTime = PETSC_FALSE;
}
t=tc; /* current time */
if (t<0.) t=cyclePeriod+t;
t1=t-cyclePeriod*floor(t/cyclePeriod);
ierr=calcPeriodicInterpFactor(numPeriods,t1,tdp,&it0,&it1,&alpha[0],&alpha[1]); CHKERRQ(ierr);
/* ierr = PetscPrintf(PETSC_COMM_WORLD,"tc=%lf,t1=%lf,it0=%d,it1=%d,a1=%17.16lf,a2=%17.16lf\n",tc,t1,it0,it1,alpha[0],alpha[1]);CHKERRQ(ierr); */
/* interpolate to current time */
ierr = VecAXPBYmy(alpha[0],alpha[1],user->up[it0],user->up[it1],u);CHKERRQ(ierr);
return 0;
}
static PetscErrorCode TSSSPGetWorkVectors(TS ts,PetscInt n,Vec **work)
{
TS_SSP *ssp = (TS_SSP*)ts->data;
PetscErrorCode ierr;
PetscFunctionBegin;
if (ssp->workout) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Work vectors already gotten");
if (ssp->nwork < n) {
if (ssp->nwork > 0) {
ierr = VecDestroyVecs(ssp->nwork,&ssp->work);CHKERRQ(ierr);
}
ierr = VecDuplicateVecs(ts->vec_sol,n,&ssp->work);CHKERRQ(ierr);
ssp->nwork = n;
}
*work = ssp->work;
ssp->workout = PETSC_TRUE;
PetscFunctionReturn(0);
}
static PetscErrorCode TaoSetUp_NM(Tao tao)
{
PetscErrorCode ierr;
TAO_NelderMead *nm = (TAO_NelderMead *)tao->data;
PetscInt n;
PetscFunctionBegin;
ierr = VecGetSize(tao->solution,&n);CHKERRQ(ierr);
nm->N = n;
nm->oneOverN = 1.0/n;
ierr = VecDuplicateVecs(tao->solution,nm->N+1,&nm->simplex);CHKERRQ(ierr);
ierr = PetscMalloc1(nm->N+1,&nm->f_values);CHKERRQ(ierr);
ierr = PetscMalloc1(nm->N+1,&nm->indices);CHKERRQ(ierr);
ierr = VecDuplicate(tao->solution,&nm->Xbar);CHKERRQ(ierr);
ierr = VecDuplicate(tao->solution,&nm->Xmur);CHKERRQ(ierr);
ierr = VecDuplicate(tao->solution,&nm->Xmue);CHKERRQ(ierr);
ierr = VecDuplicate(tao->solution,&nm->Xmuc);CHKERRQ(ierr);
tao->gradient=0;
tao->step=0;
PetscFunctionReturn(0);
}
PetscErrorCode SNESDiffParameterCreate_More(SNES snes,Vec x,void **outneP)
{
DIFFPAR_MORE *neP;
Vec w;
PetscRandom rctx; /* random number generator context */
PetscErrorCode ierr;
PetscBool flg;
char noise_file[PETSC_MAX_PATH_LEN];
PetscFunctionBegin;
ierr = PetscNewLog(snes,&neP);CHKERRQ(ierr);
neP->function_count = 0;
neP->fnoise_min = 1.0e-20;
neP->hopt_min = 1.0e-8;
neP->h_first_try = 1.0e-3;
neP->fnoise_resets = 0;
neP->hopt_resets = 0;
/* Create work vectors */
ierr = VecDuplicateVecs(x,3,&neP->workv);CHKERRQ(ierr);
w = neP->workv[0];
/* Set components of vector w to random numbers */
ierr = PetscRandomCreate(PetscObjectComm((PetscObject)snes),&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = VecSetRandom(w,rctx);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);
/* Open output file */
ierr = PetscOptionsGetString(((PetscObject)snes)->prefix,"-snes_mf_noise_file",noise_file,PETSC_MAX_PATH_LEN,&flg);CHKERRQ(ierr);
if (flg) neP->fp = fopen(noise_file,"w");
else neP->fp = fopen("noise.out","w");
if (!neP->fp) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open file");
ierr = PetscInfo(snes,"Creating Jorge's differencing parameter context\n");CHKERRQ(ierr);
*outneP = neP;
PetscFunctionReturn(0);
}
static PetscErrorCode TSSetUp_EIMEX(TS ts)
{
TS_EIMEX *ext = (TS_EIMEX*)ts->data;
PetscErrorCode ierr;
DM dm;
PetscFunctionBegin;
if (!ext->N){ /* ext->max_rows not set */
ierr = TSEIMEXSetMaxRows(ts,TSEIMEXDefault);CHKERRQ(ierr);
}
if(-1 == ext->row_ind && -1 == ext->col_ind){
ierr = TSEIMEXSetRowCol(ts,ext->max_rows,ext->max_rows);CHKERRQ(ierr);
} else{/* ext->row_ind and col_ind already set */
if (ext->ord_adapt){
ierr = PetscInfo(ts,"Order adaptivity is enabled and TSEIMEXSetRowCol or -ts_eimex_row_col option will take no effect\n");CHKERRQ(ierr);
}
}
if(ext->ord_adapt){
ext->nstages = 2; /* Start with the 2-stage scheme */
ierr = TSEIMEXSetRowCol(ts,ext->nstages,ext->nstages);CHKERRQ(ierr);
} else{
ext->nstages = ext->max_rows; /* by default nstages is the same as max_rows, this can be changed by setting order adaptivity */
}
ierr = VecDuplicateVecs(ts->vec_sol,(1+ext->nstages)*ext->nstages/2,&ext->T);CHKERRQ(ierr);/* full T table */
ierr = VecDuplicate(ts->vec_sol,&ext->YdotI);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&ext->YdotRHS);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&ext->Ydot);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&ext->VecSolPrev);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&ext->Y);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&ext->Z);CHKERRQ(ierr);
ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
if (dm) {
ierr = DMCoarsenHookAdd(dm,DMCoarsenHook_TSEIMEX,DMRestrictHook_TSEIMEX,ts);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode cHamiltonianMatrix::KernalPolynomialMethod(){
int cutoff0 = int(1.5*a_scaling*tmax);
if (rank==0) cout << "cutoff is chosen as " << cutoff0 << endl;
ierr = VecDuplicate(X1,&X3);CHKERRQ(ierr);
ierr = VecDuplicateVecs(X1,Nt,&WFt);CHKERRQ(ierr);
for(int i = 0; i<Nt; ++i) {ierr = VecZeroEntries(WFt[i]);CHKERRQ(ierr);}
/* //view matrix or vector
PetscViewer viewer;
PetscViewerASCIIOpen(PETSC_COMM_WORLD, NULL, &viewer);
PetscViewerSetFormat(viewer, PETSC_VIEWER_ASCII_DENSE);
*/
ierr = VecCopy(X1,X3);CHKERRQ(ierr); // TODO: avoid the copy for efficiency.
WaveFunctionUpdate(0);
//if (rank==0) cout<< "iter_k="<< 1 <<": X3=" << endl;
//VecView(X3,viewer);
ierr = MatMult(Hpolaron,X1,X2);CHKERRQ(ierr);
ierr = VecCopy(X2,X3);CHKERRQ(ierr); // TODO: avoid the copy for efficiency.
WaveFunctionUpdate(1);
//if (rank==0) cout<< "iter_k="<< 2 <<": X3=" << endl;
//VecView(X3,viewer);
for (int iter_k = 2; iter_k <= cutoff0; ++iter_k) {
ierr = MatMult(Hpolaron,X2,X3);CHKERRQ(ierr);
ierr = VecScale(X3,2.0);CHKERRQ(ierr);
ierr = VecAXPY(X3,-1.0,X1);CHKERRQ(ierr);
WaveFunctionUpdate(iter_k);
/* if (iter_k==1000) {
if (rank==0) cout<< "iter_k="<< iter_k+1 <<": X3=" << endl;
VecView(X3,viewer);
}*/
ierr = VecCopy(X2,X1);CHKERRQ(ierr);
ierr = VecCopy(X3,X2);CHKERRQ(ierr);
if(iter_k%int(cutoff0*0.1)==0) if (rank==0) cout << iter_k << "th iteration within total of " << cutoff0 << " cutoff has finished." << endl;
}
/*PetscViewerDestroy(&viewer);*/
return ierr;
}
static PetscErrorCode SNESSetUp_Composite(SNES snes)
{
PetscErrorCode ierr;
DM dm;
SNES_Composite *jac = (SNES_Composite*)snes->data;
SNES_CompositeLink next = jac->head;
PetscInt n=0,i;
Vec F;
PetscFunctionBegin;
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
if (snes->ops->computevariablebounds) {
/* SNESVI only ever calls computevariablebounds once, so calling it once here is justified */
if (!snes->xl) {ierr = VecDuplicate(snes->vec_sol,&snes->xl);CHKERRQ(ierr);}
if (!snes->xu) {ierr = VecDuplicate(snes->vec_sol,&snes->xu);CHKERRQ(ierr);}
ierr = (*snes->ops->computevariablebounds)(snes,snes->xl,snes->xu);CHKERRQ(ierr);
}
while (next) {
n++;
ierr = SNESSetDM(next->snes,dm);CHKERRQ(ierr);
ierr = SNESSetApplicationContext(next->snes, snes->user);CHKERRQ(ierr);
if (snes->xl && snes->xu) {
if (snes->ops->computevariablebounds) {
ierr = SNESVISetComputeVariableBounds(next->snes, snes->ops->computevariablebounds);CHKERRQ(ierr);
} else {
ierr = SNESVISetVariableBounds(next->snes,snes->xl,snes->xu);CHKERRQ(ierr);
}
}
next = next->next;
}
jac->nsnes = n;
ierr = SNESGetFunction(snes,&F,NULL,NULL);CHKERRQ(ierr);
if (jac->type == SNES_COMPOSITE_ADDITIVEOPTIMAL) {
ierr = VecDuplicateVecs(F,jac->nsnes,&jac->Xes);CHKERRQ(ierr);
ierr = PetscMalloc1(n,&jac->Fes);CHKERRQ(ierr);
ierr = PetscMalloc1(n,&jac->fnorms);CHKERRQ(ierr);
next = jac->head;
i = 0;
while (next) {
ierr = SNESGetFunction(next->snes,&F,NULL,NULL);CHKERRQ(ierr);
jac->Fes[i] = F;
ierr = PetscObjectReference((PetscObject)F);CHKERRQ(ierr);
next = next->next;
i++;
}
/* allocate the subspace direct solve area */
jac->nrhs = 1;
jac->lda = jac->nsnes;
jac->ldb = jac->nsnes;
jac->n = jac->nsnes;
ierr = PetscMalloc1(jac->n*jac->n,&jac->h);CHKERRQ(ierr);
ierr = PetscMalloc1(jac->n,&jac->beta);CHKERRQ(ierr);
ierr = PetscMalloc1(jac->n,&jac->s);CHKERRQ(ierr);
ierr = PetscMalloc1(jac->n,&jac->g);CHKERRQ(ierr);
jac->lwork = 12*jac->n;
#if PETSC_USE_COMPLEX
ierr = PetscMalloc1(jac->lwork,&jac->rwork);CHKERRQ(ierr);
#endif
ierr = PetscMalloc1(jac->lwork,&jac->work);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode PCBDDCNullSpaceAdaptGlobal(PC pc)
{
PC_IS* pcis = (PC_IS*)(pc->data);
PC_BDDC* pcbddc = (PC_BDDC*)(pc->data);
KSP inv_change;
const Vec *nsp_vecs;
Vec *new_nsp_vecs;
PetscInt i,nsp_size,new_nsp_size,start_new;
PetscBool nsp_has_cnst;
MatNullSpace new_nsp;
PetscErrorCode ierr;
PetscFunctionBegin;
/* create KSP for change of basis */
ierr = MatGetSize(pcbddc->ChangeOfBasisMatrix,&i,NULL);CHKERRQ(ierr);
ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&inv_change);CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(inv_change,pc->erroriffailure);CHKERRQ(ierr);
ierr = KSPSetOperators(inv_change,pcbddc->ChangeOfBasisMatrix,pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
ierr = KSPSetTolerances(inv_change,1.e-8,1.e-8,PETSC_DEFAULT,2*i);CHKERRQ(ierr);
if (pcbddc->dbg_flag) {
ierr = KSPMonitorSet(inv_change,KSPMonitorDefault,pcbddc->dbg_viewer,NULL);CHKERRQ(ierr);
}
ierr = KSPSetUp(inv_change);CHKERRQ(ierr);
/* get nullspace and transform it */
ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nsp_has_cnst,&nsp_size,&nsp_vecs);CHKERRQ(ierr);
new_nsp_size = nsp_size;
if (nsp_has_cnst) {
new_nsp_size++;
}
ierr = VecDuplicateVecs(pcis->vec1_global,new_nsp_size,&new_nsp_vecs);CHKERRQ(ierr);
start_new = 0;
if (nsp_has_cnst) {
start_new = 1;
ierr = VecSet(new_nsp_vecs[0],1.0);CHKERRQ(ierr);
if (pcbddc->dbg_flag) {
ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Mapping constant in nullspace\n");CHKERRQ(ierr);
}
ierr = KSPSolve(inv_change,new_nsp_vecs[0],new_nsp_vecs[0]);CHKERRQ(ierr);
}
for (i=0;i<nsp_size;i++) {
ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Mapping %dth vector in nullspace\n",i);CHKERRQ(ierr);
ierr = KSPSolve(inv_change,nsp_vecs[i],new_nsp_vecs[i+start_new]);CHKERRQ(ierr);
}
ierr = PCBDDCOrthonormalizeVecs(new_nsp_size,new_nsp_vecs);CHKERRQ(ierr);
ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)pc),PETSC_FALSE,new_nsp_size,new_nsp_vecs,&new_nsp);CHKERRQ(ierr);
ierr = PCBDDCSetNullSpace(pc,new_nsp);CHKERRQ(ierr);
/* free */
ierr = KSPDestroy(&inv_change);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&new_nsp);CHKERRQ(ierr);
ierr = VecDestroyVecs(new_nsp_size,&new_nsp_vecs);CHKERRQ(ierr);
/* check */
if (pcbddc->dbg_flag) {
PetscBool nsp_t=PETSC_FALSE;
Mat temp_mat;
Mat_IS* matis = (Mat_IS*)pc->pmat->data;
temp_mat = matis->A;
matis->A = pcbddc->local_mat;
pcbddc->local_mat = temp_mat;
ierr = MatNullSpaceTest(pcbddc->NullSpace,pc->pmat,&nsp_t);CHKERRQ(ierr);
ierr = PetscPrintf(PetscObjectComm((PetscObject)(pc->pmat)),"Check nullspace with change of basis: %d\n",nsp_t);CHKERRQ(ierr);
temp_mat = matis->A;
matis->A = pcbddc->local_mat;
pcbddc->local_mat = temp_mat;
}
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
PetscErrorCode ierr;
PetscInt itr, itl;
PetscInt numTracers, n;
Vec templateVec;
Vec **v;
Vec *vold, *vcur, *vnew;
PetscInt iold, icur, inew;
PetscViewer fd;
PetscInitialize(&argc,&args,(char *)0,help);
numTracers=5;
n=100;
iold = 0;
icur = 1;
inew = 2;
ierr = VecCreate(PETSC_COMM_WORLD,&templateVec);CHKERRQ(ierr);
ierr = VecSetSizes(templateVec,PETSC_DECIDE,n);CHKERRQ(ierr);
ierr = VecSetFromOptions(templateVec);CHKERRQ(ierr);
/* tracer vectors */
// v = malloc(numTracers*sizeof(Vec *));
// vold = malloc(numTracers*sizeof(Vec *));
// vcur = malloc(numTracers*sizeof(Vec *));
// vnew = malloc(numTracers*sizeof(Vec *));
v = malloc(3*sizeof(Vec *));
vold = malloc(numTracers*sizeof(Vec *));
vcur = malloc(numTracers*sizeof(Vec *));
vnew = malloc(numTracers*sizeof(Vec *));
// for (itr=0; itr<numTracers; itr++) {
// ierr = VecDuplicateVecs(templateVec,3,&v[itr]);CHKERRQ(ierr);
// }
for (itl=0; itl<3; itl++) {
ierr = VecDuplicateVecs(templateVec,numTracers,&v[itl]);CHKERRQ(ierr);
}
for (itl=0; itl<3; itl++) {
for (itr=0; itr<numTracers; itr++) {
VecSet(v[itl][itr],1.0*(itl+1.0));
}
}
// for (itr=0; itr<numTracers; itr++) {
// ierr = VecCopy(v[icur][itr],v[iold][itr]);CHKERRQ(ierr);
// }
for (itr=0; itr<numTracers; itr++) {
vold[itr]=v[iold][itr];
vcur[itr]=v[icur][itr];
vnew[itr]=v[inew][itr];
}
for (itr=0; itr<numTracers; itr++) {
vold[itr]=vnew[itr];
}
// for (itr=0; itr<numTracers; itr++) {
// VecSet(vold[itr],20.0);
// }
ierr = PetscPrintf(PETSC_COMM_WORLD,"Writing old\n");CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"old.petsc",FILE_MODE_WRITE,&fd);CHKERRQ(ierr);
for (itr=0; itr<numTracers; itr++) {
ierr = VecView(v[iold][itr],fd);CHKERRQ(ierr);
}
ierr = PetscViewerDestroy(fd);CHKERRQ(ierr);
// ierr = output(v[iold],numTracers);
ierr = output(vold,numTracers);
// ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"old1.petsc",FILE_MODE_WRITE,&fd);CHKERRQ(ierr);
// for (itr=0; itr<numTracers; itr++) {
// ierr = VecView(vold[itr],fd);CHKERRQ(ierr);
// }
// ierr = PetscViewerDestroy(fd);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
