INT NS_DIM_PREFIX CheckSymmetryOfMatrix (GRID *theGrid, MATDATA_DESC *A)
{
MATRIX *m,*mt;
VECTOR *v,*w;
DOUBLE *mptr,*mtptr;
register SHORT i,j,rcomp,ccomp,*mcomp,*mtcomp,vtype,mtype;
for (v=FIRSTVECTOR(theGrid); v!=NULL; v=SUCCVC(v)) {
vtype = VTYPE(v);
for (m=VSTART(v); m!=NULL; m=MNEXT(m)) {
mt = MADJ(m);
w = MDEST(m);
mtype = MTP(vtype,VTYPE(w));
rcomp = MD_ROWS_IN_MTYPE(A,mtype);
if (rcomp == 0) continue;
ccomp = MD_COLS_IN_MTYPE(A,mtype);
if (ccomp == 0) continue;
mcomp = MD_MCMPPTR_OF_MTYPE(A,mtype);
mptr = MVALUEPTR(m,0);
mtcomp = MD_MCMPPTR_OF_MTYPE(A,MTP(VTYPE(w),vtype));
mtptr = MVALUEPTR(m,0);
for (i=0; i<ccomp; i++)
for (j=0; j<rcomp; j++)
if (mptr[mcomp[i*rcomp+j]] != mtptr[mtcomp[j*ccomp+i]])
return(1);
}
}
return(0);
}
void build_graph(double *x,VTYPE &y,double (*fun)(double,double*),double x0,double x1,int nx,VTYPE &par)
{
double dx=(x1-x0)/nx;
#ifdef JACK
VTYPE xj(nx+1,par.njack);
y=VTYPE(nx+1,par.njack);
#else
VTYPE xj(nx+1,par.nboot,par.njack);
y=VTYPE(nx+1,par.nboot,par.njack);
#endif
for(int i=0;i<=nx;i++) xj.data[i]=x[i]=x0+dx*i;
y=par_single_fun(fun,xj,par);
}
static int Gather_VectorFlags (DDD_OBJ obj, void *data)
{
VECTOR *pv = (VECTOR *)obj;
INT *idata = (INT *)data;
idata[0] = VECSKIP(pv);
idata[1] = VCLASS(pv);
idata[2] = VNCLASS(pv);
idata[3] = NEW_DEFECT(pv);
idata[4] = FINE_GRID_DOF(pv);
idata[5] = VTYPE(pv);
idata[6] = VOTYPE(pv);
idata[7] = VDATATYPE(pv);
idata[8] = VNEW(pv);
idata[9] = VECTORSIDE(pv);
idata[10] = VPART(pv);
return (0);
}
INT l_nlgs (NP_NLGS *nlgs, NP_NL_ASSEMBLE *ass, GRID *grid, const DOUBLE *damp,
VECDATA_DESC *x, VECDATA_DESC *v, MATDATA_DESC *M,
VECDATA_DESC *d)
{
VECTOR *vec,*w,*first_vec;
NODE *theNode;
MULTIGRID *mg;
INT level;
INT rtype,ctype,myindex,error;
register MATRIX *mat;
register SHORT *tmpptr,*dcomp,*xcomp,*vcomp;
register SHORT i;
register SHORT n;
DEFINE_VD_CMPS(cy);
DEFINE_MD_CMPS(m);
DOUBLE r[MAX_SINGLE_VEC_COMP];
mg = nlgs->smoother.iter.base.mg;
level = GLEVEL(grid);
first_vec = FIRSTVECTOR(grid);
L_VLOOP__CLASS(vec,first_vec,ACTIVE_CLASS)
{
rtype = VTYPE(vec);
/* get node */
theNode = (NODE*)VOBJECT(vec);
n = VD_NCMPS_IN_TYPE(v,rtype);
if (n == 0) continue;
dcomp = VD_CMPPTR_OF_TYPE(d,rtype);
xcomp = VD_CMPPTR_OF_TYPE(x,rtype);
vcomp = VD_CMPPTR_OF_TYPE(v,rtype);
myindex = VINDEX(vec);
/* local Jacobi matrix */
if ((*ass->NLNAssembleMatrix)(ass,level,level,theNode,x,d,v,M,&error)) {
error = __LINE__;
REP_ERR_RETURN(error);
}
/* get defect */
for (i=0; i<n; i++)
r[i] = VVALUE(vec,dcomp[i]);
/* rhs */
for (ctype=0; ctype<=NVECTYPES; ctype++)
if (MD_ROWS_IN_RT_CT(M,rtype,ctype)>0)
{
SET_CMPS_22(cy,v,m,M,rtype,ctype,tmpptr);
s0 = s1 = 0.0;
for (mat=MNEXT(VSTART(vec)); mat!=NULL; mat=MNEXT(mat))
if (((VTYPE(w=MDEST(mat))==ctype) && (VCLASS(w)>=ACTIVE_CLASS)) && (myindex>VINDEX(w)))
MATMUL_22(s,mat,m,w,cy);
r[0] -= s0;
r[1] -= s1;
}
/* solve */
if (MySolveSmallBlock(n,VD_CMPPTR_OF_TYPE(v,rtype),VVALPTR(vec),
MD_MCMPPTR_OF_RT_CT(M,rtype,rtype),
MVALPTR(VSTART(vec)),r)!=0)
return (__LINE__);
/* damp */
for (i=0; i<n; i++)
VVALUE(vec,vcomp[i]) *= damp[i];
/* update solution */
for (i=0; i<n; i++)
VVALUE(vec,xcomp[i]) -= VVALUE(vec,vcomp[i]);
}
static int Scatter_VectorFlags (DDD_OBJ obj, void *data)
{
VECTOR *pv = (VECTOR *)obj;
INT *idata = (INT *)data;
if (idata[0] != VECSKIP(pv)) {
printf(PFMT "ERROR:"
" VECSKIP not matches vec="
VINDEX_FMTX " %d master %d\n",me,
VINDEX_PRTX(pv),VECSKIP(pv),idata[0]);
pcheck++;
ASSERT(0);
}
if (idata[1] != VCLASS(pv)) {
printf(PFMT "ERROR:"
" VCLASS not matches vec="
VINDEX_FMTX " %d master %d\n",me,
VINDEX_PRTX(pv),VCLASS(pv),idata[1]);
ASSERT(0);
}
if (idata[2] != VNCLASS(pv)) {
printf(PFMT "ERROR:"
" VNCLASS not matches vec="
VINDEX_FMTX " %d master %d\n",me,
VINDEX_PRTX(pv),VNCLASS(pv),idata[2]);
pcheck++;
ASSERT(0);
}
if (idata[3] != NEW_DEFECT(pv)) {
printf(PFMT "ERROR:"
" NEW_DEFECT not matches vec="
VINDEX_FMTX " %d master %d\n",me,
VINDEX_PRTX(pv),NEW_DEFECT(pv),idata[3]);
pcheck++;
ASSERT(0);
}
if (idata[4] != FINE_GRID_DOF(pv)) {
printf(PFMT "ERROR:"
" FINE_GRID_DOF not matches vec="
VINDEX_FMTX " %d master %d\n",me,
VINDEX_PRTX(pv),FINE_GRID_DOF(pv),idata[4]);
pcheck++;
ASSERT(0);
}
if (idata[5] != VTYPE(pv)) {
printf(PFMT "ERROR:"
" VTYPE not matches vec="
VINDEX_FMTX " %d master %d\n",me,
VINDEX_PRTX(pv),VTYPE(pv),idata[5]);
pcheck++;
ASSERT(0);
}
if (idata[6] != VOTYPE(pv)) {
printf(PFMT "ERROR:"
" VOTYPE not matches vec="
VINDEX_FMTX " %d master %d\n",me,
VINDEX_PRTX(pv),VOTYPE(pv),idata[6]);
pcheck++;
ASSERT(0);
}
if (idata[7] != VDATATYPE(pv)) {
printf(PFMT "ERROR:"
" VDATATYPE not matches vec="
VINDEX_FMTX " %d master %d\n",me,
VINDEX_PRTX(pv),VDATATYPE(pv),idata[7]);
pcheck++;
ASSERT(0);
}
if (idata[8] != VNEW(pv)) {
printf(PFMT "ERROR:"
" VNEW not matches vec="
VINDEX_FMTX " %d master %d\n",me,
VINDEX_PRTX(pv),VNEW(pv),idata[8]);
pcheck++;
ASSERT(0);
}
if (idata[9] != VECTORSIDE(pv)) {
printf(PFMT "ERROR:"
" VECTORSIDE not matches vec="
VINDEX_FMTX " %d master %d\n",me,
VINDEX_PRTX(pv),VECTORSIDE(pv),idata[9]);
pcheck++;
ASSERT(0);
}
if (idata[10] != VPART(pv)) {
printf(PFMT "ERROR:"
" VPART not matches vec="
VINDEX_FMTX " %d master %d\n",me,
VINDEX_PRTX(pv),VPART(pv),idata[10]);
pcheck++;
ASSERT(0);
}
return (0);
}
static INT CheckVector (GRID *theGrid, VECTOR *v)
{
FORMAT *theFormat;
NODE *theNode;
VECTOR *w;
INT nerr = 0;
/* get format */
theFormat = MGFORMAT(MYMG(theGrid));
if ((FMT_S_MAT_TP(theFormat,DIAGMATRIXTYPE(VTYPE(v)))>0) && (!GHOST(v))) {
if (VSTART(v) == NULL) {
UserWriteF(PFMT "ERROR: no diagonal matrix vec=" VINDEX_FMTX "\n",
me,VINDEX_PRTX(v));
nerr++;
}
else if (!MDIAG(VSTART(v))) {
UserWriteF(PFMT "ERROR: VSTART no diagonal matrix vec="
VINDEX_FMTX "\n",
me,VINDEX_PRTX(v));
nerr++;
}
}
/* check flags locally */
if (NEW_DEFECT(v) != (VCLASS(v)>=2)) {
UserWriteF(PFMT "ERROR: classes not match vec="
VINDEX_FMTX " NEW_DEFECT %d VCLASS %d\n",
me,VINDEX_PRTX(v),NEW_DEFECT(v),VCLASS(v));
nerr++;
}
if (FINE_GRID_DOF(v) != ((VCLASS(v)>=2)&&(VNCLASS(v)<=1))) {
UserWriteF(PFMT "ERROR: classes not match vec="
VINDEX_FMTX " FINE_GRID_DOF %d VNCLASS %d VCLASS %d\n",
me,VINDEX_PRTX(v),FINE_GRID_DOF(v),VNCLASS(v),VCLASS(v));
nerr++;
}
if (FINE_GRID_DOF(v))
if (FULLREFINELEVEL(MYMG(theGrid)) > GLEVEL(theGrid)) {
UserWriteF(PFMT "ERROR: FULLREFINELEVEL too large vec="
VINDEX_FMTX " FINE_GRID_DOF %d FULLREFINELEVEL %d\n",
me,VINDEX_PRTX(v),FINE_GRID_DOF(v),
FULLREFINELEVEL(MYMG(theGrid)));
nerr++;
}
if (VOTYPE(v) == NODEVEC) {
theNode = (NODE *) VOBJECT(v);
if (theNode == NULL) {
if (GLEVEL(theGrid) >= 0) {
UserWriteF(PFMT "ERROR: nodevector has no NODE vec="
VINDEX_FMTX " \n",
me,VINDEX_PRTX(v));
nerr++;
}
}
else {
if (OBJT(theNode) != NDOBJ) {
UserWriteF(PFMT "ERROR: nodevector has no NODE object vec="
VINDEX_FMTX " OBJT %d\n",
me,VINDEX_PRTX(v),OBJT(theNode));
nerr++;
}
if (NTYPE(theNode) == CORNER_NODE) {
theNode = (NODE *)NFATHER(theNode);
if (theNode != NULL) {
w = NVECTOR(theNode);
if (w == NULL) {
UserWriteF(PFMT "ERROR:"
" cornernode vector has no father vec="
VINDEX_FMTX "\n",
me,VINDEX_PRTX(v));
nerr++;
}
if (VNCLASS(w) != VCLASS(v)) {
UserWriteF(PFMT "ERROR:"
" VCLASS and VNCLASS not matches vec="
VINDEX_FMTX " VCLASS %d father vec "
VINDEX_FMTX " VNCLASS %d\n",
me,VINDEX_PRTX(v),VCLASS(v),
VINDEX_PRTX(w),VNCLASS(w));
nerr++;
}
}
}
}
}
return(nerr);
}
