#ifndef lint static char vcid[] = "$Id: aijfact.c,v 1.41 1995/10/11 15:19:32 bsmith Exp bsmith $"; #endif #include "aij.h" #include "inline/spops.h" /* Factorization code for AIJ format. */ int MatLUFactorSymbolic_SeqAIJ(Mat A,IS isrow,IS iscol,double f,Mat *B) { Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data, *b; IS isicol; int *r,*ic, ierr, i, n = a->m, *ai = a->i, *aj = a->j; int *ainew,*ajnew, jmax,*fill, *ajtmp, nz,shift = a->indexshift; int *idnew, idx, row,m,fm, nnz, nzi,len, realloc = 0,nzbd,*im; if (n != a->n) SETERRQ(1,"MatLUFactorSymbolic_SeqAIJ:Must be square"); if (!isrow) SETERRQ(1,"MatLUFactorSymbolic_SeqAIJ:Must have row permutation"); if (!iscol) SETERRQ(1,"MatLUFactorSymbolic_SeqAIJ:Must have column permutation"); ierr = ISInvertPermutation(iscol,&isicol); CHKERRQ(ierr); ISGetIndices(isrow,&r); ISGetIndices(isicol,&ic); /* get new row pointers */ ainew = (int *) PETSCMALLOC( (n+1)*sizeof(int) ); CHKPTRQ(ainew); ainew[0] = -shift; /* don't know how many column pointers are needed so estimate */ jmax = (int) (f*ai[n]+(!shift)); ajnew = (int *) PETSCMALLOC( (jmax)*sizeof(int) ); CHKPTRQ(ajnew); /* fill is a linked list of nonzeros in active row */ fill = (int *) PETSCMALLOC( (2*n+1)*sizeof(int)); CHKPTRQ(fill); im = fill + n + 1; /* idnew is location of diagonal in factor */ idnew = (int *) PETSCMALLOC( (n+1)*sizeof(int)); CHKPTRQ(idnew); idnew[0] = -shift; for ( i=0; i 0) { idx = *ajtmp++ + shift; nzbd++; if (idx == i) im[row] = nzbd; do { m = fm; fm = fill[m]; } while (fm < idx); if (fm != idx) { fill[m] = idx; fill[idx] = fm; fm = idx; nnz++; } } row = fill[row]; } /* copy new filled row into permanent storage */ ainew[i+1] = ainew[i] + nnz; if (ainew[i+1] > jmax+1) { /* allocate a longer ajnew */ int maxadd; maxadd = (int) ((f*(ai[n]+(!shift))*(n-i+5))/n); if (maxadd < nnz) maxadd = (n-i)*(nnz+1); jmax += maxadd; ajtmp = (int *) PETSCMALLOC( jmax*sizeof(int) );CHKPTRQ(ajtmp); PetscMemcpy(ajtmp,ajnew,(ainew[i]+shift)*sizeof(int)); PETSCFREE(ajnew); ajnew = ajtmp; realloc++; /* count how many times we realloc */ } ajtmp = ajnew + ainew[i] + shift; fm = fill[n]; nzi = 0; im[i] = nnz; while (nnz--) { if (fm < i) nzi++; *ajtmp++ = fm - shift; fm = fill[fm]; } idnew[i] = ainew[i] + nzi; } PLogInfo((PetscObject)A, "Info:MatLUFactorSymbolic_SeqAIJ:Reallocs %d Fill ratio:given %g needed %g\n", realloc,f,((double)ainew[n])/((double)ai[i])); ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr); ierr = ISRestoreIndices(isicol,&ic); CHKERRQ(ierr); PETSCFREE(fill); /* put together the new matrix */ ierr = MatCreateSeqAIJ(A->comm,n, n, 0, 0, B); CHKERRQ(ierr); PLogObjectParent(*B,isicol); ierr = ISDestroy(isicol); CHKERRQ(ierr); b = (Mat_SeqAIJ *) (*B)->data; PETSCFREE(b->imax); b->singlemalloc = 0; len = (ainew[n] + shift)*sizeof(Scalar); /* the next line frees the default space generated by the Create() */ PETSCFREE(b->a); PETSCFREE(b->ilen); b->a = (Scalar *) PETSCMALLOC( len ); CHKPTRQ(b->a); b->j = ajnew; b->i = ainew; b->diag = idnew; b->ilen = 0; b->imax = 0; b->row = isrow; b->col = iscol; b->solve_work = (Scalar *) PETSCMALLOC( n*sizeof(Scalar)); CHKPTRQ(b->solve_work); /* In b structure: Free imax, ilen, old a, old j. Allocate idnew, solve_work, new a, new j */ PLogObjectMemory(*B,(ainew[n]+shift-n)*(sizeof(int)+sizeof(Scalar))); b->maxnz = b->nz = ainew[n] + shift; return 0; } /* ----------------------------------------------------------- */ int MatLUFactorNumeric_SeqAIJ(Mat A,Mat *B) { Mat C = *B; Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data, *b = (Mat_SeqAIJ *)C->data; IS iscol = b->col, isrow = b->row, isicol; int *r,*ic, ierr, i, j, n = a->m, *ai = b->i, *aj = b->j; int *ajtmpold, *ajtmp, nz, row, *ics, shift = a->indexshift; Scalar *rtmp,*v, *pc, multiplier; /* These declarations are for optimizations. They reduce the number of memory references that are made by locally storing information; the word "register" used here with pointers can be viewed as "private" or "known only to me" */ int *diag_offset = b->diag; register Scalar *pv, *rtmps; register int *pj; ierr = ISInvertPermutation(iscol,&isicol); CHKERRQ(ierr); PLogObjectParent(*B,isicol); ierr = ISGetIndices(isrow,&r); CHKERRQ(ierr); ierr = ISGetIndices(isicol,&ic); CHKERRQ(ierr); rtmp = (Scalar *) PETSCMALLOC( (n+1)*sizeof(Scalar) ); CHKPTRQ(rtmp); rtmps = rtmp + shift; ics = ic + shift; for ( i=0; ii[r[i]+1] - a->i[r[i]]; ajtmpold = a->j + a->i[r[i]] + shift; v = a->a + a->i[r[i]] + shift; for ( j=0; ja + diag_offset[row] + shift; pj = b->j + diag_offset[row] + (!shift); multiplier = *pc * *pv++; *pc = multiplier; nz = ai[row+1] - diag_offset[row] - 1; PLogFlops(2*nz); /* The for-loop form can aid the compiler in overlapping loads and stores */ /*while (nz-->0) rtmps[*pj++] -= multiplier* *pv++; */ {int __i; for (__i=0; __ia */ pv = b->a + ai[i] + shift; pj = b->j + ai[i] + shift; nz = ai[i+1] - ai[i]; if (rtmp[i] == 0.0) {SETERRQ(1,"MatLUFactorNumeric_SeqAIJ:Zero pivot");} rtmp[i] = 1.0/rtmp[i]; for ( j=0; jfactor = FACTOR_LU; b->assembled = 1; PLogFlops(b->n); return 0; } /* ----------------------------------------------------------- */ int MatLUFactor_SeqAIJ(Mat A,IS row,IS col,double f) { Mat_SeqAIJ *mat = (Mat_SeqAIJ *) A->data; int ierr; Mat C; ierr = MatLUFactorSymbolic_SeqAIJ(A,row,col,f,&C); CHKERRQ(ierr); ierr = MatLUFactorNumeric_SeqAIJ(A,&C); CHKERRQ(ierr); /* free all the data structures from mat */ PETSCFREE(mat->a); if (!mat->singlemalloc) {PETSCFREE(mat->i); PETSCFREE(mat->j);} if (mat->diag) PETSCFREE(mat->diag); if (mat->ilen) PETSCFREE(mat->ilen); if (mat->imax) PETSCFREE(mat->imax); if (mat->solve_work) PETSCFREE(mat->solve_work); PETSCFREE(mat); PetscMemcpy(A,C,sizeof(struct _Mat)); PETSCHEADERDESTROY(C); return 0; } /* ----------------------------------------------------------- */ int MatSolve_SeqAIJ(Mat A,Vec bb, Vec xx) { Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; IS iscol = a->col, isrow = a->row; int *r,*c, ierr, i, n = a->m, *vi, *ai = a->i, *aj = a->j; int nz,shift = a->indexshift; Scalar *x,*b,*tmp, *tmps, *aa = a->a, sum, *v; if (A->factor != FACTOR_LU) SETERRQ(1,"MatSolve_SeqAIJ:Not for unfactored matrix"); ierr = VecGetArray(bb,&b); CHKERRQ(ierr); ierr = VecGetArray(xx,&x); CHKERRQ(ierr); tmp = a->solve_work; ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr); ierr = ISGetIndices(iscol,&c);CHKERRQ(ierr); c = c + (n-1); /* forward solve the lower triangular */ tmp[0] = b[*r++]; tmps = tmp + shift; for ( i=1; idiag[i] - ai[i]; sum = b[*r++]; while (nz--) sum -= *v++ * tmps[*vi++]; tmp[i] = sum; } /* backward solve the upper triangular */ for ( i=n-1; i>=0; i-- ){ v = aa + a->diag[i] + (!shift); vi = aj + a->diag[i] + (!shift); nz = ai[i+1] - a->diag[i] - 1; sum = tmp[i]; while (nz--) sum -= *v++ * tmps[*vi++]; x[*c--] = tmp[i] = sum*aa[a->diag[i]+shift]; } ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr); ierr = ISRestoreIndices(iscol,&c); CHKERRQ(ierr); PLogFlops(2*a->nz - a->n); return 0; } int MatSolveAdd_SeqAIJ(Mat A,Vec bb, Vec yy, Vec xx) { Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; IS iscol = a->col, isrow = a->row; int *r,*c, ierr, i, n = a->m, *vi, *ai = a->i, *aj = a->j; int nz, shift = a->indexshift; Scalar *x,*b,*tmp, *aa = a->a, sum, *v; if (A->factor != FACTOR_LU) SETERRQ(1,"MatSolveAdd_SeqAIJ:Not for unfactored matrix"); if (yy != xx) {ierr = VecCopy(yy,xx); CHKERRQ(ierr);} ierr = VecGetArray(bb,&b); CHKERRQ(ierr); ierr = VecGetArray(xx,&x); CHKERRQ(ierr); tmp = a->solve_work; ierr = ISGetIndices(isrow,&r); CHKERRQ(ierr); ierr = ISGetIndices(iscol,&c); CHKERRQ(ierr); c = c + (n-1); /* forward solve the lower triangular */ tmp[0] = b[*r++]; for ( i=1; idiag[i] - ai[i]; sum = b[*r++]; while (nz--) sum -= *v++ * tmp[*vi++ + shift]; tmp[i] = sum; } /* backward solve the upper triangular */ for ( i=n-1; i>=0; i-- ){ v = aa + a->diag[i] + (!shift); vi = aj + a->diag[i] + (!shift); nz = ai[i+1] - a->diag[i] - 1; sum = tmp[i]; while (nz--) sum -= *v++ * tmp[*vi++ + shift]; tmp[i] = sum*aa[a->diag[i]+shift]; x[*c--] += tmp[i]; } ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr); ierr = ISRestoreIndices(iscol,&c); CHKERRQ(ierr); PLogFlops(2*a->nz); return 0; } /* -------------------------------------------------------------------*/ int MatSolveTrans_SeqAIJ(Mat A,Vec bb, Vec xx) { Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; IS iscol = a->col, isrow = a->row, invisrow,inviscol; int *r,*c, ierr, i, n = a->m, *vi, *ai = a->i, *aj = a->j; int nz,shift = a->indexshift; Scalar *x,*b,*tmp, *aa = a->a, *v; if (A->factor != FACTOR_LU) SETERRQ(1,"MatSolveTrans_SeqAIJ:Not unfactored matrix"); ierr = VecGetArray(bb,&b); CHKERRQ(ierr); ierr = VecGetArray(xx,&x); CHKERRQ(ierr); tmp = a->solve_work; /* invert the permutations */ ierr = ISInvertPermutation(isrow,&invisrow); CHKERRQ(ierr); ierr = ISInvertPermutation(iscol,&inviscol); CHKERRQ(ierr); ierr = ISGetIndices(invisrow,&r); CHKERRQ(ierr); ierr = ISGetIndices(inviscol,&c); CHKERRQ(ierr); /* copy the b into temp work space according to permutation */ for ( i=0; idiag[i] + shift; vi = aj + a->diag[i] + (!shift); nz = ai[i+1] - a->diag[i] - 1; tmp[i] *= *v++; while (nz--) { tmp[*vi++ + shift] -= (*v++)*tmp[i]; } } /* backward solve the L^T */ for ( i=n-1; i>=0; i-- ){ v = aa + a->diag[i] - 1 + shift; vi = aj + a->diag[i] - 1 + shift; nz = a->diag[i] - ai[i]; while (nz--) { tmp[*vi-- + shift] -= (*v--)*tmp[i]; } } /* copy tmp into x according to permutation */ for ( i=0; inz-a->n); return 0; } int MatSolveTransAdd_SeqAIJ(Mat A,Vec bb, Vec zz,Vec xx) { Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; IS iscol = a->col, isrow = a->row, invisrow,inviscol; int *r,*c, ierr, i, n = a->m, *vi, *ai = a->i, *aj = a->j; int nz,shift = a->indexshift; Scalar *x,*b,*tmp, *aa = a->a, *v; if (A->factor != FACTOR_LU)SETERRQ(1,"MatSolveTransAdd_SeqAIJ:Not unfactored matrix"); if (zz != xx) VecCopy(zz,xx); ierr = VecGetArray(bb,&b); CHKERRQ(ierr); ierr = VecGetArray(xx,&x); CHKERRQ(ierr); tmp = a->solve_work; /* invert the permutations */ ierr = ISInvertPermutation(isrow,&invisrow); CHKERRQ(ierr); ierr = ISInvertPermutation(iscol,&inviscol); CHKERRQ(ierr); ierr = ISGetIndices(invisrow,&r); CHKERRQ(ierr); ierr = ISGetIndices(inviscol,&c); CHKERRQ(ierr); /* copy the b into temp work space according to permutation */ for ( i=0; idiag[i] + shift; vi = aj + a->diag[i] + (!shift); nz = ai[i+1] - a->diag[i] - 1; tmp[i] *= *v++; while (nz--) { tmp[*vi++ + shift] -= (*v++)*tmp[i]; } } /* backward solve the L^T */ for ( i=n-1; i>=0; i-- ){ v = aa + a->diag[i] - 1 + shift; vi = aj + a->diag[i] - 1 + shift; nz = a->diag[i] - ai[i]; while (nz--) { tmp[*vi-- + shift] -= (*v--)*tmp[i]; } } /* copy tmp into x according to permutation */ for ( i=0; inz); return 0; } /* ----------------------------------------------------------------*/ int MatILUFactorSymbolic_SeqAIJ(Mat A,IS isrow,IS iscol,double f, int levels,Mat *fact) { Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data, *b; IS isicol; int *r,*ic, ierr, prow, n = a->m, *ai = a->i, *aj = a->j; int *ainew,*ajnew, jmax,*fill, *xi, nz, *im,*ajfill,*flev; int *dloc, idx, row,m,fm, nzf, nzi,len, realloc = 0; int incrlev,nnz,i,shift = a->indexshift; if (n != a->n) SETERRQ(1,"MatILUFactorSymbolic_SeqAIJ:Matrix must be square"); if (!isrow) SETERRQ(1,"MatILUFactorSymbolic_SeqAIJ:Must have row permutation"); if (!iscol) SETERRQ(1,"MatILUFactorSymbolic_SeqAIJ:Must have column permutation"); ierr = ISInvertPermutation(iscol,&isicol); CHKERRQ(ierr); ierr = ISGetIndices(isrow,&r); CHKERRQ(ierr); ierr = ISGetIndices(isicol,&ic); CHKERRQ(ierr); /* get new row pointers */ ainew = (int *) PETSCMALLOC( (n+1)*sizeof(int) ); CHKPTRQ(ainew); ainew[0] = -shift; /* don't know how many column pointers are needed so estimate */ jmax = (int) (f*(ai[n]+!shift)); ajnew = (int *) PETSCMALLOC( (jmax)*sizeof(int) ); CHKPTRQ(ajnew); /* ajfill is level of fill for each fill entry */ ajfill = (int *) PETSCMALLOC( (jmax)*sizeof(int) ); CHKPTRQ(ajfill); /* fill is a linked list of nonzeros in active row */ fill = (int *) PETSCMALLOC( (n+1)*sizeof(int)); CHKPTRQ(fill); /* im is level for each filled value */ im = (int *) PETSCMALLOC( (n+1)*sizeof(int)); CHKPTRQ(im); /* dloc is location of diagonal in factor */ dloc = (int *) PETSCMALLOC( (n+1)*sizeof(int)); CHKPTRQ(dloc); dloc[0] = 0; for ( prow=0; prow 0) { idx = *xi++ + shift; if (*flev + incrlev > levels) { flev++; continue; } do { m = fm; fm = fill[m]; } while (fm < idx); if (fm != idx) { im[idx] = *flev + incrlev; fill[m] = idx; fill[idx] = fm; fm = idx; nzf++; } else { if (im[idx] > *flev + incrlev) im[idx] = *flev+incrlev; } flev++; } row = fill[row]; nzi++; } /* copy new filled row into permanent storage */ ainew[prow+1] = ainew[prow] + nzf; if (ainew[prow+1] > jmax+1) { /* allocate a longer ajnew */ int maxadd; maxadd = (int) ((f*(ai[n]+!shift)*(n-prow+5))/n); if (maxadd < nzf) maxadd = (n-prow)*(nzf+1); jmax += maxadd; xi = (int *) PETSCMALLOC( jmax*sizeof(int) );CHKPTRQ(xi); PetscMemcpy(xi,ajnew,(ainew[prow]+shift)*sizeof(int)); PETSCFREE(ajnew); ajnew = xi; /* allocate a longer ajfill */ xi = (int *) PETSCMALLOC( jmax*sizeof(int) );CHKPTRQ(xi); PetscMemcpy(xi,ajfill,(ainew[prow]+shift)*sizeof(int)); PETSCFREE(ajfill); ajfill = xi; realloc++; } xi = ajnew + ainew[prow] + shift; flev = ajfill + ainew[prow] + shift; dloc[prow] = nzi; fm = fill[n]; while (nzf--) { *xi++ = fm - shift; *flev++ = im[fm]; fm = fill[fm]; } } PETSCFREE(ajfill); ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr); ierr = ISRestoreIndices(isicol,&ic); CHKERRQ(ierr); ierr = ISDestroy(isicol); CHKERRQ(ierr); PETSCFREE(fill); PETSCFREE(im); PLogInfo((PetscObject)A, "Info:MatILUFactorSymbolic_SeqAIJ:Realloc %d Fill ratio:given %g needed %g\n", realloc,f,((double)ainew[n])/((double)ai[prow])); /* put together the new matrix */ ierr = MatCreateSeqAIJ(A->comm,n, n, 0, 0, fact); CHKERRQ(ierr); b = (Mat_SeqAIJ *) (*fact)->data; PETSCFREE(b->imax); b->singlemalloc = 0; len = (ainew[n] + shift)*sizeof(Scalar); /* the next line frees the default space generated by the Create() */ PETSCFREE(b->a); PETSCFREE(b->ilen); b->a = (Scalar *) PETSCMALLOC( len ); CHKPTRQ(b->a); b->j = ajnew; b->i = ainew; for ( i=0; idiag = dloc; b->ilen = 0; b->imax = 0; b->row = isrow; b->col = iscol; b->solve_work = (Scalar *) PETSCMALLOC( (n+1)*sizeof(Scalar)); CHKPTRQ(b->solve_work); /* In b structure: Free imax, ilen, old a, old j. Allocate dloc, solve_work, new a, new j */ PLogObjectMemory(*fact,(ainew[n]+shift-n) * (sizeof(int)+sizeof(Scalar))); b->maxnz = b->nz = ainew[n] + shift; (*fact)->factor = FACTOR_LU; return 0; }