void
MultiPlasticityLinearSystem::nrStep(const RankTwoTensor & stress, const std::vector<Real> & intnl_old, const std::vector<Real> & intnl, const std::vector<Real> & pm, const RankFourTensor & E_inv, const RankTwoTensor & delta_dp, RankTwoTensor & dstress, std::vector<Real> & dpm, std::vector<Real> & dintnl, const std::vector<bool> & active, std::vector<bool> & deactivated_due_to_ld)
{
// Calculate RHS and Jacobian
std::vector<Real> rhs;
calculateRHS(stress, intnl_old, intnl, pm, delta_dp, rhs, active, true, deactivated_due_to_ld);
std::vector<std::vector<Real> > jac;
calculateJacobian(stress, intnl, pm, E_inv, active, deactivated_due_to_ld, jac);
// prepare for LAPACKgesv_ routine provided by PETSc
int system_size = rhs.size();
std::vector<double> a(system_size*system_size);
// Fill in the a "matrix" by going down columns
unsigned ind = 0;
for (int col = 0 ; col < system_size ; ++col)
for (int row = 0 ; row < system_size ; ++row)
a[ind++] = jac[row][col];
int nrhs = 1;
std::vector<int> ipiv(system_size);
int info;
LAPACKgesv_(&system_size, &nrhs, &a[0], &system_size, &ipiv[0], &rhs[0], &system_size, &info);
if (info != 0)
mooseError("In solving the linear system in a Newton-Raphson process, the PETSC LAPACK gsev routine returned with error code " << info);
// Extract the results back to dstress, dpm and dintnl
std::vector<bool> active_not_deact(_num_surfaces);
for (unsigned surface = 0 ; surface < _num_surfaces ; ++surface)
active_not_deact[surface] = (active[surface] && !deactivated_due_to_ld[surface]);
unsigned int dim = 3;
ind = 0;
for (unsigned i = 0 ; i < dim ; ++i)
for (unsigned j = 0 ; j <= i ; ++j)
dstress(i, j) = dstress(j, i) = rhs[ind++];
dpm.assign(_num_surfaces, 0);
for (unsigned surface = 0 ; surface < _num_surfaces ; ++surface)
if (active_not_deact[surface])
dpm[surface] = rhs[ind++];
dintnl.assign(_num_models, 0);
for (unsigned model = 0 ; model < _num_models ; ++model)
if (anyActiveSurfaces(model, active_not_deact))
dintnl[model] = rhs[ind++];
mooseAssert(static_cast<int>(ind) == system_size, "Incorrect extracting of changes from NR solution in nrStep");
}
void
FiniteStrainPlasticBase::nrStep(const RankTwoTensor & stress, const std::vector<Real> & intnl_old, const std::vector<Real> & intnl, const std::vector<Real> & pm, const RankFourTensor & E_inv, const RankTwoTensor & delta_dp, RankTwoTensor & dstress, std::vector<Real> & dpm, std::vector<Real> & dintnl)
{
// Calculate RHS and Jacobian
std::vector<Real> rhs;
calculateRHS(stress, intnl_old, intnl, pm, delta_dp, rhs);
std::vector<std::vector<Real> > jac;
calculateJacobian(stress, intnl, pm, E_inv, jac);
// prepare for LAPACKgesv_ routine provided by PETSc (at least since PETSc 3.0.0)
int system_size = rhs.size();
std::vector<double> a(system_size*system_size);
// Fill in the a "matrix" by going down columns
unsigned ind = 0;
for (int col = 0 ; col < system_size ; ++col)
for (int row = 0 ; row < system_size ; ++row)
a[ind++] = jac[row][col];
int nrhs = 1;
std::vector<int> ipiv(system_size);
int info;
LAPACKgesv_(&system_size, &nrhs, &a[0], &system_size, &ipiv[0], &rhs[0], &system_size, &info);
if (info != 0)
mooseError("In solving the linear system in a Newton-Raphson process, the PETSC LAPACK gsev routine returned with error code " << info);
// Extract the results back to dstress, dpm and dintnl
unsigned int dim = 3;
ind = 0;
for (unsigned i = 0 ; i < dim ; ++i)
for (unsigned j = 0 ; j <= i ; ++j)
dstress(i, j) = dstress(j, i) = rhs[ind++];
dpm.resize(numberOfYieldFunctions());
for (unsigned alpha = 0 ; alpha < numberOfYieldFunctions() ; ++alpha)
dpm[alpha] = rhs[ind++];
dintnl.resize(numberOfInternalParameters());
for (unsigned a = 0 ; a < numberOfInternalParameters() ; ++a)
dintnl[a] = rhs[ind++];
}
static PetscErrorCode triangulateAndFormProl(IS selected_2, /* list of selected local ID, includes selected ghosts */
const PetscInt data_stride,
const PetscReal coords[], /* column vector of local coordinates w/ ghosts */
const PetscInt nselected_1, /* list of selected local ID, includes selected ghosts */
const PetscInt clid_lid_1[],
const PetscCoarsenData *agg_lists_1, /* selected_1 vertices of aggregate unselected vertices */
const PetscInt crsGID[],
const PetscInt bs,
Mat a_Prol, /* prolongation operator (output) */
PetscReal *a_worst_best) /* measure of worst missed fine vertex, 0 is no misses */
{
#if defined(PETSC_HAVE_TRIANGLE)
PetscErrorCode ierr;
PetscInt jj,tid,tt,idx,nselected_2;
struct triangulateio in,mid;
const PetscInt *selected_idx_2;
PetscMPIInt rank,size;
PetscInt Istart,Iend,nFineLoc,myFine0;
int kk,nPlotPts,sid;
MPI_Comm comm;
PetscReal tm;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)a_Prol,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = ISGetSize(selected_2, &nselected_2);CHKERRQ(ierr);
if (nselected_2 == 1 || nselected_2 == 2) { /* 0 happens on idle processors */
*a_worst_best = 100.0; /* this will cause a stop, but not globalized (should not happen) */
} else *a_worst_best = 0.0;
ierr = MPI_Allreduce(a_worst_best, &tm, 1, MPIU_REAL, MPIU_MAX, comm);CHKERRQ(ierr);
if (tm > 0.0) {
*a_worst_best = 100.0;
PetscFunctionReturn(0);
}
ierr = MatGetOwnershipRange(a_Prol, &Istart, &Iend);CHKERRQ(ierr);
nFineLoc = (Iend-Istart)/bs; myFine0 = Istart/bs;
nPlotPts = nFineLoc; /* locals */
/* traingle */
/* Define input points - in*/
in.numberofpoints = nselected_2;
in.numberofpointattributes = 0;
/* get nselected points */
ierr = PetscMalloc1(2*(nselected_2), &in.pointlist);CHKERRQ(ierr);
ierr = ISGetIndices(selected_2, &selected_idx_2);CHKERRQ(ierr);
for (kk=0,sid=0; kk<nselected_2; kk++,sid += 2) {
PetscInt lid = selected_idx_2[kk];
in.pointlist[sid] = coords[lid];
in.pointlist[sid+1] = coords[data_stride + lid];
if (lid>=nFineLoc) nPlotPts++;
}
if (sid != 2*nselected_2) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"sid %D != 2*nselected_2 %D",sid,nselected_2);
in.numberofsegments = 0;
in.numberofedges = 0;
in.numberofholes = 0;
in.numberofregions = 0;
in.trianglelist = 0;
in.segmentmarkerlist = 0;
in.pointattributelist = 0;
in.pointmarkerlist = 0;
in.triangleattributelist = 0;
in.trianglearealist = 0;
in.segmentlist = 0;
in.holelist = 0;
in.regionlist = 0;
in.edgelist = 0;
in.edgemarkerlist = 0;
in.normlist = 0;
/* triangulate */
mid.pointlist = 0; /* Not needed if -N switch used. */
/* Not needed if -N switch used or number of point attributes is zero: */
mid.pointattributelist = 0;
mid.pointmarkerlist = 0; /* Not needed if -N or -B switch used. */
mid.trianglelist = 0; /* Not needed if -E switch used. */
/* Not needed if -E switch used or number of triangle attributes is zero: */
mid.triangleattributelist = 0;
mid.neighborlist = 0; /* Needed only if -n switch used. */
/* Needed only if segments are output (-p or -c) and -P not used: */
mid.segmentlist = 0;
/* Needed only if segments are output (-p or -c) and -P and -B not used: */
mid.segmentmarkerlist = 0;
mid.edgelist = 0; /* Needed only if -e switch used. */
mid.edgemarkerlist = 0; /* Needed if -e used and -B not used. */
mid.numberoftriangles = 0;
/* Triangulate the points. Switches are chosen to read and write a */
/* PSLG (p), preserve the convex hull (c), number everything from */
/* zero (z), assign a regional attribute to each element (A), and */
/* produce an edge list (e), a Voronoi diagram (v), and a triangle */
/* neighbor list (n). */
if (nselected_2 != 0) { /* inactive processor */
char args[] = "npczQ"; /* c is needed ? */
triangulate(args, &in, &mid, (struct triangulateio*) NULL);
/* output .poly files for 'showme' */
if (!PETSC_TRUE) {
static int level = 1;
FILE *file; char fname[32];
sprintf(fname,"C%d_%d.poly",level,rank); file = fopen(fname, "w");
/*First line: <# of vertices> <dimension (must be 2)> <# of attributes> <# of boundary markers (0 or 1)>*/
fprintf(file, "%d %d %d %d\n",in.numberofpoints,2,0,0);
/*Following lines: <vertex #> <x> <y> */
for (kk=0,sid=0; kk<in.numberofpoints; kk++,sid += 2) {
fprintf(file, "%d %e %e\n",kk,in.pointlist[sid],in.pointlist[sid+1]);
}
/*One line: <# of segments> <# of boundary markers (0 or 1)> */
fprintf(file, "%d %d\n",0,0);
/*Following lines: <segment #> <endpoint> <endpoint> [boundary marker] */
/* One line: <# of holes> */
fprintf(file, "%d\n",0);
/* Following lines: <hole #> <x> <y> */
/* Optional line: <# of regional attributes and/or area constraints> */
/* Optional following lines: <region #> <x> <y> <attribute> <maximum area> */
fclose(file);
/* elems */
sprintf(fname,"C%d_%d.ele",level,rank); file = fopen(fname, "w");
/* First line: <# of triangles> <nodes per triangle> <# of attributes> */
fprintf(file, "%d %d %d\n",mid.numberoftriangles,3,0);
/* Remaining lines: <triangle #> <node> <node> <node> ... [attributes] */
for (kk=0,sid=0; kk<mid.numberoftriangles; kk++,sid += 3) {
fprintf(file, "%d %d %d %d\n",kk,mid.trianglelist[sid],mid.trianglelist[sid+1],mid.trianglelist[sid+2]);
}
fclose(file);
sprintf(fname,"C%d_%d.node",level,rank); file = fopen(fname, "w");
/* First line: <# of vertices> <dimension (must be 2)> <# of attributes> <# of boundary markers (0 or 1)> */
/* fprintf(file, "%d %d %d %d\n",in.numberofpoints,2,0,0); */
fprintf(file, "%d %d %d %d\n",nPlotPts,2,0,0);
/*Following lines: <vertex #> <x> <y> */
for (kk=0,sid=0; kk<in.numberofpoints; kk++,sid+=2) {
fprintf(file, "%d %e %e\n",kk,in.pointlist[sid],in.pointlist[sid+1]);
}
sid /= 2;
for (jj=0; jj<nFineLoc; jj++) {
PetscBool sel = PETSC_TRUE;
for (kk=0; kk<nselected_2 && sel; kk++) {
PetscInt lid = selected_idx_2[kk];
if (lid == jj) sel = PETSC_FALSE;
}
if (sel) fprintf(file, "%d %e %e\n",sid++,coords[jj],coords[data_stride + jj]);
}
fclose(file);
if (sid != nPlotPts) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"sid %D != nPlotPts %D",sid,nPlotPts);
level++;
}
}
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventBegin(petsc_gamg_setup_events[FIND_V],0,0,0,0);CHKERRQ(ierr);
#endif
{ /* form P - setup some maps */
PetscInt clid,mm,*nTri,*node_tri;
ierr = PetscMalloc1(nselected_2, &node_tri);CHKERRQ(ierr);
ierr = PetscMalloc1(nselected_2, &nTri);CHKERRQ(ierr);
/* need list of triangles on node */
for (kk=0; kk<nselected_2; kk++) nTri[kk] = 0;
for (tid=0,kk=0; tid<mid.numberoftriangles; tid++) {
for (jj=0; jj<3; jj++) {
PetscInt cid = mid.trianglelist[kk++];
if (nTri[cid] == 0) node_tri[cid] = tid;
nTri[cid]++;
}
}
#define EPS 1.e-12
/* find points and set prolongation */
for (mm = clid = 0; mm < nFineLoc; mm++) {
PetscBool ise;
ierr = PetscCDEmptyAt(agg_lists_1,mm,&ise);CHKERRQ(ierr);
if (!ise) {
const PetscInt lid = mm;
/* for (clid_iterator=0;clid_iterator<nselected_1;clid_iterator++) { */
PetscScalar AA[3][3];
PetscBLASInt N=3,NRHS=1,LDA=3,IPIV[3],LDB=3,INFO;
PetscCDPos pos;
ierr = PetscCDGetHeadPos(agg_lists_1,lid,&pos);CHKERRQ(ierr);
while (pos) {
PetscInt flid;
ierr = PetscLLNGetID(pos, &flid);CHKERRQ(ierr);
ierr = PetscCDGetNextPos(agg_lists_1,lid,&pos);CHKERRQ(ierr);
if (flid < nFineLoc) { /* could be a ghost */
PetscInt bestTID = -1; PetscReal best_alpha = 1.e10;
const PetscInt fgid = flid + myFine0;
/* compute shape function for gid */
const PetscReal fcoord[3] = {coords[flid],coords[data_stride+flid],1.0};
PetscBool haveit =PETSC_FALSE; PetscScalar alpha[3]; PetscInt clids[3];
/* look for it */
for (tid = node_tri[clid], jj=0;
jj < 5 && !haveit && tid != -1;
jj++) {
for (tt=0; tt<3; tt++) {
PetscInt cid2 = mid.trianglelist[3*tid + tt];
PetscInt lid2 = selected_idx_2[cid2];
AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0;
clids[tt] = cid2; /* store for interp */
}
for (tt=0; tt<3; tt++) alpha[tt] = (PetscScalar)fcoord[tt];
/* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */
PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO));
{
PetscBool have=PETSC_TRUE; PetscReal lowest=1.e10;
for (tt = 0, idx = 0; tt < 3; tt++) {
if (PetscRealPart(alpha[tt]) > (1.0+EPS) || PetscRealPart(alpha[tt]) < -EPS) have = PETSC_FALSE;
if (PetscRealPart(alpha[tt]) < lowest) {
lowest = PetscRealPart(alpha[tt]);
idx = tt;
}
}
haveit = have;
}
tid = mid.neighborlist[3*tid + idx];
}
if (!haveit) {
/* brute force */
for (tid=0; tid<mid.numberoftriangles && !haveit; tid++) {
for (tt=0; tt<3; tt++) {
PetscInt cid2 = mid.trianglelist[3*tid + tt];
PetscInt lid2 = selected_idx_2[cid2];
AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0;
clids[tt] = cid2; /* store for interp */
}
for (tt=0; tt<3; tt++) alpha[tt] = fcoord[tt];
/* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */
PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO));
{
PetscBool have=PETSC_TRUE; PetscReal worst=0.0, v;
for (tt=0; tt<3 && have; tt++) {
if (PetscRealPart(alpha[tt]) > 1.0+EPS || PetscRealPart(alpha[tt]) < -EPS) have=PETSC_FALSE;
if ((v=PetscAbs(PetscRealPart(alpha[tt])-0.5)) > worst) worst = v;
}
if (worst < best_alpha) {
best_alpha = worst; bestTID = tid;
}
haveit = have;
}
}
}
if (!haveit) {
if (best_alpha > *a_worst_best) *a_worst_best = best_alpha;
/* use best one */
for (tt=0; tt<3; tt++) {
PetscInt cid2 = mid.trianglelist[3*bestTID + tt];
PetscInt lid2 = selected_idx_2[cid2];
AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0;
clids[tt] = cid2; /* store for interp */
}
for (tt=0; tt<3; tt++) alpha[tt] = fcoord[tt];
/* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */
PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO));
}
/* put in row of P */
for (idx=0; idx<3; idx++) {
PetscScalar shp = alpha[idx];
if (PetscAbs(PetscRealPart(shp)) > 1.e-6) {
PetscInt cgid = crsGID[clids[idx]];
PetscInt jj = cgid*bs, ii = fgid*bs; /* need to gloalize */
for (tt=0; tt < bs; tt++, ii++, jj++) {
ierr = MatSetValues(a_Prol,1,&ii,1,&jj,&shp,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
}
} /* aggregates iterations */
clid++;
} /* a coarse agg */
} /* for all fine nodes */
ierr = ISRestoreIndices(selected_2, &selected_idx_2);CHKERRQ(ierr);
ierr = MatAssemblyBegin(a_Prol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(a_Prol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscFree(node_tri);CHKERRQ(ierr);
ierr = PetscFree(nTri);CHKERRQ(ierr);
}
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[FIND_V],0,0,0,0);CHKERRQ(ierr);
#endif
free(mid.trianglelist);
free(mid.neighborlist);
ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
PetscFunctionReturn(0);
#else
SETERRQ(PetscObjectComm((PetscObject)a_Prol),PETSC_ERR_PLIB,"configure with TRIANGLE to use geometric MG");
#endif
}
PetscErrorCode DSFunction_EXP_NHEP_PADE(DS ds)
{
#if defined(PETSC_MISSING_LAPACK_GESV) || defined(SLEPC_MISSING_LAPACK_LANGE)
PetscFunctionBegin;
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GESV/LANGE - Lapack routines are unavailable");
#else
PetscErrorCode ierr;
PetscBLASInt n,ld,ld2,*ipiv,info,inc=1;
PetscInt j,k,odd;
const PetscInt p=MAX_PADE;
PetscReal c[MAX_PADE+1],s;
PetscScalar scale,mone=-1.0,one=1.0,two=2.0,zero=0.0;
PetscScalar *A,*A2,*Q,*P,*W,*aux;
PetscFunctionBegin;
ierr = PetscBLASIntCast(ds->n,&n);CHKERRQ(ierr);
ierr = PetscBLASIntCast(ds->ld,&ld);CHKERRQ(ierr);
ld2 = ld*ld;
ierr = DSAllocateWork_Private(ds,0,ld,ld);CHKERRQ(ierr);
ipiv = ds->iwork;
if (!ds->mat[DS_MAT_W]) { ierr = DSAllocateMat_Private(ds,DS_MAT_W);CHKERRQ(ierr); }
if (!ds->mat[DS_MAT_Z]) { ierr = DSAllocateMat_Private(ds,DS_MAT_Z);CHKERRQ(ierr); }
A = ds->mat[DS_MAT_A];
A2 = ds->mat[DS_MAT_Z];
Q = ds->mat[DS_MAT_Q];
P = ds->mat[DS_MAT_F];
W = ds->mat[DS_MAT_W];
/* Pade' coefficients */
c[0] = 1.0;
for (k=1;k<=p;k++) {
c[k] = c[k-1]*(p+1-k)/(k*(2*p+1-k));
}
/* Scaling */
s = LAPACKlange_("I",&n,&n,A,&ld,ds->rwork);
if (s>0.5) {
s = PetscMax(0,(int)(PetscLogReal(s)/PetscLogReal(2.0)) + 2);
scale = PetscPowReal(2.0,(-1)*s);
PetscStackCallBLAS("BLASscal",BLASscal_(&ld2,&scale,A,&inc));
}
/* Horner evaluation */
PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,A,&ld,A,&ld,&zero,A2,&ld));
ierr = PetscMemzero(Q,ld*ld*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(P,ld*ld*sizeof(PetscScalar));CHKERRQ(ierr);
for (j=0;j<n;j++) {
Q[j+j*ld] = c[p];
P[j+j*ld] = c[p-1];
}
odd = 1;
for (k=p-1;k>0;k--) {
if (odd==1) {
PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,Q,&ld,A2,&ld,&zero,W,&ld));
aux = Q;
Q = W;
W = aux;
for (j=0;j<n;j++)
Q[j+j*ld] = Q[j+j*ld] + c[k-1];
} else {
PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,P,&ld,A2,&ld,&zero,W,&ld));
aux = P;
P = W;
W = aux;
for (j=0;j<n;j++)
P[j+j*ld] = P[j+j*ld] + c[k-1];
}
odd = 1-odd;
}
if (odd==1) {
PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,Q,&ld,A,&ld,&zero,W,&ld));
aux = Q;
Q = W;
W = aux;
PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&ld2,&mone,P,&inc,Q,&inc));
PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&n,&n,Q,&ld,ipiv,P,&ld,&info));
PetscStackCallBLAS("BLASscal",BLASscal_(&ld2,&two,P,&inc));
for (j=0;j<n;j++)
P[j+j*ld] = P[j+j*ld] + 1.0;
PetscStackCallBLAS("BLASscal",BLASscal_(&ld2,&mone,P,&inc));
} else {
PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,P,&ld,A,&ld,&zero,W,&ld));
aux = P;
P = W;
W = aux;
PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&ld2,&mone,P,&inc,Q,&inc));
PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&n,&n,Q,&ld,ipiv,P,&ld,&info));
PetscStackCallBLAS("BLASscal",BLASscal_(&ld2,&two,P,&inc));
for (j=0;j<n;j++)
P[j+j*ld] = P[j+j*ld] + 1.0;
}
for (k=1;k<=s;k++) {
PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,P,&ld,P,&ld,&zero,W,&ld));
ierr = PetscMemcpy(P,W,ld2*sizeof(PetscScalar));CHKERRQ(ierr);
}
if (P!=ds->mat[DS_MAT_F]) {
ierr = PetscMemcpy(ds->mat[DS_MAT_F],P,ld2*sizeof(PetscScalar));CHKERRQ(ierr);
}
PetscFunctionReturn(0);
#endif
}
