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
}
PetscErrorCode MatMatSolve_MKL_PARDISO(Mat A,Mat B,Mat X) {
Mat_MKL_PARDISO *mat_mkl_pardiso=(Mat_MKL_PARDISO*)(A)->spptr;
PetscErrorCode ierr;
PetscScalar *barray, *xarray;
PetscBool flg;
PetscFunctionBegin;
ierr = PetscObjectTypeCompare((PetscObject)B,MATSEQDENSE,&flg);
CHKERRQ(ierr);
if (!flg) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_WRONG,"Matrix B must be MATSEQDENSE matrix");
ierr = PetscObjectTypeCompare((PetscObject)X,MATSEQDENSE,&flg);
CHKERRQ(ierr);
if (!flg) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_WRONG,"Matrix X must be MATSEQDENSE matrix");
ierr = MatGetSize(B,NULL,(PetscInt*)&mat_mkl_pardiso->nrhs);
CHKERRQ(ierr);
if(mat_mkl_pardiso->nrhs > 0) {
ierr = MatDenseGetArray(B,&barray);
ierr = MatDenseGetArray(X,&xarray);
/* solve phase */
/*-------------*/
mat_mkl_pardiso->phase = JOB_SOLVE_ITERATIVE_REFINEMENT;
MKL_PARDISO (mat_mkl_pardiso->pt,
&mat_mkl_pardiso->maxfct,
&mat_mkl_pardiso->mnum,
&mat_mkl_pardiso->mtype,
&mat_mkl_pardiso->phase,
&mat_mkl_pardiso->n,
mat_mkl_pardiso->a,
mat_mkl_pardiso->ia,
mat_mkl_pardiso->ja,
mat_mkl_pardiso->perm,
&mat_mkl_pardiso->nrhs,
mat_mkl_pardiso->iparm,
&mat_mkl_pardiso->msglvl,
(void*)barray,
(void*)xarray,
&mat_mkl_pardiso->err);
if (mat_mkl_pardiso->err < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MKL_PARDISO: err=%d. Please check manual\n",mat_mkl_pardiso->err);
}
mat_mkl_pardiso->CleanUp = PETSC_TRUE;
PetscFunctionReturn(0);
}
PETSC_EXTERN void PETSC_STDCALL matdensegetarray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr)
{
PetscScalar *mm;
PetscInt m,n;
*ierr = MatDenseGetArray(*mat,&mm); if (*ierr) return;
*ierr = MatGetSize(*mat,&m,&n); if (*ierr) return;
*ierr = PetscScalarAddressToFortran((PetscObject)*mat,1,fa,mm,m*n,ia); if (*ierr) return;
}
PetscErrorCode BVGetArray_Mat(BV bv,PetscScalar **a)
{
PetscErrorCode ierr;
BV_MAT *ctx = (BV_MAT*)bv->data;
PetscFunctionBegin;
ierr = MatDenseGetArray(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);
}
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);
}
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 BVGetColumn_Mat(BV bv,PetscInt j,Vec *v)
{
PetscErrorCode ierr;
BV_MAT *ctx = (BV_MAT*)bv->data;
PetscScalar *pA;
PetscInt l;
PetscFunctionBegin;
l = BVAvailableVec;
ierr = MatDenseGetArray(ctx->A,&pA);CHKERRQ(ierr);
ierr = VecPlaceArray(bv->cv[l],pA+(bv->nc+j)*bv->n);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 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 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 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 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);
}
