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