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);
}
va_dcl
#else /*__STDC__*/
# include <stdarg.h>
# define VSTART(l,a) va_start(l, a)
void
panic(const char *str, ...)
#endif /* __STDC__ */
{
va_list iggy;
fprintf(stderr, "%s: ", myname);
VSTART(iggy, str);
#ifndef HAVE_VPRINTF
# ifndef HAVE_DOPRNT
fputs(str, stderr); /* not great, but perhaps better than nothing... */
# else /* HAVE_DOPRNT */
_doprnt(str, &iggy, stderr);
# endif /* HAVE_DOPRNT */
#else /* HAVE_VFPRINTF */
vfprintf(stderr, str, iggy);
#endif /* HAVE_VFPRINTF */
va_end(iggy);
putc('\n', stderr);
exit(4);
}
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 AMGSolverPreProcess (NP_LINEAR_SOLVER *theNP, INT level,
VECDATA_DESC *VD_x, VECDATA_DESC *VD_b,
MATDATA_DESC *MD_A,
INT *baselevel, INT *result)
{
MULTIGRID *theMG;
GRID *theGrid;
int n,nonzeros,blocksize;
int Acomp;
MATRIX *theMatrix;
VECTOR *theVector;
int i,j,block_i,block_j;
int nRows_A,nCols_A,nComp_x,nComp_b;
NP_AMG *theAMGC;
double ti;
int ii;
#ifdef ModelP
double clock_start;
#else
clock_t clock_start;
#endif
theAMGC = (NP_AMG *) theNP;
/* prepare solving */
theMG = theAMGC->ls.base.mg;
theGrid = GRID_ON_LEVEL(theMG,level);
/* mark heap for use by amg */
#ifndef DYNAMIC_MEMORY_ALLOCMODEL
Mark(MGHEAP(theMG),FROM_BOTTOM,&amg_MarkKey);
#else
Mark(MGHEAP(theMG),FROM_TOP,&amg_MarkKey);
#endif
mark_counter++;
/* initialize sp package */
AMG_InstallPrintHandler((AMG_PrintFuncPtr)UserWrite);
amgMG=theMG; /* make it global for memory handler */
AMG_InstallMallocHandler((AMG_MallocFuncPtr)amgmalloc);
/* get access to components */
nRows_A = MD_ROWS_IN_RT_CT(MD_A,NODEVEC,NODEVEC);
nCols_A = MD_COLS_IN_RT_CT(MD_A,NODEVEC,NODEVEC);
nComp_x = VD_NCMPS_IN_TYPE(VD_x,NODEVEC);
nComp_b = VD_NCMPS_IN_TYPE(VD_b,NODEVEC);
blocksize = nComp_x;
if (blocksize==0) goto exit;
if (nComp_b!=blocksize) goto exit;
if (nCols_A!=blocksize) goto exit;
if (nRows_A!=blocksize) goto exit;
Acomp = MD_MCMP_OF_RT_CT(MD_A,NODEVEC,NODEVEC,0);
CSTART(); ti=0; ii=0;
/* diagonal scaling */
if (theAMGC->scale)
if (DiagonalScaleSystem(theGrid,MD_A,MD_A,VD_b)!=NUM_OK)
{
UserWrite("Error in scaling system\n");
goto exit;
}
/* gather some data for the matrix */
n = nonzeros = 0;
/* loop through all vectors, we assume there are only node vectors ! */
for (theVector=FIRSTVECTOR(theGrid); theVector!= NULL; theVector=SUCCVC(theVector))
{
VINDEX(theVector) = n++; /* renumber vectors just to be sure ... */
/* now speed through this row */
for (theMatrix=VSTART(theVector); theMatrix!=NULL; theMatrix = MNEXT(theMatrix))
nonzeros++;
}
#ifdef ModelP
if (me == master)
{
#endif
/* now allocate fine grid vectors x and b */
theAMGC->x = AMG_NewVector(n*blocksize,1,"x");
if (theAMGC->x==NULL) {
UserWrite("no memory for x\n");
goto exit;
}
theAMGC->b = AMG_NewVector(n*blocksize,1,"b");
if (theAMGC->b==NULL) {
UserWrite("no memory for b\n");
goto exit;
}
/* and a new matrix */
theAMGC->A = AMG_NewMatrix(n*blocksize,1,nonzeros*blocksize*blocksize,blocksize,"fine grid A");
if (theAMGC->A==NULL) {
UserWrite("no memory for A\n");
goto exit;
}
#ifdef ModelP
}
else
{
/* no master vectors allowed */
assert(n==0);
/* only master builds up coarse levels */
return (0);
}
#endif
/* now fill matrix */
for (theVector=FIRSTVECTOR(theGrid); theVector!= NULL; theVector=SUCCVC(theVector))
{
i = VINDEX(theVector);
/* count row length */
nonzeros=0;
for (theMatrix=VSTART(theVector); theMatrix!=NULL; theMatrix = MNEXT(theMatrix))
nonzeros++;
/* for each row */
for (block_i=0; block_i<blocksize; block_i++)
{
/* allocate row */
if (AMG_SetRowLength(theAMGC->A,i*blocksize+block_i,nonzeros*blocksize)!=AMG_OK)
{
UserWrite("Error in AMG_SetRowLength\n");
goto exit;
}
/* the diagonal block, be careful to allocate the main diagonal first */
theMatrix=VSTART(theVector);
if (AMG_InsertValues(theAMGC->A,i*blocksize+block_i,i*blocksize+block_i,
&(MVALUE(theMatrix,Acomp+block_i*blocksize+block_i)))<0)
{
UserWrite("Error in AMG_InsertValues\n");
goto exit;
}
for (block_j=0; block_j<blocksize; block_j++)
{
if (block_j==block_i) continue;
if (AMG_InsertValues(theAMGC->A,i*blocksize+block_i,i*blocksize+block_j,
&(MVALUE(theMatrix,Acomp+block_i*blocksize+block_j)))<0)
{
UserWrite("Error in AMG_InsertValues\n");
goto exit;
}
}
/* all the offdiagonal blocks */
for (theMatrix=MNEXT(VSTART(theVector)); theMatrix!=NULL; theMatrix = MNEXT(theMatrix))
{
j = VINDEX(MDEST(theMatrix));
for (block_j=0; block_j<blocksize; block_j++)
{
if (AMG_InsertValues(theAMGC->A,i*blocksize+block_i,j*blocksize+block_j,
&(MVALUE(theMatrix,Acomp+block_i*blocksize+block_j)))<0)
{
UserWrite("Error in AMG_InsertValues\n");
goto exit;
}
}
}
}
}
/*AMG_PrintMatrix(theAMGC->A,"Matrix");*/
/* call algebraic multigrid solver */
if (AMG_Build(&theAMGC->sc,&theAMGC->cc,theAMGC->A)!=AMG_OK) theAMGC->AMG_Build_failed=1;
theAMGC->AMG_Build_failed=0;
CSTOP(ti,ii);
if (theAMGC->sc.verbose>0)
UserWriteF("AMG : L=%2d BUILD=%10.4g\n",level,ti);
return(0); /* ok, matrix is set up */
exit: /* error */
if (mark_counter>0) {
#ifndef DYNAMIC_MEMORY_ALLOCMODEL
Release(MGHEAP(theMG),FROM_BOTTOM,amg_MarkKey);
#else
Release(MGHEAP(theMG),FROM_TOP,amg_MarkKey);
#endif
mark_counter--;
}
return(1);
}
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);
}
