PetscErrorCode BVResize_Mat(BV bv,PetscInt m,PetscBool copy)
{
PetscErrorCode ierr;
BV_MAT *ctx = (BV_MAT*)bv->data;
PetscScalar *pA,*pnew;
Mat A;
char str[50];
PetscFunctionBegin;
ierr = MatCreateDense(PetscObjectComm((PetscObject)bv->t),bv->n,PETSC_DECIDE,PETSC_DECIDE,m,NULL,&A);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)bv,(PetscObject)A);CHKERRQ(ierr);
if (((PetscObject)bv)->name) {
ierr = PetscSNPrintf(str,50,"%s_0",((PetscObject)bv)->name);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)A,str);CHKERRQ(ierr);
}
if (copy) {
ierr = MatDenseGetArray(ctx->A,&pA);CHKERRQ(ierr);
ierr = MatDenseGetArray(A,&pnew);CHKERRQ(ierr);
ierr = PetscMemcpy(pnew,pA,PetscMin(m,bv->m)*bv->n*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = MatDenseRestoreArray(ctx->A,&pA);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(A,&pnew);CHKERRQ(ierr);
}
ierr = MatDestroy(&ctx->A);CHKERRQ(ierr);
ctx->A = A;
PetscFunctionReturn(0);
}
PetscErrorCode BVAXPY_Mat(BV Y,PetscScalar alpha,BV X)
{
PetscErrorCode ierr;
BV_MAT *x = (BV_MAT*)X->data,*y = (BV_MAT*)Y->data;
PetscScalar *px,*py;
PetscFunctionBegin;
ierr = MatDenseGetArray(x->A,&px);CHKERRQ(ierr);
ierr = MatDenseGetArray(y->A,&py);CHKERRQ(ierr);
ierr = BVAXPY_BLAS_Private(Y,Y->n,Y->k-Y->l,alpha,px+(X->nc+X->l)*X->n,py+(Y->nc+Y->l)*Y->n);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(x->A,&px);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(y->A,&py);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode BVOrthogonalize_Mat(BV V,Mat R)
{
PetscErrorCode ierr;
BV_MAT *ctx = (BV_MAT*)V->data;
PetscScalar *pv,*r=NULL;
PetscFunctionBegin;
if (R) { ierr = MatDenseGetArray(R,&r);CHKERRQ(ierr); }
ierr = MatDenseGetArray(ctx->A,&pv);CHKERRQ(ierr);
ierr = BVOrthogonalize_LAPACK_Private(V,V->n,V->k,pv+V->nc*V->n,r,ctx->mpi);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(ctx->A,&pv);CHKERRQ(ierr);
if (R) { ierr = MatDenseRestoreArray(R,&r);CHKERRQ(ierr); }
PetscFunctionReturn(0);
}
PetscErrorCode BVCopy_Mat(BV V,BV W)
{
PetscErrorCode ierr;
BV_MAT *v = (BV_MAT*)V->data,*w = (BV_MAT*)W->data;
PetscScalar *pv,*pw,*pvc,*pwc;
PetscFunctionBegin;
ierr = MatDenseGetArray(v->A,&pv);CHKERRQ(ierr);
ierr = MatDenseGetArray(w->A,&pw);CHKERRQ(ierr);
pvc = pv+(V->nc+V->l)*V->n;
pwc = pw+(W->nc+W->l)*W->n;
ierr = PetscMemcpy(pwc,pvc,(V->k-V->l)*V->n*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = MatDenseRestoreArray(v->A,&pv);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(w->A,&pw);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode BVMultInPlaceTranspose_Mat(BV V,Mat Q,PetscInt s,PetscInt e)
{
PetscErrorCode ierr;
BV_MAT *ctx = (BV_MAT*)V->data;
PetscScalar *pv,*q;
PetscInt ldq;
PetscFunctionBegin;
ierr = MatGetSize(Q,&ldq,NULL);CHKERRQ(ierr);
ierr = MatDenseGetArray(ctx->A,&pv);CHKERRQ(ierr);
ierr = MatDenseGetArray(Q,&q);CHKERRQ(ierr);
ierr = BVMultInPlace_BLAS_Private(V,V->n,V->k-V->l,ldq,s-V->l,e-V->l,pv+(V->nc+V->l)*V->n,q+V->l*ldq+V->l,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(Q,&q);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(ctx->A,&pv);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode BVOrthogonalize_GS(BV V,Mat R)
{
PetscErrorCode ierr;
PetscScalar *r=NULL;
PetscReal norm;
PetscInt j,ldr;
PetscFunctionBegin;
ldr = V->k;
if (R) {
ierr = MatDenseGetArray(R,&r);CHKERRQ(ierr);
ierr = PetscMemzero(r+V->l*ldr,ldr*(ldr-V->l)*sizeof(PetscScalar));CHKERRQ(ierr);
}
for (j=V->l;j<V->k;j++) {
if (R) {
ierr = BVOrthogonalizeColumn(V,j,r+j*ldr,&norm,NULL);CHKERRQ(ierr);
r[j+j*ldr] = norm;
} else {
ierr = BVOrthogonalizeColumn(V,j,NULL,&norm,NULL);CHKERRQ(ierr);
}
ierr = BVScaleColumn(V,j,1.0/norm);CHKERRQ(ierr);
}
if (R) { ierr = MatDenseRestoreArray(R,&r);CHKERRQ(ierr); }
PetscFunctionReturn(0);
}
PetscErrorCode ComputeRHSMatrix(PetscInt m,PetscInt nrhs,Mat* C)
{
PetscErrorCode ierr;
PetscRandom rand;
Mat RHS;
PetscScalar *array,rval;
PetscInt i,k;
PetscFunctionBegin;
ierr = MatCreate(PETSC_COMM_WORLD,&RHS);CHKERRQ(ierr);
ierr = MatSetSizes(RHS,m,PETSC_DECIDE,PETSC_DECIDE,nrhs);CHKERRQ(ierr);
ierr = MatSetType(RHS,MATSEQDENSE);CHKERRQ(ierr);
ierr = MatSetUp(RHS);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rand);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rand);CHKERRQ(ierr);
ierr = MatDenseGetArray(RHS,&array);CHKERRQ(ierr);
for (i=0; i<m; i++){
ierr = PetscRandomGetValue(rand,&rval);CHKERRQ(ierr);
array[i] = rval;
}
if (nrhs > 1){
for (k=1; k<nrhs; k++){
for (i=0; i<m; i++){
array[m*k+i] = array[i];
}
}
}
ierr = MatDenseRestoreArray(RHS,&array);CHKERRQ(ierr);
ierr = MatAssemblyBegin(RHS,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(RHS,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
*C = RHS;
ierr = PetscRandomDestroy(&rand);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESMonitorJacUpdateSpectrum(SNES snes,PetscInt it,PetscReal fnorm,void *ctx)
{
#if defined(PETSC_MISSING_LAPACK_GEEV)
SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"GEEV - Lapack routine is unavailable\nNot able to provide eigen values.");
#elif defined(PETSC_HAVE_ESSL)
SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"GEEV - No support for ESSL Lapack Routines");
#else
Vec X;
Mat J,dJ,dJdense;
PetscErrorCode ierr;
PetscErrorCode (*func)(SNES,Vec,Mat*,Mat*,MatStructure*,void*);
PetscInt n,i;
PetscBLASInt nb,lwork;
PetscReal *eigr,*eigi;
MatStructure flg = DIFFERENT_NONZERO_PATTERN;
PetscScalar *work;
PetscScalar *a;
PetscFunctionBegin;
if (it == 0) PetscFunctionReturn(0);
/* create the difference between the current update and the current jacobian */
ierr = SNESGetSolution(snes,&X);CHKERRQ(ierr);
ierr = SNESGetJacobian(snes,&J,NULL,&func,NULL);CHKERRQ(ierr);
ierr = MatDuplicate(J,MAT_COPY_VALUES,&dJ);CHKERRQ(ierr);
ierr = SNESComputeJacobian(snes,X,&dJ,&dJ,&flg);CHKERRQ(ierr);
ierr = MatAXPY(dJ,-1.0,J,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
/* compute the spectrum directly */
ierr = MatConvert(dJ,MATSEQDENSE,MAT_INITIAL_MATRIX,&dJdense);CHKERRQ(ierr);
ierr = MatGetSize(dJ,&n,NULL);CHKERRQ(ierr);
ierr = PetscBLASIntCast(n,&nb);CHKERRQ(ierr);
lwork = 3*nb;
ierr = PetscMalloc(n*sizeof(PetscReal),&eigr);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscReal),&eigi);CHKERRQ(ierr);
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
ierr = MatDenseGetArray(dJdense,&a);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
{
PetscBLASInt lierr;
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
PetscStackCall("LAPACKgeev",LAPACKgeev_("N","N",&nb,a,&nb,eigr,eigi,NULL,&nb,NULL,&nb,work,&lwork,&lierr));
if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"geev() error %d",lierr);
ierr = PetscFPTrapPop();CHKERRQ(ierr);
}
#else
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not coded for complex");
#endif
PetscPrintf(PetscObjectComm((PetscObject)snes),"Eigenvalues of J_%d - J_%d:\n",it,it-1);CHKERRQ(ierr);
for (i=0;i<n;i++) {
PetscPrintf(PetscObjectComm((PetscObject)snes),"%5d: %20.5g + %20.5gi\n",i,eigr[i],eigi[i]);CHKERRQ(ierr);
}
ierr = MatDenseRestoreArray(dJdense,&a);CHKERRQ(ierr);
ierr = MatDestroy(&dJ);CHKERRQ(ierr);
ierr = MatDestroy(&dJdense);CHKERRQ(ierr);
ierr = PetscFree(eigr);CHKERRQ(ierr);
ierr = PetscFree(eigi);CHKERRQ(ierr);
ierr = PetscFree(work);CHKERRQ(ierr);
PetscFunctionReturn(0);
#endif
}
PETSC_EXTERN void PETSC_STDCALL matdenserestorearray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr)
{
PetscScalar *lx;
PetscInt m,n;
*ierr = MatGetSize(*mat,&m,&n); if (*ierr) return;
*ierr = PetscScalarAddressFromFortran((PetscObject)*mat,fa,*ia,m*n,&lx);if (*ierr) return;
*ierr = MatDenseRestoreArray(*mat,&lx);if (*ierr) return;
}
PetscErrorCode BVMult_Mat(BV Y,PetscScalar alpha,PetscScalar beta,BV X,Mat Q)
{
PetscErrorCode ierr;
BV_MAT *y = (BV_MAT*)Y->data,*x = (BV_MAT*)X->data;
PetscScalar *px,*py,*q;
PetscInt ldq;
PetscFunctionBegin;
ierr = MatGetSize(Q,&ldq,NULL);CHKERRQ(ierr);
ierr = MatDenseGetArray(x->A,&px);CHKERRQ(ierr);
ierr = MatDenseGetArray(y->A,&py);CHKERRQ(ierr);
ierr = MatDenseGetArray(Q,&q);CHKERRQ(ierr);
ierr = BVMult_BLAS_Private(Y,Y->n,Y->k-Y->l,X->k-X->l,ldq,alpha,px+(X->nc+X->l)*X->n,q+Y->l*ldq+X->l,beta,py+(Y->nc+Y->l)*Y->n);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(Q,&q);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(x->A,&px);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(y->A,&py);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode BVRestoreArray_Mat(BV bv,PetscScalar **a)
{
PetscErrorCode ierr;
BV_MAT *ctx = (BV_MAT*)bv->data;
PetscFunctionBegin;
if (a) { ierr = MatDenseRestoreArray(ctx->A,a);CHKERRQ(ierr); }
PetscFunctionReturn(0);
}
PetscErrorCode BVDot_Mat(BV X,BV Y,Mat M)
{
PetscErrorCode ierr;
BV_MAT *x = (BV_MAT*)X->data,*y = (BV_MAT*)Y->data;
PetscScalar *px,*py,*m;
PetscInt ldm;
PetscFunctionBegin;
ierr = MatGetSize(M,&ldm,NULL);CHKERRQ(ierr);
ierr = MatDenseGetArray(x->A,&px);CHKERRQ(ierr);
ierr = MatDenseGetArray(y->A,&py);CHKERRQ(ierr);
ierr = MatDenseGetArray(M,&m);CHKERRQ(ierr);
ierr = BVDot_BLAS_Private(X,Y->k-Y->l,X->k-X->l,X->n,ldm,py+(Y->nc+Y->l)*Y->n,px+(X->nc+X->l)*X->n,m+X->l*ldm+Y->l,x->mpi);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(M,&m);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(x->A,&px);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(y->A,&py);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode AddDRDY(PetscReal t,Vec X,Vec *drdy,Userctx *user)
{
PetscErrorCode ierr;
Vec Xgen,Xnet,Dgen,Dnet;
PetscScalar *xnet,*dnet,*proj_vec;
PetscInt obs_len,i,idx;
PetscReal step_num, aux1, aux2;
PetscScalar *mat;
PetscFunctionBegin;
//printf("AddDRDY lambda\n");
//ierr = VecView(*drdy, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Dgen,&Dnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(user->dmpgrid,X,Xgen,Xnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(user->dmpgrid,*drdy,Dgen,Dnet);CHKERRQ(ierr);
ierr = VecGetArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = VecGetArray(Dnet,&dnet);CHKERRQ(ierr);
ierr = VecGetArray(user->proj,&proj_vec);CHKERRQ(ierr);
ierr = VecGetSize(user->proj, &obs_len);CHKERRQ(ierr);
//!step_num = round((t-user->tdisturb) / user->data_dt);
step_num = round((t-user->trestore) / user->data_dt);
idx = 2*obs_len* (PetscInt)step_num;
ierr = MatDenseGetArray(user->obs,&mat);CHKERRQ(ierr);
for(i=0;i<obs_len; i++) {
//printf("B^Tnoisecovinv(B x -d):t=%g index=%d proj_len=%d proj[i] = %d \n", t, idx, obs_len, (int)proj_vec[i]);
aux1 = (xnet[2*((int)proj_vec[i])] - mat[idx+2*i])
/ pow(user->data_stddev[i],2); // obs[2*i, num_obs]
dnet[2*((int)proj_vec[i])] += aux1;
aux2 = (xnet[2*((int)proj_vec[i])+1] - mat[idx+2*i+1])
/ pow(user->data_stddev[i+1],2);// obs[2*i+1, num_obs]
dnet[2*((int)proj_vec[i])+1] += aux2;
//printf("IC Adjoint: t=%g [%g] [%g]\n", t, aux1, aux2);
}
ierr = MatDenseRestoreArray(user->obs,&mat);CHKERRQ(ierr);
ierr = VecRestoreArray(user->proj,&proj_vec);CHKERRQ(ierr);
ierr = VecRestoreArray(Dnet,&dnet);CHKERRQ(ierr);
ierr = DMCompositeGather(user->dmpgrid,*drdy,INSERT_VALUES,Dgen,Dnet);CHKERRQ(ierr);
ierr = DMCompositeRestoreLocalVectors(user->dmpgrid,&Dgen,&Dnet);CHKERRQ(ierr);
ierr = DMCompositeRestoreLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
//printf("AddDRDY lambda at the end\n");
//ierr = VecView(*drdy, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatTransposeMatMultNumeric_MPIAIJ_MPIDense(Mat A,Mat B,Mat C)
{
PetscErrorCode ierr;
PetscInt i,j,k,m=A->rmap->n,n=A->cmap->n,BN=B->cmap->N;
PetscScalar *Barray,*Carray,*btarray,*ctarray;
Mat_MPIDense *c=(Mat_MPIDense*)C->data;
Mat_MatTransMatMult *atb=c->atb;
Vec bt=atb->bt,ct=atb->ct;
PetscFunctionBegin;
/* create MAIJ matrix mA from A -- should be done in symbolic phase */
ierr = MatDestroy(&atb->mA);CHKERRQ(ierr);
ierr = MatCreateMAIJ(A,BN,&atb->mA);CHKERRQ(ierr);
/* transpose local arry of B, then copy it to vector bt */
ierr = MatDenseGetArray(B,&Barray);CHKERRQ(ierr);
ierr = VecGetArray(bt,&btarray);CHKERRQ(ierr);
k=0;
for (j=0; j<BN; j++) {
for (i=0; i<m; i++) btarray[i*BN + j] = Barray[k++];
}
ierr = VecRestoreArray(bt,&btarray);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(B,&Barray);CHKERRQ(ierr);
/* compute ct = mA^T * cb */
ierr = MatMultTranspose(atb->mA,bt,ct);CHKERRQ(ierr);
/* transpose local arry of ct to matrix C */
ierr = MatDenseGetArray(C,&Carray);CHKERRQ(ierr);
ierr = VecGetArray(ct,&ctarray);CHKERRQ(ierr);
k = 0;
for (j=0; j<BN; j++) {
for (i=0; i<n; i++) Carray[k++] = ctarray[i*BN + j];
}
ierr = VecRestoreArray(ct,&ctarray);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(C,&Carray);CHKERRQ(ierr);
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode BVMatMult_Mat(BV V,Mat A,BV W)
{
PetscErrorCode ierr;
BV_MAT *v = (BV_MAT*)V->data,*w = (BV_MAT*)W->data;
PetscScalar *pv,*pw;
PetscInt j;
PetscFunctionBegin;
ierr = MatDenseGetArray(v->A,&pv);CHKERRQ(ierr);
ierr = MatDenseGetArray(w->A,&pw);CHKERRQ(ierr);
for (j=0;j<V->k-V->l;j++) {
ierr = VecPlaceArray(V->cv[1],pv+(V->nc+V->l+j)*V->n);CHKERRQ(ierr);
ierr = VecPlaceArray(W->cv[1],pw+(W->nc+W->l+j)*W->n);CHKERRQ(ierr);
ierr = MatMult(A,V->cv[1],W->cv[1]);CHKERRQ(ierr);
ierr = VecResetArray(V->cv[1]);CHKERRQ(ierr);
ierr = VecResetArray(W->cv[1]);CHKERRQ(ierr);
}
ierr = MatDenseRestoreArray(v->A,&pv);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(w->A,&pw);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode BVOrthogonalize_Contiguous(BV V,Mat R)
{
PetscErrorCode ierr;
BV_CONTIGUOUS *ctx = (BV_CONTIGUOUS*)V->data;
PetscScalar *r=NULL;
PetscFunctionBegin;
if (R) { ierr = MatDenseGetArray(R,&r);CHKERRQ(ierr); }
ierr = BVOrthogonalize_LAPACK_Private(V,V->n,V->k,ctx->array+V->nc*V->n,r,ctx->mpi);CHKERRQ(ierr);
if (R) { ierr = MatDenseRestoreArray(R,&r);CHKERRQ(ierr); }
PetscFunctionReturn(0);
}
PetscErrorCode BVRestoreColumn_Mat(BV bv,PetscInt j,Vec *v)
{
PetscErrorCode ierr;
BV_MAT *ctx = (BV_MAT*)bv->data;
PetscScalar *pA;
PetscInt l;
PetscFunctionBegin;
l = (j==bv->ci[0])? 0: 1;
ierr = VecResetArray(bv->cv[l]);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(ctx->A,&pA);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SetObservation(Userctx* user, PetscReal t, Vec X)
{
PetscErrorCode ierr;
PetscInt idx,obs_len,i;
PetscScalar *mat;
Vec Xgen,Xnet;
PetscScalar *xnet;//, *xgen;
const PetscScalar *x;
PetscScalar *proj_vec;
PetscReal step_num;
PetscFunctionBegin;
/* observations are generated only after restore */
/* t = t - user->tdisturb;*/
t = t - user->trestore;
if(t >= -1e-6*user->dt) {
step_num = round(t / user->data_dt);
if(fabs(step_num - t/user->data_dt)<= 1e-6*user->dt) {
idx = (PetscInt) step_num;
ierr = VecGetSize(user->proj, &obs_len);CHKERRQ(ierr);
//printf("SetObservation: t=%g index=%d proj_len=%d \n", t, idx, obs_len);
idx = idx*2*obs_len;
ierr = MatDenseGetArray(user->obs,&mat);CHKERRQ(ierr);
ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
ierr = VecGetArray(user->proj, &proj_vec);CHKERRQ(ierr);
ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(user->dmpgrid,X,Xgen,Xnet);CHKERRQ(ierr);
ierr = VecGetArray(Xnet,&xnet);CHKERRQ(ierr);
//get pointer to xnet and to user->proj
for(i=0;i<obs_len; i++) {
//printf("proj[%d]=%d\n", i, (int)proj_vec[i]);
*(mat+idx+2*i) = xnet[2*((int)proj_vec[i])];
*(mat+idx+2*i+1) = xnet[2*((int)proj_vec[i])+1];
}
//printf("%g \n", xnet[0]);
ierr = MatDenseRestoreArray(user->obs,&mat);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
ierr = VecRestoreArray(user->proj,&proj_vec);CHKERRQ(ierr);
ierr = VecRestoreArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = DMCompositeRestoreLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
PetscErrorCode EvalMisfit(TS ts)
{
PetscErrorCode ierr;
Userctx *user;
Vec X;
PetscReal t;
Vec Xgen,Xnet;
PetscScalar *xnet, *proj_vec;
PetscInt obs_len,i,idx;
PetscReal step_num;
PetscScalar *mat;
PetscFunctionBegin;
ierr = TSGetApplicationContext(ts,&user);CHKERRQ(ierr);
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
//!t = t - user->tdisturb;
t = t - user->trestore;
step_num = round(t / user->data_dt);
if(fabs(step_num - t/user->data_dt)<= 1e-6*user->dt) {
ierr = VecGetArray(user->proj,&proj_vec);CHKERRQ(ierr);
ierr = VecGetSize(user->proj, &obs_len);CHKERRQ(ierr);
idx = 2*obs_len*(PetscInt) step_num;
ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(user->dmpgrid,X,Xgen,Xnet);CHKERRQ(ierr);
ierr = VecGetArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = MatDenseGetArray(user->obs,&mat);CHKERRQ(ierr);
for(i=0;i<obs_len; i++) {
user->misfit += 0.5*pow(xnet[2*((int)proj_vec[i])] - mat[idx+2*i], 2) / pow(user->data_stddev[i], 2); // obs[2*i, num_obs]
user->misfit += 0.5*pow(xnet[2*((int)proj_vec[i])+1] - mat[idx+2*i+1],2)
/ pow(user->data_stddev[i+1], 2);// obs[2*i+1, num_obs]
}
//printf("evm %g %g idx=%d\n", xnet[0], mat[idx], idx);
ierr = MatDenseRestoreArray(user->obs,&mat);CHKERRQ(ierr);
ierr = VecRestoreArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = DMCompositeRestoreLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = VecRestoreArray(user->proj,&proj_vec);CHKERRQ(ierr);
}
user->stepnum++;
PetscFunctionReturn(0);
}
PetscErrorCode BVMultInPlace_Contiguous(BV V,Mat Q,PetscInt s,PetscInt e)
{
PetscErrorCode ierr;
BV_CONTIGUOUS *ctx = (BV_CONTIGUOUS*)V->data;
PetscScalar *q;
PetscInt ldq;
PetscFunctionBegin;
ierr = MatGetSize(Q,&ldq,NULL);CHKERRQ(ierr);
ierr = MatDenseGetArray(Q,&q);CHKERRQ(ierr);
ierr = BVMultInPlace_BLAS_Private(V,V->n,V->k-V->l,ldq,s-V->l,e-V->l,ctx->array+(V->nc+V->l)*V->n,q+V->l*ldq+V->l,PETSC_FALSE);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(Q,&q);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode BVDot_Contiguous(BV X,BV Y,Mat M)
{
PetscErrorCode ierr;
BV_CONTIGUOUS *x = (BV_CONTIGUOUS*)X->data,*y = (BV_CONTIGUOUS*)Y->data;
PetscScalar *m;
PetscInt ldm;
PetscFunctionBegin;
ierr = MatGetSize(M,&ldm,NULL);CHKERRQ(ierr);
ierr = MatDenseGetArray(M,&m);CHKERRQ(ierr);
ierr = BVDot_BLAS_Private(X,Y->k-Y->l,X->k-X->l,X->n,ldm,y->array+(Y->nc+Y->l)*Y->n,x->array+(X->nc+X->l)*X->n,m+X->l*ldm+Y->l,x->mpi);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(M,&m);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode BVMultVec_Mat(BV X,PetscScalar alpha,PetscScalar beta,Vec y,PetscScalar *q)
{
PetscErrorCode ierr;
BV_MAT *x = (BV_MAT*)X->data;
PetscScalar *px,*py;
PetscFunctionBegin;
ierr = MatDenseGetArray(x->A,&px);CHKERRQ(ierr);
ierr = VecGetArray(y,&py);CHKERRQ(ierr);
ierr = BVMultVec_BLAS_Private(X,X->n,X->k-X->l,alpha,px+(X->nc+X->l)*X->n,q,beta,py);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(x->A,&px);CHKERRQ(ierr);
ierr = VecRestoreArray(y,&py);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode BVMult_Contiguous(BV Y,PetscScalar alpha,PetscScalar beta,BV X,Mat Q)
{
PetscErrorCode ierr;
BV_CONTIGUOUS *y = (BV_CONTIGUOUS*)Y->data,*x = (BV_CONTIGUOUS*)X->data;
PetscScalar *q;
PetscInt ldq;
PetscFunctionBegin;
ierr = MatGetSize(Q,&ldq,NULL);CHKERRQ(ierr);
ierr = MatDenseGetArray(Q,&q);CHKERRQ(ierr);
ierr = BVMult_BLAS_Private(Y,Y->n,Y->k-Y->l,X->k-X->l,ldq,alpha,x->array+(X->nc+X->l)*X->n,q+Y->l*ldq+X->l,beta,y->array+(Y->nc+Y->l)*Y->n);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(Q,&q);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode BVNorm_Mat(BV bv,PetscInt j,NormType type,PetscReal *val)
{
PetscErrorCode ierr;
BV_MAT *ctx = (BV_MAT*)bv->data;
PetscScalar *array;
PetscFunctionBegin;
ierr = MatDenseGetArray(ctx->A,&array);CHKERRQ(ierr);
if (j<0) {
ierr = BVNorm_LAPACK_Private(bv,bv->n,bv->k-bv->l,array+(bv->nc+bv->l)*bv->n,type,val,ctx->mpi);CHKERRQ(ierr);
} else {
ierr = BVNorm_LAPACK_Private(bv,bv->n,1,array+(bv->nc+j)*bv->n,type,val,ctx->mpi);CHKERRQ(ierr);
}
ierr = MatDenseRestoreArray(ctx->A,&array);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode BVScale_Mat(BV bv,PetscInt j,PetscScalar alpha)
{
PetscErrorCode ierr;
BV_MAT *ctx = (BV_MAT*)bv->data;
PetscScalar *array;
PetscFunctionBegin;
ierr = MatDenseGetArray(ctx->A,&array);CHKERRQ(ierr);
if (j<0) {
ierr = BVScale_BLAS_Private(bv,(bv->k-bv->l)*bv->n,array+(bv->nc+bv->l)*bv->n,alpha);CHKERRQ(ierr);
} else {
ierr = BVScale_BLAS_Private(bv,bv->n,array+(bv->nc+j)*bv->n,alpha);CHKERRQ(ierr);
}
ierr = MatDenseRestoreArray(ctx->A,&array);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode BVDotVec_Mat(BV X,Vec y,PetscScalar *m)
{
PetscErrorCode ierr;
BV_MAT *x = (BV_MAT*)X->data;
PetscScalar *px,*py;
Vec z = y;
PetscFunctionBegin;
if (X->matrix) {
ierr = BV_IPMatMult(X,y);CHKERRQ(ierr);
z = X->Bx;
}
ierr = MatDenseGetArray(x->A,&px);CHKERRQ(ierr);
ierr = VecGetArray(z,&py);CHKERRQ(ierr);
ierr = BVDotVec_BLAS_Private(X,X->n,X->k-X->l,px+(X->nc+X->l)*X->n,py,m,x->mpi);CHKERRQ(ierr);
ierr = VecRestoreArray(z,&py);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(x->A,&px);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SetSolution(Userctx* user, PetscReal t, Vec X)
{
PetscErrorCode ierr;
PetscScalar *xgen,*xnet,*mat;
PetscInt idx, len_xgen, len_xnet;
Vec Xgen, Xnet;
PetscFunctionBegin;
if(user->saveSol) {
//printf("SaveSol at t=%g\n", t);
ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(user->dmpgrid,X,Xgen,Xnet);CHKERRQ(ierr);
ierr = VecGetSize(Xgen, &len_xgen);CHKERRQ(ierr);
ierr = VecGetSize(Xnet, &len_xnet);CHKERRQ(ierr);
ierr = VecGetArray(Xgen,&xgen);CHKERRQ(ierr);
ierr = VecGetArray(Xnet,&xnet);CHKERRQ(ierr);
idx = ((PetscInt) round(t / user->dt))*(user->neqs_pgrid+1);
ierr = MatDenseGetArray(user->Sol,&mat);CHKERRQ(ierr);
mat[idx] = t;
ierr = PetscMemcpy(mat+idx+1, xgen,len_xgen*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemcpy(mat+idx+1+len_xgen,xnet,len_xnet*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = MatDenseRestoreArray(user->Sol,&mat);CHKERRQ(ierr);
ierr = VecRestoreArray(Xgen,&xgen);CHKERRQ(ierr);
ierr = VecRestoreArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = DMCompositeRestoreLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode SaveSolution(TS ts)
{
PetscErrorCode ierr;
Userctx *user;
Vec X;
PetscScalar *x,*mat;
PetscInt idx;
PetscReal t;
PetscFunctionBegin;
ierr = TSGetApplicationContext(ts,&user);CHKERRQ(ierr);
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
idx = user->stepnum*(user->neqs_pgrid+1);
ierr = MatDenseGetArray(user->Sol,&mat);CHKERRQ(ierr);
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
mat[idx] = t;
ierr = PetscMemcpy(mat+idx+1,x,user->neqs_pgrid*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = MatDenseRestoreArray(user->Sol,&mat);CHKERRQ(ierr);
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
user->stepnum++;
PetscFunctionReturn(0);
}
static PetscErrorCode PCBDDCMatTransposeMatSolve_SeqDense(Mat A,Mat B,Mat X)
{
Mat_SeqDense *mat = (Mat_SeqDense*)A->data;
PetscErrorCode ierr;
const PetscScalar *b;
PetscScalar *x;
PetscInt n;
PetscBLASInt nrhs,info,m;
PetscBool flg;
PetscFunctionBegin;
ierr = PetscBLASIntCast(A->rmap->n,&m);CHKERRQ(ierr);
ierr = PetscObjectTypeCompareAny((PetscObject)B,&flg,MATSEQDENSE,MATMPIDENSE,NULL);CHKERRQ(ierr);
if (!flg) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_WRONG,"Matrix B must be MATDENSE matrix");
ierr = PetscObjectTypeCompareAny((PetscObject)X,&flg,MATSEQDENSE,MATMPIDENSE,NULL);CHKERRQ(ierr);
if (!flg) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_WRONG,"Matrix X must be MATDENSE matrix");
ierr = MatGetSize(B,NULL,&n);CHKERRQ(ierr);
ierr = PetscBLASIntCast(n,&nrhs);CHKERRQ(ierr);
ierr = MatDenseGetArrayRead(B,&b);CHKERRQ(ierr);
ierr = MatDenseGetArray(X,&x);CHKERRQ(ierr);
ierr = PetscMemcpy(x,b,m*nrhs*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = MatDenseRestoreArrayRead(B,&b);CHKERRQ(ierr);
if (A->factortype == MAT_FACTOR_LU) {
#if defined(PETSC_MISSING_LAPACK_GETRS)
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable.");
#else
PetscStackCallBLAS("LAPACKgetrs",LAPACKgetrs_("T",&m,&nrhs,mat->v,&mat->lda,mat->pivots,x,&m,&info));
if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"GETRS - Bad solve");
#endif
} else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only LU factor supported");
ierr = MatDenseRestoreArray(X,&x);CHKERRQ(ierr);
ierr = PetscLogFlops(nrhs*(2.0*m*m - m));CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PCBDDCNullSpaceAssembleCorrection(PC pc, PetscBool isdir, IS local_dofs)
{
PC_BDDC *pcbddc = (PC_BDDC*)pc->data;
PC_IS *pcis = (PC_IS*)pc->data;
Mat_IS* matis = (Mat_IS*)pc->pmat->data;
KSP local_ksp;
PC newpc;
NullSpaceCorrection_ctx shell_ctx;
Mat local_mat,local_pmat,small_mat,inv_small_mat;
Vec work1,work2;
const Vec *nullvecs;
VecScatter scatter_ctx;
IS is_aux;
MatFactorInfo matinfo;
PetscScalar *basis_mat,*Kbasis_mat,*array,*array_mat;
PetscScalar one = 1.0,zero = 0.0, m_one = -1.0;
PetscInt basis_dofs,basis_size,nnsp_size,i,k;
PetscBool nnsp_has_cnst;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Infer the local solver */
ierr = ISGetSize(local_dofs,&basis_dofs);CHKERRQ(ierr);
if (isdir) {
/* Dirichlet solver */
local_ksp = pcbddc->ksp_D;
} else {
/* Neumann solver */
local_ksp = pcbddc->ksp_R;
}
ierr = KSPGetOperators(local_ksp,&local_mat,&local_pmat);CHKERRQ(ierr);
/* Get null space vecs */
ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nnsp_has_cnst,&nnsp_size,&nullvecs);CHKERRQ(ierr);
basis_size = nnsp_size;
if (nnsp_has_cnst) {
basis_size++;
}
if (basis_dofs) {
/* Create shell ctx */
ierr = PetscNew(&shell_ctx);CHKERRQ(ierr);
/* Create work vectors in shell context */
ierr = VecCreate(PETSC_COMM_SELF,&shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = VecSetSizes(shell_ctx->work_small_1,basis_size,basis_size);CHKERRQ(ierr);
ierr = VecSetType(shell_ctx->work_small_1,VECSEQ);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_small_1,&shell_ctx->work_small_2);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_SELF,&shell_ctx->work_full_1);CHKERRQ(ierr);
ierr = VecSetSizes(shell_ctx->work_full_1,basis_dofs,basis_dofs);CHKERRQ(ierr);
ierr = VecSetType(shell_ctx->work_full_1,VECSEQ);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&shell_ctx->work_full_2);CHKERRQ(ierr);
/* Allocate workspace */
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_dofs,basis_size,NULL,&shell_ctx->basis_mat );CHKERRQ(ierr);
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_dofs,basis_size,NULL,&shell_ctx->Kbasis_mat);CHKERRQ(ierr);
ierr = MatDenseGetArray(shell_ctx->basis_mat,&basis_mat);CHKERRQ(ierr);
ierr = MatDenseGetArray(shell_ctx->Kbasis_mat,&Kbasis_mat);CHKERRQ(ierr);
/* Restrict local null space on selected dofs (Dirichlet or Neumann)
and compute matrices N and K*N */
ierr = VecDuplicate(shell_ctx->work_full_1,&work1);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work2);CHKERRQ(ierr);
ierr = VecScatterCreate(pcis->vec1_N,local_dofs,work1,(IS)0,&scatter_ctx);CHKERRQ(ierr);
}
for (k=0;k<nnsp_size;k++) {
ierr = VecScatterBegin(matis->rctx,nullvecs[k],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(matis->rctx,nullvecs[k],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
if (basis_dofs) {
ierr = VecPlaceArray(work1,(const PetscScalar*)&basis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = VecScatterBegin(scatter_ctx,pcis->vec1_N,work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scatter_ctx,pcis->vec1_N,work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecPlaceArray(work2,(const PetscScalar*)&Kbasis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = VecResetArray(work1);CHKERRQ(ierr);
ierr = VecResetArray(work2);CHKERRQ(ierr);
}
}
if (basis_dofs) {
if (nnsp_has_cnst) {
ierr = VecPlaceArray(work1,(const PetscScalar*)&basis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = VecSet(work1,one);CHKERRQ(ierr);
ierr = VecPlaceArray(work2,(const PetscScalar*)&Kbasis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = VecResetArray(work1);CHKERRQ(ierr);
ierr = VecResetArray(work2);CHKERRQ(ierr);
}
ierr = VecDestroy(&work1);CHKERRQ(ierr);
ierr = VecDestroy(&work2);CHKERRQ(ierr);
ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(shell_ctx->basis_mat,&basis_mat);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(shell_ctx->Kbasis_mat,&Kbasis_mat);CHKERRQ(ierr);
/* Assemble another Mat object in shell context */
ierr = MatTransposeMatMult(shell_ctx->basis_mat,shell_ctx->Kbasis_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&small_mat);CHKERRQ(ierr);
ierr = MatFactorInfoInitialize(&matinfo);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,basis_size,0,1,&is_aux);CHKERRQ(ierr);
ierr = MatLUFactor(small_mat,is_aux,is_aux,&matinfo);CHKERRQ(ierr);
ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
ierr = PetscMalloc1(basis_size*basis_size,&array_mat);CHKERRQ(ierr);
for (k=0;k<basis_size;k++) {
ierr = VecSet(shell_ctx->work_small_1,zero);CHKERRQ(ierr);
ierr = VecSetValue(shell_ctx->work_small_1,k,one,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = VecAssemblyEnd(shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = MatSolve(small_mat,shell_ctx->work_small_1,shell_ctx->work_small_2);CHKERRQ(ierr);
ierr = VecGetArrayRead(shell_ctx->work_small_2,(const PetscScalar**)&array);CHKERRQ(ierr);
for (i=0;i<basis_size;i++) {
array_mat[i*basis_size+k]=array[i];
}
ierr = VecRestoreArrayRead(shell_ctx->work_small_2,(const PetscScalar**)&array);CHKERRQ(ierr);
}
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_size,basis_size,array_mat,&inv_small_mat);CHKERRQ(ierr);
ierr = MatMatMult(shell_ctx->basis_mat,inv_small_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&shell_ctx->Lbasis_mat);CHKERRQ(ierr);
ierr = PetscFree(array_mat);CHKERRQ(ierr);
ierr = MatDestroy(&inv_small_mat);CHKERRQ(ierr);
ierr = MatDestroy(&small_mat);CHKERRQ(ierr);
ierr = MatScale(shell_ctx->Kbasis_mat,m_one);CHKERRQ(ierr);
/* Rebuild local PC */
ierr = KSPGetPC(local_ksp,&shell_ctx->local_pc);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)shell_ctx->local_pc);CHKERRQ(ierr);
ierr = PCCreate(PETSC_COMM_SELF,&newpc);CHKERRQ(ierr);
ierr = PCSetOperators(newpc,local_mat,local_mat);CHKERRQ(ierr);
ierr = PCSetType(newpc,PCSHELL);CHKERRQ(ierr);
ierr = PCShellSetContext(newpc,shell_ctx);CHKERRQ(ierr);
ierr = PCShellSetApply(newpc,PCBDDCApplyNullSpaceCorrectionPC);CHKERRQ(ierr);
ierr = PCShellSetDestroy(newpc,PCBDDCDestroyNullSpaceCorrectionPC);CHKERRQ(ierr);
ierr = PCSetUp(newpc);CHKERRQ(ierr);
ierr = KSPSetPC(local_ksp,newpc);CHKERRQ(ierr);
ierr = PCDestroy(&newpc);CHKERRQ(ierr);
ierr = KSPSetUp(local_ksp);CHKERRQ(ierr);
}
/* test */
if (pcbddc->dbg_flag && basis_dofs) {
KSP check_ksp;
PC check_pc;
Mat test_mat;
Vec work3;
PetscReal test_err,lambda_min,lambda_max;
PetscBool setsym,issym=PETSC_FALSE;
PetscInt tabs;
ierr = PetscViewerASCIIGetTab(pcbddc->dbg_viewer,&tabs);CHKERRQ(ierr);
ierr = KSPGetPC(local_ksp,&check_pc);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work1);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work2);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work3);CHKERRQ(ierr);
ierr = VecSetRandom(shell_ctx->work_small_1,NULL);CHKERRQ(ierr);
ierr = MatMult(shell_ctx->basis_mat,shell_ctx->work_small_1,work1);CHKERRQ(ierr);
ierr = VecCopy(work1,work2);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work3);CHKERRQ(ierr);
ierr = PCApply(check_pc,work3,work1);CHKERRQ(ierr);
ierr = VecAXPY(work1,m_one,work2);CHKERRQ(ierr);
ierr = VecNorm(work1,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for nullspace correction for ",PetscGlobalRank);CHKERRQ(ierr);
ierr = PetscViewerASCIIUseTabs(pcbddc->dbg_viewer,PETSC_FALSE);CHKERRQ(ierr);
if (isdir) {
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Dirichlet ");CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Neumann ");CHKERRQ(ierr);
}
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"solver is :%1.14e\n",test_err);CHKERRQ(ierr);
ierr = PetscViewerASCIISetTab(pcbddc->dbg_viewer,tabs);CHKERRQ(ierr);
ierr = PetscViewerASCIIUseTabs(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatTransposeMatMult(shell_ctx->Lbasis_mat,shell_ctx->Kbasis_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&test_mat);CHKERRQ(ierr);
ierr = MatShift(test_mat,one);CHKERRQ(ierr);
ierr = MatNorm(test_mat,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = MatDestroy(&test_mat);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for nullspace matrices is :%1.14e\n",PetscGlobalRank,test_err);CHKERRQ(ierr);
/* Create ksp object suitable for extreme eigenvalues' estimation */
ierr = KSPCreate(PETSC_COMM_SELF,&check_ksp);CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(check_ksp,pc->erroriffailure);CHKERRQ(ierr);
ierr = KSPSetOperators(check_ksp,local_mat,local_mat);CHKERRQ(ierr);
ierr = KSPSetTolerances(check_ksp,1.e-8,1.e-8,PETSC_DEFAULT,basis_dofs);CHKERRQ(ierr);
ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
if (issym) {
ierr = KSPSetType(check_ksp,KSPCG);CHKERRQ(ierr);
}
ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
ierr = VecSetRandom(work1,NULL);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = KSPSolve(check_ksp,work2,work2);CHKERRQ(ierr);
ierr = VecAXPY(work2,m_one,work1);CHKERRQ(ierr);
ierr = VecNorm(work2,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for adapted KSP %1.14e (it %d, eigs %1.6e %1.6e)\n",PetscGlobalRank,test_err,k,lambda_min,lambda_max);CHKERRQ(ierr);
ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
ierr = VecDestroy(&work1);CHKERRQ(ierr);
ierr = VecDestroy(&work2);CHKERRQ(ierr);
ierr = VecDestroy(&work3);CHKERRQ(ierr);
}
/* all processes shoud call this, even the void ones */
if (pcbddc->dbg_flag) {
ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
