Actual source code: aijfact.c

petsc-3.4.2 2013-07-02
  2: #include <../src/mat/impls/aij/seq/aij.h>
  3: #include <../src/mat/impls/sbaij/seq/sbaij.h>
  4: #include <petscbt.h>
  5: #include <../src/mat/utils/freespace.h>

  9: /*
 10:       Computes an ordering to get most of the large numerical values in the lower triangular part of the matrix

 12:       This code does not work and is not called anywhere. It would be registered with MatOrderingRegisterAll()
 13: */
 14: PetscErrorCode MatGetOrdering_Flow_SeqAIJ(Mat mat,MatOrderingType type,IS *irow,IS *icol)
 15: {
 16:   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)mat->data;
 17:   PetscErrorCode    ierr;
 18:   PetscInt          i,j,jj,k, kk,n = mat->rmap->n, current = 0, newcurrent = 0,*order;
 19:   const PetscInt    *ai = a->i, *aj = a->j;
 20:   const PetscScalar *aa = a->a;
 21:   PetscBool         *done;
 22:   PetscReal         best,past = 0,future;

 25:   /* pick initial row */
 26:   best = -1;
 27:   for (i=0; i<n; i++) {
 28:     future = 0.0;
 29:     for (j=ai[i]; j<ai[i+1]; j++) {
 30:       if (aj[j] != i) future += PetscAbsScalar(aa[j]);
 31:       else              past  = PetscAbsScalar(aa[j]);
 32:     }
 33:     if (!future) future = 1.e-10; /* if there is zero in the upper diagonal part want to rank this row high */
 34:     if (past/future > best) {
 35:       best    = past/future;
 36:       current = i;
 37:     }
 38:   }

 40:   PetscMalloc(n*sizeof(PetscBool),&done);
 41:   PetscMemzero(done,n*sizeof(PetscBool));
 42:   PetscMalloc(n*sizeof(PetscInt),&order);
 43:   order[0] = current;
 44:   for (i=0; i<n-1; i++) {
 45:     done[current] = PETSC_TRUE;
 46:     best          = -1;
 47:     /* loop over all neighbors of current pivot */
 48:     for (j=ai[current]; j<ai[current+1]; j++) {
 49:       jj = aj[j];
 50:       if (done[jj]) continue;
 51:       /* loop over columns of potential next row computing weights for below and above diagonal */
 52:       past = future = 0.0;
 53:       for (k=ai[jj]; k<ai[jj+1]; k++) {
 54:         kk = aj[k];
 55:         if (done[kk]) past += PetscAbsScalar(aa[k]);
 56:         else if (kk != jj) future += PetscAbsScalar(aa[k]);
 57:       }
 58:       if (!future) future = 1.e-10; /* if there is zero in the upper diagonal part want to rank this row high */
 59:       if (past/future > best) {
 60:         best       = past/future;
 61:         newcurrent = jj;
 62:       }
 63:     }
 64:     if (best == -1) { /* no neighbors to select from so select best of all that remain */
 65:       best = -1;
 66:       for (k=0; k<n; k++) {
 67:         if (done[k]) continue;
 68:         future = 0.0;
 69:         past   = 0.0;
 70:         for (j=ai[k]; j<ai[k+1]; j++) {
 71:           kk = aj[j];
 72:           if (done[kk])       past += PetscAbsScalar(aa[j]);
 73:           else if (kk != k) future += PetscAbsScalar(aa[j]);
 74:         }
 75:         if (!future) future = 1.e-10; /* if there is zero in the upper diagonal part want to rank this row high */
 76:         if (past/future > best) {
 77:           best       = past/future;
 78:           newcurrent = k;
 79:         }
 80:       }
 81:     }
 82:     if (current == newcurrent) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"newcurrent cannot be current");
 83:     current    = newcurrent;
 84:     order[i+1] = current;
 85:   }
 86:   ISCreateGeneral(PETSC_COMM_SELF,n,order,PETSC_COPY_VALUES,irow);
 87:   *icol = *irow;
 88:   PetscObjectReference((PetscObject)*irow);
 89:   PetscFree(done);
 90:   PetscFree(order);
 91:   return(0);
 92: }

 96: PetscErrorCode MatGetFactorAvailable_seqaij_petsc(Mat A,MatFactorType ftype,PetscBool  *flg)
 97: {
 99:   *flg = PETSC_TRUE;
100:   return(0);
101: }

105: PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_petsc(Mat A,MatFactorType ftype,Mat *B)
106: {
107:   PetscInt       n = A->rmap->n;

111: #if defined(PETSC_USE_COMPLEX)
112:   if (A->hermitian && (ftype == MAT_FACTOR_CHOLESKY || ftype == MAT_FACTOR_ICC)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Hermitian Factor is not supported");
113: #endif
114:   MatCreate(PetscObjectComm((PetscObject)A),B);
115:   MatSetSizes(*B,n,n,n,n);
116:   if (ftype == MAT_FACTOR_LU || ftype == MAT_FACTOR_ILU || ftype == MAT_FACTOR_ILUDT) {
117:     MatSetType(*B,MATSEQAIJ);

119:     (*B)->ops->ilufactorsymbolic = MatILUFactorSymbolic_SeqAIJ;
120:     (*B)->ops->lufactorsymbolic  = MatLUFactorSymbolic_SeqAIJ;

122:     MatSetBlockSizes(*B,A->rmap->bs,A->cmap->bs);
123:   } else if (ftype == MAT_FACTOR_CHOLESKY || ftype == MAT_FACTOR_ICC) {
124:     MatSetType(*B,MATSEQSBAIJ);
125:     MatSeqSBAIJSetPreallocation(*B,1,MAT_SKIP_ALLOCATION,NULL);

127:     (*B)->ops->iccfactorsymbolic      = MatICCFactorSymbolic_SeqAIJ;
128:     (*B)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqAIJ;
129:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Factor type not supported");
130:   (*B)->factortype = ftype;
131:   return(0);
132: }

136: PetscErrorCode MatLUFactorSymbolic_SeqAIJ_inplace(Mat B,Mat A,IS isrow,IS iscol,const MatFactorInfo *info)
137: {
138:   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data,*b;
139:   IS                 isicol;
140:   PetscErrorCode     ierr;
141:   const PetscInt     *r,*ic;
142:   PetscInt           i,n=A->rmap->n,*ai=a->i,*aj=a->j;
143:   PetscInt           *bi,*bj,*ajtmp;
144:   PetscInt           *bdiag,row,nnz,nzi,reallocs=0,nzbd,*im;
145:   PetscReal          f;
146:   PetscInt           nlnk,*lnk,k,**bi_ptr;
147:   PetscFreeSpaceList free_space=NULL,current_space=NULL;
148:   PetscBT            lnkbt;

151:   if (A->rmap->N != A->cmap->N) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"matrix must be square");
152:   ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);
153:   ISGetIndices(isrow,&r);
154:   ISGetIndices(isicol,&ic);

156:   /* get new row pointers */
157:   PetscMalloc((n+1)*sizeof(PetscInt),&bi);
158:   bi[0] = 0;

160:   /* bdiag is location of diagonal in factor */
161:   PetscMalloc((n+1)*sizeof(PetscInt),&bdiag);
162:   bdiag[0] = 0;

164:   /* linked list for storing column indices of the active row */
165:   nlnk = n + 1;
166:   PetscLLCreate(n,n,nlnk,lnk,lnkbt);

168:   PetscMalloc2(n+1,PetscInt**,&bi_ptr,n+1,PetscInt,&im);

170:   /* initial FreeSpace size is f*(ai[n]+1) */
171:   f             = info->fill;
172:   PetscFreeSpaceGet((PetscInt)(f*(ai[n]+1)),&free_space);
173:   current_space = free_space;

175:   for (i=0; i<n; i++) {
176:     /* copy previous fill into linked list */
177:     nzi = 0;
178:     nnz = ai[r[i]+1] - ai[r[i]];
179:     if (!nnz) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",r[i],i);
180:     ajtmp = aj + ai[r[i]];
181:     PetscLLAddPerm(nnz,ajtmp,ic,n,nlnk,lnk,lnkbt);
182:     nzi  += nlnk;

184:     /* add pivot rows into linked list */
185:     row = lnk[n];
186:     while (row < i) {
187:       nzbd  = bdiag[row] - bi[row] + 1;   /* num of entries in the row with column index <= row */
188:       ajtmp = bi_ptr[row] + nzbd;   /* points to the entry next to the diagonal */
189:       PetscLLAddSortedLU(ajtmp,row,nlnk,lnk,lnkbt,i,nzbd,im);
190:       nzi  += nlnk;
191:       row   = lnk[row];
192:     }
193:     bi[i+1] = bi[i] + nzi;
194:     im[i]   = nzi;

196:     /* mark bdiag */
197:     nzbd = 0;
198:     nnz  = nzi;
199:     k    = lnk[n];
200:     while (nnz-- && k < i) {
201:       nzbd++;
202:       k = lnk[k];
203:     }
204:     bdiag[i] = bi[i] + nzbd;

206:     /* if free space is not available, make more free space */
207:     if (current_space->local_remaining<nzi) {
208:       nnz  = (n - i)*nzi; /* estimated and max additional space needed */
209:       PetscFreeSpaceGet(nnz,&current_space);
210:       reallocs++;
211:     }

213:     /* copy data into free space, then initialize lnk */
214:     PetscLLClean(n,n,nzi,lnk,current_space->array,lnkbt);

216:     bi_ptr[i]                       = current_space->array;
217:     current_space->array           += nzi;
218:     current_space->local_used      += nzi;
219:     current_space->local_remaining -= nzi;
220:   }
221: #if defined(PETSC_USE_INFO)
222:   if (ai[n] != 0) {
223:     PetscReal af = ((PetscReal)bi[n])/((PetscReal)ai[n]);
224:     PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,f,af);
225:     PetscInfo1(A,"Run with -pc_factor_fill %G or use \n",af);
226:     PetscInfo1(A,"PCFactorSetFill(pc,%G);\n",af);
227:     PetscInfo(A,"for best performance.\n");
228:   } else {
229:     PetscInfo(A,"Empty matrix\n");
230:   }
231: #endif

233:   ISRestoreIndices(isrow,&r);
234:   ISRestoreIndices(isicol,&ic);

236:   /* destroy list of free space and other temporary array(s) */
237:   PetscMalloc((bi[n]+1)*sizeof(PetscInt),&bj);
238:   PetscFreeSpaceContiguous(&free_space,bj);
239:   PetscLLDestroy(lnk,lnkbt);
240:   PetscFree2(bi_ptr,im);

242:   /* put together the new matrix */
243:   MatSeqAIJSetPreallocation_SeqAIJ(B,MAT_SKIP_ALLOCATION,NULL);
244:   PetscLogObjectParent(B,isicol);
245:   b    = (Mat_SeqAIJ*)(B)->data;

247:   b->free_a       = PETSC_TRUE;
248:   b->free_ij      = PETSC_TRUE;
249:   b->singlemalloc = PETSC_FALSE;

251:   PetscMalloc((bi[n]+1)*sizeof(PetscScalar),&b->a);
252:   b->j    = bj;
253:   b->i    = bi;
254:   b->diag = bdiag;
255:   b->ilen = 0;
256:   b->imax = 0;
257:   b->row  = isrow;
258:   b->col  = iscol;
259:   PetscObjectReference((PetscObject)isrow);
260:   PetscObjectReference((PetscObject)iscol);
261:   b->icol = isicol;
262:   PetscMalloc((n+1)*sizeof(PetscScalar),&b->solve_work);

264:   /* In b structure:  Free imax, ilen, old a, old j.  Allocate solve_work, new a, new j */
265:   PetscLogObjectMemory(B,(bi[n]-n)*(sizeof(PetscInt)+sizeof(PetscScalar)));
266:   b->maxnz = b->nz = bi[n];

268:   (B)->factortype            = MAT_FACTOR_LU;
269:   (B)->info.factor_mallocs   = reallocs;
270:   (B)->info.fill_ratio_given = f;

272:   if (ai[n]) {
273:     (B)->info.fill_ratio_needed = ((PetscReal)bi[n])/((PetscReal)ai[n]);
274:   } else {
275:     (B)->info.fill_ratio_needed = 0.0;
276:   }
277:   (B)->ops->lufactornumeric = MatLUFactorNumeric_SeqAIJ_inplace;
278:   if (a->inode.size) {
279:     (B)->ops->lufactornumeric = MatLUFactorNumeric_SeqAIJ_Inode_inplace;
280:   }
281:   return(0);
282: }

286: PetscErrorCode MatLUFactorSymbolic_SeqAIJ(Mat B,Mat A,IS isrow,IS iscol,const MatFactorInfo *info)
287: {
288:   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data,*b;
289:   IS                 isicol;
290:   PetscErrorCode     ierr;
291:   const PetscInt     *r,*ic;
292:   PetscInt           i,n=A->rmap->n,*ai=a->i,*aj=a->j;
293:   PetscInt           *bi,*bj,*ajtmp;
294:   PetscInt           *bdiag,row,nnz,nzi,reallocs=0,nzbd,*im;
295:   PetscReal          f;
296:   PetscInt           nlnk,*lnk,k,**bi_ptr;
297:   PetscFreeSpaceList free_space=NULL,current_space=NULL;
298:   PetscBT            lnkbt;

301:   /* Uncomment the oldatastruct part only while testing new data structure for MatSolve() */
302:   /*
303:   PetscBool          olddatastruct=PETSC_FALSE;
304:   PetscOptionsGetBool(NULL,"-lu_old",&olddatastruct,NULL);
305:   if (olddatastruct) {
306:     MatLUFactorSymbolic_SeqAIJ_inplace(B,A,isrow,iscol,info);
307:     return(0);
308:   }
309:   */
310:   if (A->rmap->N != A->cmap->N) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"matrix must be square");
311:   ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);
312:   ISGetIndices(isrow,&r);
313:   ISGetIndices(isicol,&ic);

315:   /* get new row and diagonal pointers, must be allocated separately because they will be given to the Mat_SeqAIJ and freed separately */
316:   PetscMalloc((n+1)*sizeof(PetscInt),&bi);
317:   PetscMalloc((n+1)*sizeof(PetscInt),&bdiag);
318:   bi[0] = bdiag[0] = 0;

320:   /* linked list for storing column indices of the active row */
321:   nlnk = n + 1;
322:   PetscLLCreate(n,n,nlnk,lnk,lnkbt);

324:   PetscMalloc2(n+1,PetscInt**,&bi_ptr,n+1,PetscInt,&im);

326:   /* initial FreeSpace size is f*(ai[n]+1) */
327:   f             = info->fill;
328:   PetscFreeSpaceGet((PetscInt)(f*(ai[n]+1)),&free_space);
329:   current_space = free_space;

331:   for (i=0; i<n; i++) {
332:     /* copy previous fill into linked list */
333:     nzi = 0;
334:     nnz = ai[r[i]+1] - ai[r[i]];
335:     if (!nnz) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",r[i],i);
336:     ajtmp = aj + ai[r[i]];
337:     PetscLLAddPerm(nnz,ajtmp,ic,n,nlnk,lnk,lnkbt);
338:     nzi  += nlnk;

340:     /* add pivot rows into linked list */
341:     row = lnk[n];
342:     while (row < i) {
343:       nzbd  = bdiag[row] + 1; /* num of entries in the row with column index <= row */
344:       ajtmp = bi_ptr[row] + nzbd; /* points to the entry next to the diagonal */
345:       PetscLLAddSortedLU(ajtmp,row,nlnk,lnk,lnkbt,i,nzbd,im);
346:       nzi  += nlnk;
347:       row   = lnk[row];
348:     }
349:     bi[i+1] = bi[i] + nzi;
350:     im[i]   = nzi;

352:     /* mark bdiag */
353:     nzbd = 0;
354:     nnz  = nzi;
355:     k    = lnk[n];
356:     while (nnz-- && k < i) {
357:       nzbd++;
358:       k = lnk[k];
359:     }
360:     bdiag[i] = nzbd; /* note: bdiag[i] = nnzL as input for PetscFreeSpaceContiguous_LU() */

362:     /* if free space is not available, make more free space */
363:     if (current_space->local_remaining<nzi) {
364:       nnz  = 2*(n - i)*nzi; /* estimated and max additional space needed */
365:       PetscFreeSpaceGet(nnz,&current_space);
366:       reallocs++;
367:     }

369:     /* copy data into free space, then initialize lnk */
370:     PetscLLClean(n,n,nzi,lnk,current_space->array,lnkbt);

372:     bi_ptr[i]                       = current_space->array;
373:     current_space->array           += nzi;
374:     current_space->local_used      += nzi;
375:     current_space->local_remaining -= nzi;
376:   }

378:   ISRestoreIndices(isrow,&r);
379:   ISRestoreIndices(isicol,&ic);

381:   /*   copy free_space into bj and free free_space; set bi, bj, bdiag in new datastructure; */
382:   PetscMalloc((bi[n]+1)*sizeof(PetscInt),&bj);
383:   PetscFreeSpaceContiguous_LU(&free_space,bj,n,bi,bdiag);
384:   PetscLLDestroy(lnk,lnkbt);
385:   PetscFree2(bi_ptr,im);

387:   /* put together the new matrix */
388:   MatSeqAIJSetPreallocation_SeqAIJ(B,MAT_SKIP_ALLOCATION,NULL);
389:   PetscLogObjectParent(B,isicol);
390:   b    = (Mat_SeqAIJ*)(B)->data;

392:   b->free_a       = PETSC_TRUE;
393:   b->free_ij      = PETSC_TRUE;
394:   b->singlemalloc = PETSC_FALSE;

396:   PetscMalloc((bdiag[0]+1)*sizeof(PetscScalar),&b->a);

398:   b->j    = bj;
399:   b->i    = bi;
400:   b->diag = bdiag;
401:   b->ilen = 0;
402:   b->imax = 0;
403:   b->row  = isrow;
404:   b->col  = iscol;
405:   PetscObjectReference((PetscObject)isrow);
406:   PetscObjectReference((PetscObject)iscol);
407:   b->icol = isicol;
408:   PetscMalloc((n+1)*sizeof(PetscScalar),&b->solve_work);

410:   /* In b structure:  Free imax, ilen, old a, old j.  Allocate solve_work, new a, new j */
411:   PetscLogObjectMemory(B,(bdiag[0]+1)*(sizeof(PetscInt)+sizeof(PetscScalar)));
412:   b->maxnz = b->nz = bdiag[0]+1;

414:   B->factortype            = MAT_FACTOR_LU;
415:   B->info.factor_mallocs   = reallocs;
416:   B->info.fill_ratio_given = f;

418:   if (ai[n]) {
419:     B->info.fill_ratio_needed = ((PetscReal)(bdiag[0]+1))/((PetscReal)ai[n]);
420:   } else {
421:     B->info.fill_ratio_needed = 0.0;
422:   }
423: #if defined(PETSC_USE_INFO)
424:   if (ai[n] != 0) {
425:     PetscReal af = B->info.fill_ratio_needed;
426:     PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,f,af);
427:     PetscInfo1(A,"Run with -pc_factor_fill %G or use \n",af);
428:     PetscInfo1(A,"PCFactorSetFill(pc,%G);\n",af);
429:     PetscInfo(A,"for best performance.\n");
430:   } else {
431:     PetscInfo(A,"Empty matrix\n");
432:   }
433: #endif
434:   B->ops->lufactornumeric = MatLUFactorNumeric_SeqAIJ;
435:   if (a->inode.size) {
436:     B->ops->lufactornumeric = MatLUFactorNumeric_SeqAIJ_Inode;
437:   }
438:   return(0);
439: }

441: /*
442:     Trouble in factorization, should we dump the original matrix?
443: */
446: PetscErrorCode MatFactorDumpMatrix(Mat A)
447: {
449:   PetscBool      flg = PETSC_FALSE;

452:   PetscOptionsGetBool(NULL,"-mat_factor_dump_on_error",&flg,NULL);
453:   if (flg) {
454:     PetscViewer viewer;
455:     char        filename[PETSC_MAX_PATH_LEN];

457:     PetscSNPrintf(filename,PETSC_MAX_PATH_LEN,"matrix_factor_error.%d",PetscGlobalRank);
458:     PetscViewerBinaryOpen(PetscObjectComm((PetscObject)A),filename,FILE_MODE_WRITE,&viewer);
459:     MatView(A,viewer);
460:     PetscViewerDestroy(&viewer);
461:   }
462:   return(0);
463: }

467: PetscErrorCode MatLUFactorNumeric_SeqAIJ(Mat B,Mat A,const MatFactorInfo *info)
468: {
469:   Mat             C     =B;
470:   Mat_SeqAIJ      *a    =(Mat_SeqAIJ*)A->data,*b=(Mat_SeqAIJ*)C->data;
471:   IS              isrow = b->row,isicol = b->icol;
472:   PetscErrorCode  ierr;
473:   const PetscInt  *r,*ic,*ics;
474:   const PetscInt  n=A->rmap->n,*ai=a->i,*aj=a->j,*bi=b->i,*bj=b->j,*bdiag=b->diag;
475:   PetscInt        i,j,k,nz,nzL,row,*pj;
476:   const PetscInt  *ajtmp,*bjtmp;
477:   MatScalar       *rtmp,*pc,multiplier,*pv;
478:   const MatScalar *aa=a->a,*v;
479:   PetscBool       row_identity,col_identity;
480:   FactorShiftCtx  sctx;
481:   const PetscInt  *ddiag;
482:   PetscReal       rs;
483:   MatScalar       d;

486:   /* MatPivotSetUp(): initialize shift context sctx */
487:   PetscMemzero(&sctx,sizeof(FactorShiftCtx));

489:   if (info->shifttype == (PetscReal) MAT_SHIFT_POSITIVE_DEFINITE) { /* set sctx.shift_top=max{rs} */
490:     ddiag          = a->diag;
491:     sctx.shift_top = info->zeropivot;
492:     for (i=0; i<n; i++) {
493:       /* calculate sum(|aij|)-RealPart(aii), amt of shift needed for this row */
494:       d  = (aa)[ddiag[i]];
495:       rs = -PetscAbsScalar(d) - PetscRealPart(d);
496:       v  = aa+ai[i];
497:       nz = ai[i+1] - ai[i];
498:       for (j=0; j<nz; j++) rs += PetscAbsScalar(v[j]);
499:       if (rs>sctx.shift_top) sctx.shift_top = rs;
500:     }
501:     sctx.shift_top *= 1.1;
502:     sctx.nshift_max = 5;
503:     sctx.shift_lo   = 0.;
504:     sctx.shift_hi   = 1.;
505:   }

507:   ISGetIndices(isrow,&r);
508:   ISGetIndices(isicol,&ic);
509:   PetscMalloc((n+1)*sizeof(MatScalar),&rtmp);
510:   ics  = ic;

512:   do {
513:     sctx.newshift = PETSC_FALSE;
514:     for (i=0; i<n; i++) {
515:       /* zero rtmp */
516:       /* L part */
517:       nz    = bi[i+1] - bi[i];
518:       bjtmp = bj + bi[i];
519:       for  (j=0; j<nz; j++) rtmp[bjtmp[j]] = 0.0;

521:       /* U part */
522:       nz    = bdiag[i]-bdiag[i+1];
523:       bjtmp = bj + bdiag[i+1]+1;
524:       for  (j=0; j<nz; j++) rtmp[bjtmp[j]] = 0.0;

526:       /* load in initial (unfactored row) */
527:       nz    = ai[r[i]+1] - ai[r[i]];
528:       ajtmp = aj + ai[r[i]];
529:       v     = aa + ai[r[i]];
530:       for (j=0; j<nz; j++) {
531:         rtmp[ics[ajtmp[j]]] = v[j];
532:       }
533:       /* ZeropivotApply() */
534:       rtmp[i] += sctx.shift_amount;  /* shift the diagonal of the matrix */

536:       /* elimination */
537:       bjtmp = bj + bi[i];
538:       row   = *bjtmp++;
539:       nzL   = bi[i+1] - bi[i];
540:       for (k=0; k < nzL; k++) {
541:         pc = rtmp + row;
542:         if (*pc != 0.0) {
543:           pv         = b->a + bdiag[row];
544:           multiplier = *pc * (*pv);
545:           *pc        = multiplier;

547:           pj = b->j + bdiag[row+1]+1; /* beginning of U(row,:) */
548:           pv = b->a + bdiag[row+1]+1;
549:           nz = bdiag[row]-bdiag[row+1]-1; /* num of entries in U(row,:) excluding diag */

551:           for (j=0; j<nz; j++) rtmp[pj[j]] -= multiplier * pv[j];
552:           PetscLogFlops(1+2*nz);
553:         }
554:         row = *bjtmp++;
555:       }

557:       /* finished row so stick it into b->a */
558:       rs = 0.0;
559:       /* L part */
560:       pv = b->a + bi[i];
561:       pj = b->j + bi[i];
562:       nz = bi[i+1] - bi[i];
563:       for (j=0; j<nz; j++) {
564:         pv[j] = rtmp[pj[j]]; rs += PetscAbsScalar(pv[j]);
565:       }

567:       /* U part */
568:       pv = b->a + bdiag[i+1]+1;
569:       pj = b->j + bdiag[i+1]+1;
570:       nz = bdiag[i] - bdiag[i+1]-1;
571:       for (j=0; j<nz; j++) {
572:         pv[j] = rtmp[pj[j]]; rs += PetscAbsScalar(pv[j]);
573:       }

575:       sctx.rs = rs;
576:       sctx.pv = rtmp[i];
577:       MatPivotCheck(A,info,&sctx,i);
578:       if (sctx.newshift) break; /* break for-loop */
579:       rtmp[i] = sctx.pv; /* sctx.pv might be updated in the case of MAT_SHIFT_INBLOCKS */

581:       /* Mark diagonal and invert diagonal for simplier triangular solves */
582:       pv  = b->a + bdiag[i];
583:       *pv = 1.0/rtmp[i];

585:     } /* endof for (i=0; i<n; i++) { */

587:     /* MatPivotRefine() */
588:     if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE && !sctx.newshift && sctx.shift_fraction>0 && sctx.nshift<sctx.nshift_max) {
589:       /*
590:        * if no shift in this attempt & shifting & started shifting & can refine,
591:        * then try lower shift
592:        */
593:       sctx.shift_hi       = sctx.shift_fraction;
594:       sctx.shift_fraction = (sctx.shift_hi+sctx.shift_lo)/2.;
595:       sctx.shift_amount   = sctx.shift_fraction * sctx.shift_top;
596:       sctx.newshift       = PETSC_TRUE;
597:       sctx.nshift++;
598:     }
599:   } while (sctx.newshift);

601:   PetscFree(rtmp);
602:   ISRestoreIndices(isicol,&ic);
603:   ISRestoreIndices(isrow,&r);

605:   ISIdentity(isrow,&row_identity);
606:   ISIdentity(isicol,&col_identity);
607:   if (row_identity && col_identity) {
608:     C->ops->solve = MatSolve_SeqAIJ_NaturalOrdering;
609:   } else {
610:     C->ops->solve = MatSolve_SeqAIJ;
611:   }
612:   C->ops->solveadd          = MatSolveAdd_SeqAIJ;
613:   C->ops->solvetranspose    = MatSolveTranspose_SeqAIJ;
614:   C->ops->solvetransposeadd = MatSolveTransposeAdd_SeqAIJ;
615:   C->ops->matsolve          = MatMatSolve_SeqAIJ;
616:   C->assembled              = PETSC_TRUE;
617:   C->preallocated           = PETSC_TRUE;

619:   PetscLogFlops(C->cmap->n);

621:   /* MatShiftView(A,info,&sctx) */
622:   if (sctx.nshift) {
623:     if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) {
624:       PetscInfo4(A,"number of shift_pd tries %D, shift_amount %G, diagonal shifted up by %e fraction top_value %e\n",sctx.nshift,sctx.shift_amount,sctx.shift_fraction,sctx.shift_top);
625:     } else if (info->shifttype == (PetscReal)MAT_SHIFT_NONZERO) {
626:       PetscInfo2(A,"number of shift_nz tries %D, shift_amount %G\n",sctx.nshift,sctx.shift_amount);
627:     } else if (info->shifttype == (PetscReal)MAT_SHIFT_INBLOCKS) {
628:       PetscInfo2(A,"number of shift_inblocks applied %D, each shift_amount %G\n",sctx.nshift,info->shiftamount);
629:     }
630:   }
631:   Mat_CheckInode_FactorLU(C,PETSC_FALSE);
632:   return(0);
633: }

637: PetscErrorCode MatLUFactorNumeric_SeqAIJ_inplace(Mat B,Mat A,const MatFactorInfo *info)
638: {
639:   Mat             C     =B;
640:   Mat_SeqAIJ      *a    =(Mat_SeqAIJ*)A->data,*b=(Mat_SeqAIJ*)C->data;
641:   IS              isrow = b->row,isicol = b->icol;
642:   PetscErrorCode  ierr;
643:   const PetscInt  *r,*ic,*ics;
644:   PetscInt        nz,row,i,j,n=A->rmap->n,diag;
645:   const PetscInt  *ai=a->i,*aj=a->j,*bi=b->i,*bj=b->j;
646:   const PetscInt  *ajtmp,*bjtmp,*diag_offset = b->diag,*pj;
647:   MatScalar       *pv,*rtmp,*pc,multiplier,d;
648:   const MatScalar *v,*aa=a->a;
649:   PetscReal       rs=0.0;
650:   FactorShiftCtx  sctx;
651:   const PetscInt  *ddiag;
652:   PetscBool       row_identity, col_identity;

655:   /* MatPivotSetUp(): initialize shift context sctx */
656:   PetscMemzero(&sctx,sizeof(FactorShiftCtx));

658:   if (info->shifttype == (PetscReal) MAT_SHIFT_POSITIVE_DEFINITE) { /* set sctx.shift_top=max{rs} */
659:     ddiag          = a->diag;
660:     sctx.shift_top = info->zeropivot;
661:     for (i=0; i<n; i++) {
662:       /* calculate sum(|aij|)-RealPart(aii), amt of shift needed for this row */
663:       d  = (aa)[ddiag[i]];
664:       rs = -PetscAbsScalar(d) - PetscRealPart(d);
665:       v  = aa+ai[i];
666:       nz = ai[i+1] - ai[i];
667:       for (j=0; j<nz; j++) rs += PetscAbsScalar(v[j]);
668:       if (rs>sctx.shift_top) sctx.shift_top = rs;
669:     }
670:     sctx.shift_top *= 1.1;
671:     sctx.nshift_max = 5;
672:     sctx.shift_lo   = 0.;
673:     sctx.shift_hi   = 1.;
674:   }

676:   ISGetIndices(isrow,&r);
677:   ISGetIndices(isicol,&ic);
678:   PetscMalloc((n+1)*sizeof(MatScalar),&rtmp);
679:   ics  = ic;

681:   do {
682:     sctx.newshift = PETSC_FALSE;
683:     for (i=0; i<n; i++) {
684:       nz    = bi[i+1] - bi[i];
685:       bjtmp = bj + bi[i];
686:       for  (j=0; j<nz; j++) rtmp[bjtmp[j]] = 0.0;

688:       /* load in initial (unfactored row) */
689:       nz    = ai[r[i]+1] - ai[r[i]];
690:       ajtmp = aj + ai[r[i]];
691:       v     = aa + ai[r[i]];
692:       for (j=0; j<nz; j++) {
693:         rtmp[ics[ajtmp[j]]] = v[j];
694:       }
695:       rtmp[ics[r[i]]] += sctx.shift_amount; /* shift the diagonal of the matrix */

697:       row = *bjtmp++;
698:       while  (row < i) {
699:         pc = rtmp + row;
700:         if (*pc != 0.0) {
701:           pv         = b->a + diag_offset[row];
702:           pj         = b->j + diag_offset[row] + 1;
703:           multiplier = *pc / *pv++;
704:           *pc        = multiplier;
705:           nz         = bi[row+1] - diag_offset[row] - 1;
706:           for (j=0; j<nz; j++) rtmp[pj[j]] -= multiplier * pv[j];
707:           PetscLogFlops(1+2*nz);
708:         }
709:         row = *bjtmp++;
710:       }
711:       /* finished row so stick it into b->a */
712:       pv   = b->a + bi[i];
713:       pj   = b->j + bi[i];
714:       nz   = bi[i+1] - bi[i];
715:       diag = diag_offset[i] - bi[i];
716:       rs   = 0.0;
717:       for (j=0; j<nz; j++) {
718:         pv[j] = rtmp[pj[j]];
719:         rs   += PetscAbsScalar(pv[j]);
720:       }
721:       rs -= PetscAbsScalar(pv[diag]);

723:       sctx.rs = rs;
724:       sctx.pv = pv[diag];
725:       MatPivotCheck(A,info,&sctx,i);
726:       if (sctx.newshift) break;
727:       pv[diag] = sctx.pv;
728:     }

730:     if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE && !sctx.newshift && sctx.shift_fraction>0 && sctx.nshift<sctx.nshift_max) {
731:       /*
732:        * if no shift in this attempt & shifting & started shifting & can refine,
733:        * then try lower shift
734:        */
735:       sctx.shift_hi       = sctx.shift_fraction;
736:       sctx.shift_fraction = (sctx.shift_hi+sctx.shift_lo)/2.;
737:       sctx.shift_amount   = sctx.shift_fraction * sctx.shift_top;
738:       sctx.newshift       = PETSC_TRUE;
739:       sctx.nshift++;
740:     }
741:   } while (sctx.newshift);

743:   /* invert diagonal entries for simplier triangular solves */
744:   for (i=0; i<n; i++) {
745:     b->a[diag_offset[i]] = 1.0/b->a[diag_offset[i]];
746:   }
747:   PetscFree(rtmp);
748:   ISRestoreIndices(isicol,&ic);
749:   ISRestoreIndices(isrow,&r);

751:   ISIdentity(isrow,&row_identity);
752:   ISIdentity(isicol,&col_identity);
753:   if (row_identity && col_identity) {
754:     C->ops->solve = MatSolve_SeqAIJ_NaturalOrdering_inplace;
755:   } else {
756:     C->ops->solve = MatSolve_SeqAIJ_inplace;
757:   }
758:   C->ops->solveadd          = MatSolveAdd_SeqAIJ_inplace;
759:   C->ops->solvetranspose    = MatSolveTranspose_SeqAIJ_inplace;
760:   C->ops->solvetransposeadd = MatSolveTransposeAdd_SeqAIJ_inplace;
761:   C->ops->matsolve          = MatMatSolve_SeqAIJ_inplace;

763:   C->assembled    = PETSC_TRUE;
764:   C->preallocated = PETSC_TRUE;

766:   PetscLogFlops(C->cmap->n);
767:   if (sctx.nshift) {
768:     if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) {
769:       PetscInfo4(A,"number of shift_pd tries %D, shift_amount %G, diagonal shifted up by %e fraction top_value %e\n",sctx.nshift,sctx.shift_amount,sctx.shift_fraction,sctx.shift_top);
770:     } else if (info->shifttype == (PetscReal)MAT_SHIFT_NONZERO) {
771:       PetscInfo2(A,"number of shift_nz tries %D, shift_amount %G\n",sctx.nshift,sctx.shift_amount);
772:     }
773:   }
774:   (C)->ops->solve          = MatSolve_SeqAIJ_inplace;
775:   (C)->ops->solvetranspose = MatSolveTranspose_SeqAIJ_inplace;

777:   Mat_CheckInode(C,PETSC_FALSE);
778:   return(0);
779: }

781: /*
782:    This routine implements inplace ILU(0) with row or/and column permutations.
783:    Input:
784:      A - original matrix
785:    Output;
786:      A - a->i (rowptr) is same as original rowptr, but factored i-the row is stored in rowperm[i]
787:          a->j (col index) is permuted by the inverse of colperm, then sorted
788:          a->a reordered accordingly with a->j
789:          a->diag (ptr to diagonal elements) is updated.
790: */
793: PetscErrorCode MatLUFactorNumeric_SeqAIJ_InplaceWithPerm(Mat B,Mat A,const MatFactorInfo *info)
794: {
795:   Mat_SeqAIJ      *a    =(Mat_SeqAIJ*)A->data;
796:   IS              isrow = a->row,isicol = a->icol;
797:   PetscErrorCode  ierr;
798:   const PetscInt  *r,*ic,*ics;
799:   PetscInt        i,j,n=A->rmap->n,*ai=a->i,*aj=a->j;
800:   PetscInt        *ajtmp,nz,row;
801:   PetscInt        *diag = a->diag,nbdiag,*pj;
802:   PetscScalar     *rtmp,*pc,multiplier,d;
803:   MatScalar       *pv,*v;
804:   PetscReal       rs;
805:   FactorShiftCtx  sctx;
806:   const MatScalar *aa=a->a,*vtmp;

809:   if (A != B) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"input and output matrix must have same address");

811:   /* MatPivotSetUp(): initialize shift context sctx */
812:   PetscMemzero(&sctx,sizeof(FactorShiftCtx));

814:   if (info->shifttype == (PetscReal) MAT_SHIFT_POSITIVE_DEFINITE) { /* set sctx.shift_top=max{rs} */
815:     const PetscInt *ddiag = a->diag;
816:     sctx.shift_top = info->zeropivot;
817:     for (i=0; i<n; i++) {
818:       /* calculate sum(|aij|)-RealPart(aii), amt of shift needed for this row */
819:       d    = (aa)[ddiag[i]];
820:       rs   = -PetscAbsScalar(d) - PetscRealPart(d);
821:       vtmp = aa+ai[i];
822:       nz   = ai[i+1] - ai[i];
823:       for (j=0; j<nz; j++) rs += PetscAbsScalar(vtmp[j]);
824:       if (rs>sctx.shift_top) sctx.shift_top = rs;
825:     }
826:     sctx.shift_top *= 1.1;
827:     sctx.nshift_max = 5;
828:     sctx.shift_lo   = 0.;
829:     sctx.shift_hi   = 1.;
830:   }

832:   ISGetIndices(isrow,&r);
833:   ISGetIndices(isicol,&ic);
834:   PetscMalloc((n+1)*sizeof(PetscScalar),&rtmp);
835:   PetscMemzero(rtmp,(n+1)*sizeof(PetscScalar));
836:   ics  = ic;

838: #if defined(MV)
839:   sctx.shift_top      = 0.;
840:   sctx.nshift_max     = 0;
841:   sctx.shift_lo       = 0.;
842:   sctx.shift_hi       = 0.;
843:   sctx.shift_fraction = 0.;

845:   if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) { /* set sctx.shift_top=max{rs} */
846:     sctx.shift_top = 0.;
847:     for (i=0; i<n; i++) {
848:       /* calculate sum(|aij|)-RealPart(aii), amt of shift needed for this row */
849:       d  = (a->a)[diag[i]];
850:       rs = -PetscAbsScalar(d) - PetscRealPart(d);
851:       v  = a->a+ai[i];
852:       nz = ai[i+1] - ai[i];
853:       for (j=0; j<nz; j++) rs += PetscAbsScalar(v[j]);
854:       if (rs>sctx.shift_top) sctx.shift_top = rs;
855:     }
856:     if (sctx.shift_top < info->zeropivot) sctx.shift_top = info->zeropivot;
857:     sctx.shift_top *= 1.1;
858:     sctx.nshift_max = 5;
859:     sctx.shift_lo   = 0.;
860:     sctx.shift_hi   = 1.;
861:   }

863:   sctx.shift_amount = 0.;
864:   sctx.nshift       = 0;
865: #endif

867:   do {
868:     sctx.newshift = PETSC_FALSE;
869:     for (i=0; i<n; i++) {
870:       /* load in initial unfactored row */
871:       nz    = ai[r[i]+1] - ai[r[i]];
872:       ajtmp = aj + ai[r[i]];
873:       v     = a->a + ai[r[i]];
874:       /* sort permuted ajtmp and values v accordingly */
875:       for (j=0; j<nz; j++) ajtmp[j] = ics[ajtmp[j]];
876:       PetscSortIntWithScalarArray(nz,ajtmp,v);

878:       diag[r[i]] = ai[r[i]];
879:       for (j=0; j<nz; j++) {
880:         rtmp[ajtmp[j]] = v[j];
881:         if (ajtmp[j] < i) diag[r[i]]++; /* update a->diag */
882:       }
883:       rtmp[r[i]] += sctx.shift_amount; /* shift the diagonal of the matrix */

885:       row = *ajtmp++;
886:       while  (row < i) {
887:         pc = rtmp + row;
888:         if (*pc != 0.0) {
889:           pv = a->a + diag[r[row]];
890:           pj = aj + diag[r[row]] + 1;

892:           multiplier = *pc / *pv++;
893:           *pc        = multiplier;
894:           nz         = ai[r[row]+1] - diag[r[row]] - 1;
895:           for (j=0; j<nz; j++) rtmp[pj[j]] -= multiplier * pv[j];
896:           PetscLogFlops(1+2*nz);
897:         }
898:         row = *ajtmp++;
899:       }
900:       /* finished row so overwrite it onto a->a */
901:       pv     = a->a + ai[r[i]];
902:       pj     = aj + ai[r[i]];
903:       nz     = ai[r[i]+1] - ai[r[i]];
904:       nbdiag = diag[r[i]] - ai[r[i]]; /* num of entries before the diagonal */

906:       rs = 0.0;
907:       for (j=0; j<nz; j++) {
908:         pv[j] = rtmp[pj[j]];
909:         if (j != nbdiag) rs += PetscAbsScalar(pv[j]);
910:       }

912:       sctx.rs = rs;
913:       sctx.pv = pv[nbdiag];
914:       MatPivotCheck(A,info,&sctx,i);
915:       if (sctx.newshift) break;
916:       pv[nbdiag] = sctx.pv;
917:     }

919:     if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE && !sctx.newshift && sctx.shift_fraction>0 && sctx.nshift<sctx.nshift_max) {
920:       /*
921:        * if no shift in this attempt & shifting & started shifting & can refine,
922:        * then try lower shift
923:        */
924:       sctx.shift_hi       = sctx.shift_fraction;
925:       sctx.shift_fraction = (sctx.shift_hi+sctx.shift_lo)/2.;
926:       sctx.shift_amount   = sctx.shift_fraction * sctx.shift_top;
927:       sctx.newshift       = PETSC_TRUE;
928:       sctx.nshift++;
929:     }
930:   } while (sctx.newshift);

932:   /* invert diagonal entries for simplier triangular solves */
933:   for (i=0; i<n; i++) {
934:     a->a[diag[r[i]]] = 1.0/a->a[diag[r[i]]];
935:   }

937:   PetscFree(rtmp);
938:   ISRestoreIndices(isicol,&ic);
939:   ISRestoreIndices(isrow,&r);

941:   A->ops->solve             = MatSolve_SeqAIJ_InplaceWithPerm;
942:   A->ops->solveadd          = MatSolveAdd_SeqAIJ_inplace;
943:   A->ops->solvetranspose    = MatSolveTranspose_SeqAIJ_inplace;
944:   A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqAIJ_inplace;

946:   A->assembled    = PETSC_TRUE;
947:   A->preallocated = PETSC_TRUE;

949:   PetscLogFlops(A->cmap->n);
950:   if (sctx.nshift) {
951:     if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) {
952:       PetscInfo4(A,"number of shift_pd tries %D, shift_amount %G, diagonal shifted up by %e fraction top_value %e\n",sctx.nshift,sctx.shift_amount,sctx.shift_fraction,sctx.shift_top);
953:     } else if (info->shifttype == (PetscReal)MAT_SHIFT_NONZERO) {
954:       PetscInfo2(A,"number of shift_nz tries %D, shift_amount %G\n",sctx.nshift,sctx.shift_amount);
955:     }
956:   }
957:   return(0);
958: }

960: /* ----------------------------------------------------------- */
963: PetscErrorCode MatLUFactor_SeqAIJ(Mat A,IS row,IS col,const MatFactorInfo *info)
964: {
966:   Mat            C;

969:   MatGetFactor(A,MATSOLVERPETSC,MAT_FACTOR_LU,&C);
970:   MatLUFactorSymbolic(C,A,row,col,info);
971:   MatLUFactorNumeric(C,A,info);

973:   A->ops->solve          = C->ops->solve;
974:   A->ops->solvetranspose = C->ops->solvetranspose;

976:   MatHeaderMerge(A,C);
977:   PetscLogObjectParent(A,((Mat_SeqAIJ*)(A->data))->icol);
978:   return(0);
979: }
980: /* ----------------------------------------------------------- */


985: PetscErrorCode MatSolve_SeqAIJ_inplace(Mat A,Vec bb,Vec xx)
986: {
987:   Mat_SeqAIJ        *a    = (Mat_SeqAIJ*)A->data;
988:   IS                iscol = a->col,isrow = a->row;
989:   PetscErrorCode    ierr;
990:   PetscInt          i, n = A->rmap->n,*vi,*ai = a->i,*aj = a->j;
991:   PetscInt          nz;
992:   const PetscInt    *rout,*cout,*r,*c;
993:   PetscScalar       *x,*tmp,*tmps,sum;
994:   const PetscScalar *b;
995:   const MatScalar   *aa = a->a,*v;

998:   if (!n) return(0);

1000:   VecGetArrayRead(bb,&b);
1001:   VecGetArray(xx,&x);
1002:   tmp  = a->solve_work;

1004:   ISGetIndices(isrow,&rout); r = rout;
1005:   ISGetIndices(iscol,&cout); c = cout + (n-1);

1007:   /* forward solve the lower triangular */
1008:   tmp[0] = b[*r++];
1009:   tmps   = tmp;
1010:   for (i=1; i<n; i++) {
1011:     v   = aa + ai[i];
1012:     vi  = aj + ai[i];
1013:     nz  = a->diag[i] - ai[i];
1014:     sum = b[*r++];
1015:     PetscSparseDenseMinusDot(sum,tmps,v,vi,nz);
1016:     tmp[i] = sum;
1017:   }

1019:   /* backward solve the upper triangular */
1020:   for (i=n-1; i>=0; i--) {
1021:     v   = aa + a->diag[i] + 1;
1022:     vi  = aj + a->diag[i] + 1;
1023:     nz  = ai[i+1] - a->diag[i] - 1;
1024:     sum = tmp[i];
1025:     PetscSparseDenseMinusDot(sum,tmps,v,vi,nz);
1026:     x[*c--] = tmp[i] = sum*aa[a->diag[i]];
1027:   }

1029:   ISRestoreIndices(isrow,&rout);
1030:   ISRestoreIndices(iscol,&cout);
1031:   VecRestoreArrayRead(bb,&b);
1032:   VecRestoreArray(xx,&x);
1033:   PetscLogFlops(2.0*a->nz - A->cmap->n);
1034:   return(0);
1035: }

1039: PetscErrorCode MatMatSolve_SeqAIJ_inplace(Mat A,Mat B,Mat X)
1040: {
1041:   Mat_SeqAIJ      *a    = (Mat_SeqAIJ*)A->data;
1042:   IS              iscol = a->col,isrow = a->row;
1043:   PetscErrorCode  ierr;
1044:   PetscInt        i, n = A->rmap->n,*vi,*ai = a->i,*aj = a->j;
1045:   PetscInt        nz,neq;
1046:   const PetscInt  *rout,*cout,*r,*c;
1047:   PetscScalar     *x,*b,*tmp,*tmps,sum;
1048:   const MatScalar *aa = a->a,*v;
1049:   PetscBool       bisdense,xisdense;

1052:   if (!n) return(0);

1054:   PetscObjectTypeCompare((PetscObject)B,MATSEQDENSE,&bisdense);
1055:   if (!bisdense) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"B matrix must be a SeqDense matrix");
1056:   PetscObjectTypeCompare((PetscObject)X,MATSEQDENSE,&xisdense);
1057:   if (!xisdense) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"X matrix must be a SeqDense matrix");

1059:   MatDenseGetArray(B,&b);
1060:   MatDenseGetArray(X,&x);

1062:   tmp  = a->solve_work;
1063:   ISGetIndices(isrow,&rout); r = rout;
1064:   ISGetIndices(iscol,&cout); c = cout;

1066:   for (neq=0; neq<B->cmap->n; neq++) {
1067:     /* forward solve the lower triangular */
1068:     tmp[0] = b[r[0]];
1069:     tmps   = tmp;
1070:     for (i=1; i<n; i++) {
1071:       v   = aa + ai[i];
1072:       vi  = aj + ai[i];
1073:       nz  = a->diag[i] - ai[i];
1074:       sum = b[r[i]];
1075:       PetscSparseDenseMinusDot(sum,tmps,v,vi,nz);
1076:       tmp[i] = sum;
1077:     }
1078:     /* backward solve the upper triangular */
1079:     for (i=n-1; i>=0; i--) {
1080:       v   = aa + a->diag[i] + 1;
1081:       vi  = aj + a->diag[i] + 1;
1082:       nz  = ai[i+1] - a->diag[i] - 1;
1083:       sum = tmp[i];
1084:       PetscSparseDenseMinusDot(sum,tmps,v,vi,nz);
1085:       x[c[i]] = tmp[i] = sum*aa[a->diag[i]];
1086:     }

1088:     b += n;
1089:     x += n;
1090:   }
1091:   ISRestoreIndices(isrow,&rout);
1092:   ISRestoreIndices(iscol,&cout);
1093:   MatDenseRestoreArray(B,&b);
1094:   MatDenseRestoreArray(X,&x);
1095:   PetscLogFlops(B->cmap->n*(2.0*a->nz - n));
1096:   return(0);
1097: }

1101: PetscErrorCode MatMatSolve_SeqAIJ(Mat A,Mat B,Mat X)
1102: {
1103:   Mat_SeqAIJ      *a    = (Mat_SeqAIJ*)A->data;
1104:   IS              iscol = a->col,isrow = a->row;
1105:   PetscErrorCode  ierr;
1106:   PetscInt        i, n = A->rmap->n,*vi,*ai = a->i,*aj = a->j,*adiag = a->diag;
1107:   PetscInt        nz,neq;
1108:   const PetscInt  *rout,*cout,*r,*c;
1109:   PetscScalar     *x,*b,*tmp,sum;
1110:   const MatScalar *aa = a->a,*v;
1111:   PetscBool       bisdense,xisdense;

1114:   if (!n) return(0);

1116:   PetscObjectTypeCompare((PetscObject)B,MATSEQDENSE,&bisdense);
1117:   if (!bisdense) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"B matrix must be a SeqDense matrix");
1118:   PetscObjectTypeCompare((PetscObject)X,MATSEQDENSE,&xisdense);
1119:   if (!xisdense) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"X matrix must be a SeqDense matrix");

1121:   MatDenseGetArray(B,&b);
1122:   MatDenseGetArray(X,&x);

1124:   tmp  = a->solve_work;
1125:   ISGetIndices(isrow,&rout); r = rout;
1126:   ISGetIndices(iscol,&cout); c = cout;

1128:   for (neq=0; neq<B->cmap->n; neq++) {
1129:     /* forward solve the lower triangular */
1130:     tmp[0] = b[r[0]];
1131:     v      = aa;
1132:     vi     = aj;
1133:     for (i=1; i<n; i++) {
1134:       nz  = ai[i+1] - ai[i];
1135:       sum = b[r[i]];
1136:       PetscSparseDenseMinusDot(sum,tmp,v,vi,nz);
1137:       tmp[i] = sum;
1138:       v     += nz; vi += nz;
1139:     }

1141:     /* backward solve the upper triangular */
1142:     for (i=n-1; i>=0; i--) {
1143:       v   = aa + adiag[i+1]+1;
1144:       vi  = aj + adiag[i+1]+1;
1145:       nz  = adiag[i]-adiag[i+1]-1;
1146:       sum = tmp[i];
1147:       PetscSparseDenseMinusDot(sum,tmp,v,vi,nz);
1148:       x[c[i]] = tmp[i] = sum*v[nz]; /* v[nz] = aa[adiag[i]] */
1149:     }

1151:     b += n;
1152:     x += n;
1153:   }
1154:   ISRestoreIndices(isrow,&rout);
1155:   ISRestoreIndices(iscol,&cout);
1156:   MatDenseRestoreArray(B,&b);
1157:   MatDenseRestoreArray(X,&x);
1158:   PetscLogFlops(B->cmap->n*(2.0*a->nz - n));
1159:   return(0);
1160: }

1164: PetscErrorCode MatSolve_SeqAIJ_InplaceWithPerm(Mat A,Vec bb,Vec xx)
1165: {
1166:   Mat_SeqAIJ      *a    = (Mat_SeqAIJ*)A->data;
1167:   IS              iscol = a->col,isrow = a->row;
1168:   PetscErrorCode  ierr;
1169:   const PetscInt  *r,*c,*rout,*cout;
1170:   PetscInt        i, n = A->rmap->n,*vi,*ai = a->i,*aj = a->j;
1171:   PetscInt        nz,row;
1172:   PetscScalar     *x,*b,*tmp,*tmps,sum;
1173:   const MatScalar *aa = a->a,*v;

1176:   if (!n) return(0);

1178:   VecGetArray(bb,&b);
1179:   VecGetArray(xx,&x);
1180:   tmp  = a->solve_work;

1182:   ISGetIndices(isrow,&rout); r = rout;
1183:   ISGetIndices(iscol,&cout); c = cout + (n-1);

1185:   /* forward solve the lower triangular */
1186:   tmp[0] = b[*r++];
1187:   tmps   = tmp;
1188:   for (row=1; row<n; row++) {
1189:     i   = rout[row]; /* permuted row */
1190:     v   = aa + ai[i];
1191:     vi  = aj + ai[i];
1192:     nz  = a->diag[i] - ai[i];
1193:     sum = b[*r++];
1194:     PetscSparseDenseMinusDot(sum,tmps,v,vi,nz);
1195:     tmp[row] = sum;
1196:   }

1198:   /* backward solve the upper triangular */
1199:   for (row=n-1; row>=0; row--) {
1200:     i   = rout[row]; /* permuted row */
1201:     v   = aa + a->diag[i] + 1;
1202:     vi  = aj + a->diag[i] + 1;
1203:     nz  = ai[i+1] - a->diag[i] - 1;
1204:     sum = tmp[row];
1205:     PetscSparseDenseMinusDot(sum,tmps,v,vi,nz);
1206:     x[*c--] = tmp[row] = sum*aa[a->diag[i]];
1207:   }

1209:   ISRestoreIndices(isrow,&rout);
1210:   ISRestoreIndices(iscol,&cout);
1211:   VecRestoreArray(bb,&b);
1212:   VecRestoreArray(xx,&x);
1213:   PetscLogFlops(2.0*a->nz - A->cmap->n);
1214:   return(0);
1215: }

1217: /* ----------------------------------------------------------- */
1218: #include <../src/mat/impls/aij/seq/ftn-kernels/fsolve.h>
1221: PetscErrorCode MatSolve_SeqAIJ_NaturalOrdering_inplace(Mat A,Vec bb,Vec xx)
1222: {
1223:   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
1224:   PetscErrorCode    ierr;
1225:   PetscInt          n   = A->rmap->n;
1226:   const PetscInt    *ai = a->i,*aj = a->j,*adiag = a->diag;
1227:   PetscScalar       *x;
1228:   const PetscScalar *b;
1229:   const MatScalar   *aa = a->a;
1230: #if !defined(PETSC_USE_FORTRAN_KERNEL_SOLVEAIJ)
1231:   PetscInt        adiag_i,i,nz,ai_i;
1232:   const PetscInt  *vi;
1233:   const MatScalar *v;
1234:   PetscScalar     sum;
1235: #endif

1238:   if (!n) return(0);

1240:   VecGetArrayRead(bb,&b);
1241:   VecGetArray(xx,&x);

1243: #if defined(PETSC_USE_FORTRAN_KERNEL_SOLVEAIJ)
1244:   fortransolveaij_(&n,x,ai,aj,adiag,aa,b);
1245: #else
1246:   /* forward solve the lower triangular */
1247:   x[0] = b[0];
1248:   for (i=1; i<n; i++) {
1249:     ai_i = ai[i];
1250:     v    = aa + ai_i;
1251:     vi   = aj + ai_i;
1252:     nz   = adiag[i] - ai_i;
1253:     sum  = b[i];
1254:     PetscSparseDenseMinusDot(sum,x,v,vi,nz);
1255:     x[i] = sum;
1256:   }

1258:   /* backward solve the upper triangular */
1259:   for (i=n-1; i>=0; i--) {
1260:     adiag_i = adiag[i];
1261:     v       = aa + adiag_i + 1;
1262:     vi      = aj + adiag_i + 1;
1263:     nz      = ai[i+1] - adiag_i - 1;
1264:     sum     = x[i];
1265:     PetscSparseDenseMinusDot(sum,x,v,vi,nz);
1266:     x[i] = sum*aa[adiag_i];
1267:   }
1268: #endif
1269:   PetscLogFlops(2.0*a->nz - A->cmap->n);
1270:   VecRestoreArrayRead(bb,&b);
1271:   VecRestoreArray(xx,&x);
1272:   return(0);
1273: }

1277: PetscErrorCode MatSolveAdd_SeqAIJ_inplace(Mat A,Vec bb,Vec yy,Vec xx)
1278: {
1279:   Mat_SeqAIJ        *a    = (Mat_SeqAIJ*)A->data;
1280:   IS                iscol = a->col,isrow = a->row;
1281:   PetscErrorCode    ierr;
1282:   PetscInt          i, n = A->rmap->n,j;
1283:   PetscInt          nz;
1284:   const PetscInt    *rout,*cout,*r,*c,*vi,*ai = a->i,*aj = a->j;
1285:   PetscScalar       *x,*tmp,sum;
1286:   const PetscScalar *b;
1287:   const MatScalar   *aa = a->a,*v;

1290:   if (yy != xx) {VecCopy(yy,xx);}

1292:   VecGetArrayRead(bb,&b);
1293:   VecGetArray(xx,&x);
1294:   tmp  = a->solve_work;

1296:   ISGetIndices(isrow,&rout); r = rout;
1297:   ISGetIndices(iscol,&cout); c = cout + (n-1);

1299:   /* forward solve the lower triangular */
1300:   tmp[0] = b[*r++];
1301:   for (i=1; i<n; i++) {
1302:     v   = aa + ai[i];
1303:     vi  = aj + ai[i];
1304:     nz  = a->diag[i] - ai[i];
1305:     sum = b[*r++];
1306:     for (j=0; j<nz; j++) sum -= v[j]*tmp[vi[j]];
1307:     tmp[i] = sum;
1308:   }

1310:   /* backward solve the upper triangular */
1311:   for (i=n-1; i>=0; i--) {
1312:     v   = aa + a->diag[i] + 1;
1313:     vi  = aj + a->diag[i] + 1;
1314:     nz  = ai[i+1] - a->diag[i] - 1;
1315:     sum = tmp[i];
1316:     for (j=0; j<nz; j++) sum -= v[j]*tmp[vi[j]];
1317:     tmp[i]   = sum*aa[a->diag[i]];
1318:     x[*c--] += tmp[i];
1319:   }

1321:   ISRestoreIndices(isrow,&rout);
1322:   ISRestoreIndices(iscol,&cout);
1323:   VecRestoreArrayRead(bb,&b);
1324:   VecRestoreArray(xx,&x);
1325:   PetscLogFlops(2.0*a->nz);
1326:   return(0);
1327: }

1331: PetscErrorCode MatSolveAdd_SeqAIJ(Mat A,Vec bb,Vec yy,Vec xx)
1332: {
1333:   Mat_SeqAIJ        *a    = (Mat_SeqAIJ*)A->data;
1334:   IS                iscol = a->col,isrow = a->row;
1335:   PetscErrorCode    ierr;
1336:   PetscInt          i, n = A->rmap->n,j;
1337:   PetscInt          nz;
1338:   const PetscInt    *rout,*cout,*r,*c,*vi,*ai = a->i,*aj = a->j,*adiag = a->diag;
1339:   PetscScalar       *x,*tmp,sum;
1340:   const PetscScalar *b;
1341:   const MatScalar   *aa = a->a,*v;

1344:   if (yy != xx) {VecCopy(yy,xx);}

1346:   VecGetArrayRead(bb,&b);
1347:   VecGetArray(xx,&x);
1348:   tmp  = a->solve_work;

1350:   ISGetIndices(isrow,&rout); r = rout;
1351:   ISGetIndices(iscol,&cout); c = cout;

1353:   /* forward solve the lower triangular */
1354:   tmp[0] = b[r[0]];
1355:   v      = aa;
1356:   vi     = aj;
1357:   for (i=1; i<n; i++) {
1358:     nz  = ai[i+1] - ai[i];
1359:     sum = b[r[i]];
1360:     for (j=0; j<nz; j++) sum -= v[j]*tmp[vi[j]];
1361:     tmp[i] = sum;
1362:     v     += nz;
1363:     vi    += nz;
1364:   }

1366:   /* backward solve the upper triangular */
1367:   v  = aa + adiag[n-1];
1368:   vi = aj + adiag[n-1];
1369:   for (i=n-1; i>=0; i--) {
1370:     nz  = adiag[i] - adiag[i+1] - 1;
1371:     sum = tmp[i];
1372:     for (j=0; j<nz; j++) sum -= v[j]*tmp[vi[j]];
1373:     tmp[i]   = sum*v[nz];
1374:     x[c[i]] += tmp[i];
1375:     v       += nz+1; vi += nz+1;
1376:   }

1378:   ISRestoreIndices(isrow,&rout);
1379:   ISRestoreIndices(iscol,&cout);
1380:   VecRestoreArrayRead(bb,&b);
1381:   VecRestoreArray(xx,&x);
1382:   PetscLogFlops(2.0*a->nz);
1383:   return(0);
1384: }

1388: PetscErrorCode MatSolveTranspose_SeqAIJ_inplace(Mat A,Vec bb,Vec xx)
1389: {
1390:   Mat_SeqAIJ        *a    = (Mat_SeqAIJ*)A->data;
1391:   IS                iscol = a->col,isrow = a->row;
1392:   PetscErrorCode    ierr;
1393:   const PetscInt    *rout,*cout,*r,*c,*diag = a->diag,*ai = a->i,*aj = a->j,*vi;
1394:   PetscInt          i,n = A->rmap->n,j;
1395:   PetscInt          nz;
1396:   PetscScalar       *x,*tmp,s1;
1397:   const MatScalar   *aa = a->a,*v;
1398:   const PetscScalar *b;

1401:   VecGetArrayRead(bb,&b);
1402:   VecGetArray(xx,&x);
1403:   tmp  = a->solve_work;

1405:   ISGetIndices(isrow,&rout); r = rout;
1406:   ISGetIndices(iscol,&cout); c = cout;

1408:   /* copy the b into temp work space according to permutation */
1409:   for (i=0; i<n; i++) tmp[i] = b[c[i]];

1411:   /* forward solve the U^T */
1412:   for (i=0; i<n; i++) {
1413:     v   = aa + diag[i];
1414:     vi  = aj + diag[i] + 1;
1415:     nz  = ai[i+1] - diag[i] - 1;
1416:     s1  = tmp[i];
1417:     s1 *= (*v++);  /* multiply by inverse of diagonal entry */
1418:     for (j=0; j<nz; j++) tmp[vi[j]] -= s1*v[j];
1419:     tmp[i] = s1;
1420:   }

1422:   /* backward solve the L^T */
1423:   for (i=n-1; i>=0; i--) {
1424:     v  = aa + diag[i] - 1;
1425:     vi = aj + diag[i] - 1;
1426:     nz = diag[i] - ai[i];
1427:     s1 = tmp[i];
1428:     for (j=0; j>-nz; j--) tmp[vi[j]] -= s1*v[j];
1429:   }

1431:   /* copy tmp into x according to permutation */
1432:   for (i=0; i<n; i++) x[r[i]] = tmp[i];

1434:   ISRestoreIndices(isrow,&rout);
1435:   ISRestoreIndices(iscol,&cout);
1436:   VecRestoreArrayRead(bb,&b);
1437:   VecRestoreArray(xx,&x);

1439:   PetscLogFlops(2.0*a->nz-A->cmap->n);
1440:   return(0);
1441: }

1445: PetscErrorCode MatSolveTranspose_SeqAIJ(Mat A,Vec bb,Vec xx)
1446: {
1447:   Mat_SeqAIJ        *a    = (Mat_SeqAIJ*)A->data;
1448:   IS                iscol = a->col,isrow = a->row;
1449:   PetscErrorCode    ierr;
1450:   const PetscInt    *rout,*cout,*r,*c,*adiag = a->diag,*ai = a->i,*aj = a->j,*vi;
1451:   PetscInt          i,n = A->rmap->n,j;
1452:   PetscInt          nz;
1453:   PetscScalar       *x,*tmp,s1;
1454:   const MatScalar   *aa = a->a,*v;
1455:   const PetscScalar *b;

1458:   VecGetArrayRead(bb,&b);
1459:   VecGetArray(xx,&x);
1460:   tmp  = a->solve_work;

1462:   ISGetIndices(isrow,&rout); r = rout;
1463:   ISGetIndices(iscol,&cout); c = cout;

1465:   /* copy the b into temp work space according to permutation */
1466:   for (i=0; i<n; i++) tmp[i] = b[c[i]];

1468:   /* forward solve the U^T */
1469:   for (i=0; i<n; i++) {
1470:     v   = aa + adiag[i+1] + 1;
1471:     vi  = aj + adiag[i+1] + 1;
1472:     nz  = adiag[i] - adiag[i+1] - 1;
1473:     s1  = tmp[i];
1474:     s1 *= v[nz];  /* multiply by inverse of diagonal entry */
1475:     for (j=0; j<nz; j++) tmp[vi[j]] -= s1*v[j];
1476:     tmp[i] = s1;
1477:   }

1479:   /* backward solve the L^T */
1480:   for (i=n-1; i>=0; i--) {
1481:     v  = aa + ai[i];
1482:     vi = aj + ai[i];
1483:     nz = ai[i+1] - ai[i];
1484:     s1 = tmp[i];
1485:     for (j=0; j<nz; j++) tmp[vi[j]] -= s1*v[j];
1486:   }

1488:   /* copy tmp into x according to permutation */
1489:   for (i=0; i<n; i++) x[r[i]] = tmp[i];

1491:   ISRestoreIndices(isrow,&rout);
1492:   ISRestoreIndices(iscol,&cout);
1493:   VecRestoreArrayRead(bb,&b);
1494:   VecRestoreArray(xx,&x);

1496:   PetscLogFlops(2.0*a->nz-A->cmap->n);
1497:   return(0);
1498: }

1502: PetscErrorCode MatSolveTransposeAdd_SeqAIJ_inplace(Mat A,Vec bb,Vec zz,Vec xx)
1503: {
1504:   Mat_SeqAIJ        *a    = (Mat_SeqAIJ*)A->data;
1505:   IS                iscol = a->col,isrow = a->row;
1506:   PetscErrorCode    ierr;
1507:   const PetscInt    *rout,*cout,*r,*c,*diag = a->diag,*ai = a->i,*aj = a->j,*vi;
1508:   PetscInt          i,n = A->rmap->n,j;
1509:   PetscInt          nz;
1510:   PetscScalar       *x,*tmp,s1;
1511:   const MatScalar   *aa = a->a,*v;
1512:   const PetscScalar *b;

1515:   if (zz != xx) {VecCopy(zz,xx);}
1516:   VecGetArrayRead(bb,&b);
1517:   VecGetArray(xx,&x);
1518:   tmp  = a->solve_work;

1520:   ISGetIndices(isrow,&rout); r = rout;
1521:   ISGetIndices(iscol,&cout); c = cout;

1523:   /* copy the b into temp work space according to permutation */
1524:   for (i=0; i<n; i++) tmp[i] = b[c[i]];

1526:   /* forward solve the U^T */
1527:   for (i=0; i<n; i++) {
1528:     v   = aa + diag[i];
1529:     vi  = aj + diag[i] + 1;
1530:     nz  = ai[i+1] - diag[i] - 1;
1531:     s1  = tmp[i];
1532:     s1 *= (*v++);  /* multiply by inverse of diagonal entry */
1533:     for (j=0; j<nz; j++) tmp[vi[j]] -= s1*v[j];
1534:     tmp[i] = s1;
1535:   }

1537:   /* backward solve the L^T */
1538:   for (i=n-1; i>=0; i--) {
1539:     v  = aa + diag[i] - 1;
1540:     vi = aj + diag[i] - 1;
1541:     nz = diag[i] - ai[i];
1542:     s1 = tmp[i];
1543:     for (j=0; j>-nz; j--) tmp[vi[j]] -= s1*v[j];
1544:   }

1546:   /* copy tmp into x according to permutation */
1547:   for (i=0; i<n; i++) x[r[i]] += tmp[i];

1549:   ISRestoreIndices(isrow,&rout);
1550:   ISRestoreIndices(iscol,&cout);
1551:   VecRestoreArrayRead(bb,&b);
1552:   VecRestoreArray(xx,&x);

1554:   PetscLogFlops(2.0*a->nz-A->cmap->n);
1555:   return(0);
1556: }

1560: PetscErrorCode MatSolveTransposeAdd_SeqAIJ(Mat A,Vec bb,Vec zz,Vec xx)
1561: {
1562:   Mat_SeqAIJ        *a    = (Mat_SeqAIJ*)A->data;
1563:   IS                iscol = a->col,isrow = a->row;
1564:   PetscErrorCode    ierr;
1565:   const PetscInt    *rout,*cout,*r,*c,*adiag = a->diag,*ai = a->i,*aj = a->j,*vi;
1566:   PetscInt          i,n = A->rmap->n,j;
1567:   PetscInt          nz;
1568:   PetscScalar       *x,*tmp,s1;
1569:   const MatScalar   *aa = a->a,*v;
1570:   const PetscScalar *b;

1573:   if (zz != xx) {VecCopy(zz,xx);}
1574:   VecGetArrayRead(bb,&b);
1575:   VecGetArray(xx,&x);
1576:   tmp  = a->solve_work;

1578:   ISGetIndices(isrow,&rout); r = rout;
1579:   ISGetIndices(iscol,&cout); c = cout;

1581:   /* copy the b into temp work space according to permutation */
1582:   for (i=0; i<n; i++) tmp[i] = b[c[i]];

1584:   /* forward solve the U^T */
1585:   for (i=0; i<n; i++) {
1586:     v   = aa + adiag[i+1] + 1;
1587:     vi  = aj + adiag[i+1] + 1;
1588:     nz  = adiag[i] - adiag[i+1] - 1;
1589:     s1  = tmp[i];
1590:     s1 *= v[nz];  /* multiply by inverse of diagonal entry */
1591:     for (j=0; j<nz; j++) tmp[vi[j]] -= s1*v[j];
1592:     tmp[i] = s1;
1593:   }


1596:   /* backward solve the L^T */
1597:   for (i=n-1; i>=0; i--) {
1598:     v  = aa + ai[i];
1599:     vi = aj + ai[i];
1600:     nz = ai[i+1] - ai[i];
1601:     s1 = tmp[i];
1602:     for (j=0; j<nz; j++) tmp[vi[j]] -= s1*v[j];
1603:   }

1605:   /* copy tmp into x according to permutation */
1606:   for (i=0; i<n; i++) x[r[i]] += tmp[i];

1608:   ISRestoreIndices(isrow,&rout);
1609:   ISRestoreIndices(iscol,&cout);
1610:   VecRestoreArrayRead(bb,&b);
1611:   VecRestoreArray(xx,&x);

1613:   PetscLogFlops(2.0*a->nz-A->cmap->n);
1614:   return(0);
1615: }

1617: /* ----------------------------------------------------------------*/

1619: extern PetscErrorCode MatDuplicateNoCreate_SeqAIJ(Mat,Mat,MatDuplicateOption,PetscBool);

1621: /*
1622:    ilu() under revised new data structure.
1623:    Factored arrays bj and ba are stored as
1624:      L(0,:), L(1,:), ...,L(n-1,:),  U(n-1,:),...,U(i,:),U(i-1,:),...,U(0,:)

1626:    bi=fact->i is an array of size n+1, in which
1627:    bi+
1628:      bi[i]:  points to 1st entry of L(i,:),i=0,...,n-1
1629:      bi[n]:  points to L(n-1,n-1)+1

1631:   bdiag=fact->diag is an array of size n+1,in which
1632:      bdiag[i]: points to diagonal of U(i,:), i=0,...,n-1
1633:      bdiag[n]: points to entry of U(n-1,0)-1

1635:    U(i,:) contains bdiag[i] as its last entry, i.e.,
1636:     U(i,:) = (u[i,i+1],...,u[i,n-1],diag[i])
1637: */
1640: PetscErrorCode MatILUFactorSymbolic_SeqAIJ_ilu0(Mat fact,Mat A,IS isrow,IS iscol,const MatFactorInfo *info)
1641: {

1643:   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data,*b;
1645:   const PetscInt n=A->rmap->n,*ai=a->i,*aj,*adiag=a->diag;
1646:   PetscInt       i,j,k=0,nz,*bi,*bj,*bdiag;
1647:   PetscBool      missing;
1648:   IS             isicol;

1651:   if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
1652:   MatMissingDiagonal(A,&missing,&i);
1653:   if (missing) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",i);
1654:   ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);
1655:   MatDuplicateNoCreate_SeqAIJ(fact,A,MAT_DO_NOT_COPY_VALUES,PETSC_FALSE);
1656:   b    = (Mat_SeqAIJ*)(fact)->data;

1658:   /* allocate matrix arrays for new data structure */
1659:   PetscMalloc3(ai[n]+1,PetscScalar,&b->a,ai[n]+1,PetscInt,&b->j,n+1,PetscInt,&b->i);
1660:   PetscLogObjectMemory(fact,ai[n]*(sizeof(PetscScalar)+sizeof(PetscInt))+(n+1)*sizeof(PetscInt));

1662:   b->singlemalloc = PETSC_TRUE;
1663:   if (!b->diag) {
1664:     PetscMalloc((n+1)*sizeof(PetscInt),&b->diag);
1665:     PetscLogObjectMemory(fact,(n+1)*sizeof(PetscInt));
1666:   }
1667:   bdiag = b->diag;

1669:   if (n > 0) {
1670:     PetscMemzero(b->a,(ai[n])*sizeof(MatScalar));
1671:   }

1673:   /* set bi and bj with new data structure */
1674:   bi = b->i;
1675:   bj = b->j;

1677:   /* L part */
1678:   bi[0] = 0;
1679:   for (i=0; i<n; i++) {
1680:     nz      = adiag[i] - ai[i];
1681:     bi[i+1] = bi[i] + nz;
1682:     aj      = a->j + ai[i];
1683:     for (j=0; j<nz; j++) {
1684:       /*   *bj = aj[j]; bj++; */
1685:       bj[k++] = aj[j];
1686:     }
1687:   }

1689:   /* U part */
1690:   bdiag[n] = bi[n]-1;
1691:   for (i=n-1; i>=0; i--) {
1692:     nz = ai[i+1] - adiag[i] - 1;
1693:     aj = a->j + adiag[i] + 1;
1694:     for (j=0; j<nz; j++) {
1695:       /*      *bj = aj[j]; bj++; */
1696:       bj[k++] = aj[j];
1697:     }
1698:     /* diag[i] */
1699:     /*    *bj = i; bj++; */
1700:     bj[k++]  = i;
1701:     bdiag[i] = bdiag[i+1] + nz + 1;
1702:   }

1704:   fact->factortype             = MAT_FACTOR_ILU;
1705:   fact->info.factor_mallocs    = 0;
1706:   fact->info.fill_ratio_given  = info->fill;
1707:   fact->info.fill_ratio_needed = 1.0;
1708:   fact->ops->lufactornumeric   = MatLUFactorNumeric_SeqAIJ;

1710:   b       = (Mat_SeqAIJ*)(fact)->data;
1711:   b->row  = isrow;
1712:   b->col  = iscol;
1713:   b->icol = isicol;
1714:   PetscMalloc((fact->rmap->n+1)*sizeof(PetscScalar),&b->solve_work);
1715:   PetscObjectReference((PetscObject)isrow);
1716:   PetscObjectReference((PetscObject)iscol);
1717:   return(0);
1718: }

1722: PetscErrorCode MatILUFactorSymbolic_SeqAIJ(Mat fact,Mat A,IS isrow,IS iscol,const MatFactorInfo *info)
1723: {
1724:   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data,*b;
1725:   IS                 isicol;
1726:   PetscErrorCode     ierr;
1727:   const PetscInt     *r,*ic;
1728:   PetscInt           n=A->rmap->n,*ai=a->i,*aj=a->j;
1729:   PetscInt           *bi,*cols,nnz,*cols_lvl;
1730:   PetscInt           *bdiag,prow,fm,nzbd,reallocs=0,dcount=0;
1731:   PetscInt           i,levels,diagonal_fill;
1732:   PetscBool          col_identity,row_identity;
1733:   PetscReal          f;
1734:   PetscInt           nlnk,*lnk,*lnk_lvl=NULL;
1735:   PetscBT            lnkbt;
1736:   PetscInt           nzi,*bj,**bj_ptr,**bjlvl_ptr;
1737:   PetscFreeSpaceList free_space    =NULL,current_space=NULL;
1738:   PetscFreeSpaceList free_space_lvl=NULL,current_space_lvl=NULL;

1741:   /* Uncomment the old data struct part only while testing new data structure for MatSolve() */
1742:   /*
1743:   PetscBool          olddatastruct=PETSC_FALSE;
1744:   PetscOptionsGetBool(NULL,"-ilu_old",&olddatastruct,NULL);
1745:   if (olddatastruct) {
1746:     MatILUFactorSymbolic_SeqAIJ_inplace(fact,A,isrow,iscol,info);
1747:     return(0);
1748:   }
1749:   */

1751:   levels = (PetscInt)info->levels;
1752:   ISIdentity(isrow,&row_identity);
1753:   ISIdentity(iscol,&col_identity);
1754:   if (!levels && row_identity && col_identity) {
1755:     /* special case: ilu(0) with natural ordering */
1756:     MatILUFactorSymbolic_SeqAIJ_ilu0(fact,A,isrow,iscol,info);
1757:     if (a->inode.size) {
1758:       fact->ops->lufactornumeric = MatLUFactorNumeric_SeqAIJ_Inode;
1759:     }
1760:     return(0);
1761:   }

1763:   if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
1764:   ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);
1765:   ISGetIndices(isrow,&r);
1766:   ISGetIndices(isicol,&ic);

1768:   /* get new row and diagonal pointers, must be allocated separately because they will be given to the Mat_SeqAIJ and freed separately */
1769:   PetscMalloc((n+1)*sizeof(PetscInt),&bi);
1770:   PetscMalloc((n+1)*sizeof(PetscInt),&bdiag);
1771:   bi[0] = bdiag[0] = 0;
1772:   PetscMalloc2(n,PetscInt*,&bj_ptr,n,PetscInt*,&bjlvl_ptr);

1774:   /* create a linked list for storing column indices of the active row */
1775:   nlnk = n + 1;
1776:   PetscIncompleteLLCreate(n,n,nlnk,lnk,lnk_lvl,lnkbt);

1778:   /* initial FreeSpace size is f*(ai[n]+1) */
1779:   f                 = info->fill;
1780:   diagonal_fill     = (PetscInt)info->diagonal_fill;
1781:   PetscFreeSpaceGet((PetscInt)(f*(ai[n]+1)),&free_space);
1782:   current_space     = free_space;
1783:   PetscFreeSpaceGet((PetscInt)(f*(ai[n]+1)),&free_space_lvl);
1784:   current_space_lvl = free_space_lvl;
1785:   for (i=0; i<n; i++) {
1786:     nzi = 0;
1787:     /* copy current row into linked list */
1788:     nnz = ai[r[i]+1] - ai[r[i]];
1789:     if (!nnz) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",r[i],i);
1790:     cols   = aj + ai[r[i]];
1791:     lnk[i] = -1; /* marker to indicate if diagonal exists */
1792:     PetscIncompleteLLInit(nnz,cols,n,ic,nlnk,lnk,lnk_lvl,lnkbt);
1793:     nzi   += nlnk;

1795:     /* make sure diagonal entry is included */
1796:     if (diagonal_fill && lnk[i] == -1) {
1797:       fm = n;
1798:       while (lnk[fm] < i) fm = lnk[fm];
1799:       lnk[i]     = lnk[fm]; /* insert diagonal into linked list */
1800:       lnk[fm]    = i;
1801:       lnk_lvl[i] = 0;
1802:       nzi++; dcount++;
1803:     }

1805:     /* add pivot rows into the active row */
1806:     nzbd = 0;
1807:     prow = lnk[n];
1808:     while (prow < i) {
1809:       nnz      = bdiag[prow];
1810:       cols     = bj_ptr[prow] + nnz + 1;
1811:       cols_lvl = bjlvl_ptr[prow] + nnz + 1;
1812:       nnz      = bi[prow+1] - bi[prow] - nnz - 1;
1813:       PetscILULLAddSorted(nnz,cols,levels,cols_lvl,prow,nlnk,lnk,lnk_lvl,lnkbt,prow);
1814:       nzi     += nlnk;
1815:       prow     = lnk[prow];
1816:       nzbd++;
1817:     }
1818:     bdiag[i] = nzbd;
1819:     bi[i+1]  = bi[i] + nzi;
1820:     /* if free space is not available, make more free space */
1821:     if (current_space->local_remaining<nzi) {
1822:       nnz  = 2*nzi*(n - i); /* estimated and max additional space needed */
1823:       PetscFreeSpaceGet(nnz,&current_space);
1824:       PetscFreeSpaceGet(nnz,&current_space_lvl);
1825:       reallocs++;
1826:     }

1828:     /* copy data into free_space and free_space_lvl, then initialize lnk */
1829:     PetscIncompleteLLClean(n,n,nzi,lnk,lnk_lvl,current_space->array,current_space_lvl->array,lnkbt);
1830:     bj_ptr[i]    = current_space->array;
1831:     bjlvl_ptr[i] = current_space_lvl->array;

1833:     /* make sure the active row i has diagonal entry */
1834:     if (*(bj_ptr[i]+bdiag[i]) != i) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Row %D has missing diagonal in factored matrix\ntry running with -pc_factor_nonzeros_along_diagonal or -pc_factor_diagonal_fill",i);

1836:     current_space->array               += nzi;
1837:     current_space->local_used          += nzi;
1838:     current_space->local_remaining     -= nzi;
1839:     current_space_lvl->array           += nzi;
1840:     current_space_lvl->local_used      += nzi;
1841:     current_space_lvl->local_remaining -= nzi;
1842:   }

1844:   ISRestoreIndices(isrow,&r);
1845:   ISRestoreIndices(isicol,&ic);
1846:   /* copy free_space into bj and free free_space; set bi, bj, bdiag in new datastructure; */
1847:   PetscMalloc((bi[n]+1)*sizeof(PetscInt),&bj);
1848:   PetscFreeSpaceContiguous_LU(&free_space,bj,n,bi,bdiag);

1850:   PetscIncompleteLLDestroy(lnk,lnkbt);
1851:   PetscFreeSpaceDestroy(free_space_lvl);
1852:   PetscFree2(bj_ptr,bjlvl_ptr);

1854: #if defined(PETSC_USE_INFO)
1855:   {
1856:     PetscReal af = ((PetscReal)(bdiag[0]+1))/((PetscReal)ai[n]);
1857:     PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,f,af);
1858:     PetscInfo1(A,"Run with -[sub_]pc_factor_fill %G or use \n",af);
1859:     PetscInfo1(A,"PCFactorSetFill([sub]pc,%G);\n",af);
1860:     PetscInfo(A,"for best performance.\n");
1861:     if (diagonal_fill) {
1862:       PetscInfo1(A,"Detected and replaced %D missing diagonals",dcount);
1863:     }
1864:   }
1865: #endif
1866:   /* put together the new matrix */
1867:   MatSeqAIJSetPreallocation_SeqAIJ(fact,MAT_SKIP_ALLOCATION,NULL);
1868:   PetscLogObjectParent(fact,isicol);
1869:   b    = (Mat_SeqAIJ*)(fact)->data;

1871:   b->free_a       = PETSC_TRUE;
1872:   b->free_ij      = PETSC_TRUE;
1873:   b->singlemalloc = PETSC_FALSE;

1875:   PetscMalloc((bdiag[0]+1)*sizeof(PetscScalar),&b->a);

1877:   b->j    = bj;
1878:   b->i    = bi;
1879:   b->diag = bdiag;
1880:   b->ilen = 0;
1881:   b->imax = 0;
1882:   b->row  = isrow;
1883:   b->col  = iscol;
1884:   PetscObjectReference((PetscObject)isrow);
1885:   PetscObjectReference((PetscObject)iscol);
1886:   b->icol = isicol;

1888:   PetscMalloc((n+1)*sizeof(PetscScalar),&b->solve_work);
1889:   /* In b structure:  Free imax, ilen, old a, old j.
1890:      Allocate bdiag, solve_work, new a, new j */
1891:   PetscLogObjectMemory(fact,(bdiag[0]+1)*(sizeof(PetscInt)+sizeof(PetscScalar)));
1892:   b->maxnz = b->nz = bdiag[0]+1;

1894:   (fact)->info.factor_mallocs    = reallocs;
1895:   (fact)->info.fill_ratio_given  = f;
1896:   (fact)->info.fill_ratio_needed = ((PetscReal)(bdiag[0]+1))/((PetscReal)ai[n]);
1897:   (fact)->ops->lufactornumeric   = MatLUFactorNumeric_SeqAIJ;
1898:   if (a->inode.size) {
1899:     (fact)->ops->lufactornumeric = MatLUFactorNumeric_SeqAIJ_Inode;
1900:   }
1901:   return(0);
1902: }

1906: PetscErrorCode MatILUFactorSymbolic_SeqAIJ_inplace(Mat fact,Mat A,IS isrow,IS iscol,const MatFactorInfo *info)
1907: {
1908:   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data,*b;
1909:   IS                 isicol;
1910:   PetscErrorCode     ierr;
1911:   const PetscInt     *r,*ic;
1912:   PetscInt           n=A->rmap->n,*ai=a->i,*aj=a->j,d;
1913:   PetscInt           *bi,*cols,nnz,*cols_lvl;
1914:   PetscInt           *bdiag,prow,fm,nzbd,reallocs=0,dcount=0;
1915:   PetscInt           i,levels,diagonal_fill;
1916:   PetscBool          col_identity,row_identity;
1917:   PetscReal          f;
1918:   PetscInt           nlnk,*lnk,*lnk_lvl=NULL;
1919:   PetscBT            lnkbt;
1920:   PetscInt           nzi,*bj,**bj_ptr,**bjlvl_ptr;
1921:   PetscFreeSpaceList free_space    =NULL,current_space=NULL;
1922:   PetscFreeSpaceList free_space_lvl=NULL,current_space_lvl=NULL;
1923:   PetscBool          missing;

1926:   if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
1927:   f             = info->fill;
1928:   levels        = (PetscInt)info->levels;
1929:   diagonal_fill = (PetscInt)info->diagonal_fill;

1931:   ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);

1933:   ISIdentity(isrow,&row_identity);
1934:   ISIdentity(iscol,&col_identity);
1935:   if (!levels && row_identity && col_identity) { /* special case: ilu(0) with natural ordering */
1936:     MatDuplicateNoCreate_SeqAIJ(fact,A,MAT_DO_NOT_COPY_VALUES,PETSC_TRUE);

1938:     (fact)->ops->lufactornumeric =  MatLUFactorNumeric_SeqAIJ_inplace;
1939:     if (a->inode.size) {
1940:       (fact)->ops->lufactornumeric = MatLUFactorNumeric_SeqAIJ_Inode_inplace;
1941:     }
1942:     fact->factortype               = MAT_FACTOR_ILU;
1943:     (fact)->info.factor_mallocs    = 0;
1944:     (fact)->info.fill_ratio_given  = info->fill;
1945:     (fact)->info.fill_ratio_needed = 1.0;

1947:     b    = (Mat_SeqAIJ*)(fact)->data;
1948:     MatMissingDiagonal(A,&missing,&d);
1949:     if (missing) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",d);
1950:     b->row  = isrow;
1951:     b->col  = iscol;
1952:     b->icol = isicol;
1953:     PetscMalloc(((fact)->rmap->n+1)*sizeof(PetscScalar),&b->solve_work);
1954:     PetscObjectReference((PetscObject)isrow);
1955:     PetscObjectReference((PetscObject)iscol);
1956:     return(0);
1957:   }

1959:   ISGetIndices(isrow,&r);
1960:   ISGetIndices(isicol,&ic);

1962:   /* get new row and diagonal pointers, must be allocated separately because they will be given to the Mat_SeqAIJ and freed separately */
1963:   PetscMalloc((n+1)*sizeof(PetscInt),&bi);
1964:   PetscMalloc((n+1)*sizeof(PetscInt),&bdiag);
1965:   bi[0] = bdiag[0] = 0;

1967:   PetscMalloc2(n,PetscInt*,&bj_ptr,n,PetscInt*,&bjlvl_ptr);

1969:   /* create a linked list for storing column indices of the active row */
1970:   nlnk = n + 1;
1971:   PetscIncompleteLLCreate(n,n,nlnk,lnk,lnk_lvl,lnkbt);

1973:   /* initial FreeSpace size is f*(ai[n]+1) */
1974:   PetscFreeSpaceGet((PetscInt)(f*(ai[n]+1)),&free_space);
1975:   current_space     = free_space;
1976:   PetscFreeSpaceGet((PetscInt)(f*(ai[n]+1)),&free_space_lvl);
1977:   current_space_lvl = free_space_lvl;

1979:   for (i=0; i<n; i++) {
1980:     nzi = 0;
1981:     /* copy current row into linked list */
1982:     nnz = ai[r[i]+1] - ai[r[i]];
1983:     if (!nnz) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",r[i],i);
1984:     cols   = aj + ai[r[i]];
1985:     lnk[i] = -1; /* marker to indicate if diagonal exists */
1986:     PetscIncompleteLLInit(nnz,cols,n,ic,nlnk,lnk,lnk_lvl,lnkbt);
1987:     nzi   += nlnk;

1989:     /* make sure diagonal entry is included */
1990:     if (diagonal_fill && lnk[i] == -1) {
1991:       fm = n;
1992:       while (lnk[fm] < i) fm = lnk[fm];
1993:       lnk[i]     = lnk[fm]; /* insert diagonal into linked list */
1994:       lnk[fm]    = i;
1995:       lnk_lvl[i] = 0;
1996:       nzi++; dcount++;
1997:     }

1999:     /* add pivot rows into the active row */
2000:     nzbd = 0;
2001:     prow = lnk[n];
2002:     while (prow < i) {
2003:       nnz      = bdiag[prow];
2004:       cols     = bj_ptr[prow] + nnz + 1;
2005:       cols_lvl = bjlvl_ptr[prow] + nnz + 1;
2006:       nnz      = bi[prow+1] - bi[prow] - nnz - 1;
2007:       PetscILULLAddSorted(nnz,cols,levels,cols_lvl,prow,nlnk,lnk,lnk_lvl,lnkbt,prow);
2008:       nzi     += nlnk;
2009:       prow     = lnk[prow];
2010:       nzbd++;
2011:     }
2012:     bdiag[i] = nzbd;
2013:     bi[i+1]  = bi[i] + nzi;

2015:     /* if free space is not available, make more free space */
2016:     if (current_space->local_remaining<nzi) {
2017:       nnz  = nzi*(n - i); /* estimated and max additional space needed */
2018:       PetscFreeSpaceGet(nnz,&current_space);
2019:       PetscFreeSpaceGet(nnz,&current_space_lvl);
2020:       reallocs++;
2021:     }

2023:     /* copy data into free_space and free_space_lvl, then initialize lnk */
2024:     PetscIncompleteLLClean(n,n,nzi,lnk,lnk_lvl,current_space->array,current_space_lvl->array,lnkbt);
2025:     bj_ptr[i]    = current_space->array;
2026:     bjlvl_ptr[i] = current_space_lvl->array;

2028:     /* make sure the active row i has diagonal entry */
2029:     if (*(bj_ptr[i]+bdiag[i]) != i) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Row %D has missing diagonal in factored matrix\ntry running with -pc_factor_nonzeros_along_diagonal or -pc_factor_diagonal_fill",i);

2031:     current_space->array               += nzi;
2032:     current_space->local_used          += nzi;
2033:     current_space->local_remaining     -= nzi;
2034:     current_space_lvl->array           += nzi;
2035:     current_space_lvl->local_used      += nzi;
2036:     current_space_lvl->local_remaining -= nzi;
2037:   }

2039:   ISRestoreIndices(isrow,&r);
2040:   ISRestoreIndices(isicol,&ic);

2042:   /* destroy list of free space and other temporary arrays */
2043:   PetscMalloc((bi[n]+1)*sizeof(PetscInt),&bj);
2044:   PetscFreeSpaceContiguous(&free_space,bj); /* copy free_space -> bj */
2045:   PetscIncompleteLLDestroy(lnk,lnkbt);
2046:   PetscFreeSpaceDestroy(free_space_lvl);
2047:   PetscFree2(bj_ptr,bjlvl_ptr);

2049: #if defined(PETSC_USE_INFO)
2050:   {
2051:     PetscReal af = ((PetscReal)bi[n])/((PetscReal)ai[n]);
2052:     PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,f,af);
2053:     PetscInfo1(A,"Run with -[sub_]pc_factor_fill %G or use \n",af);
2054:     PetscInfo1(A,"PCFactorSetFill([sub]pc,%G);\n",af);
2055:     PetscInfo(A,"for best performance.\n");
2056:     if (diagonal_fill) {
2057:       PetscInfo1(A,"Detected and replaced %D missing diagonals",dcount);
2058:     }
2059:   }
2060: #endif

2062:   /* put together the new matrix */
2063:   MatSeqAIJSetPreallocation_SeqAIJ(fact,MAT_SKIP_ALLOCATION,NULL);
2064:   PetscLogObjectParent(fact,isicol);
2065:   b    = (Mat_SeqAIJ*)(fact)->data;

2067:   b->free_a       = PETSC_TRUE;
2068:   b->free_ij      = PETSC_TRUE;
2069:   b->singlemalloc = PETSC_FALSE;

2071:   PetscMalloc(bi[n]*sizeof(PetscScalar),&b->a);
2072:   b->j = bj;
2073:   b->i = bi;
2074:   for (i=0; i<n; i++) bdiag[i] += bi[i];
2075:   b->diag = bdiag;
2076:   b->ilen = 0;
2077:   b->imax = 0;
2078:   b->row  = isrow;
2079:   b->col  = iscol;
2080:   PetscObjectReference((PetscObject)isrow);
2081:   PetscObjectReference((PetscObject)iscol);
2082:   b->icol = isicol;
2083:   PetscMalloc((n+1)*sizeof(PetscScalar),&b->solve_work);
2084:   /* In b structure:  Free imax, ilen, old a, old j.
2085:      Allocate bdiag, solve_work, new a, new j */
2086:   PetscLogObjectMemory(fact,(bi[n]-n) * (sizeof(PetscInt)+sizeof(PetscScalar)));
2087:   b->maxnz = b->nz = bi[n];

2089:   (fact)->info.factor_mallocs    = reallocs;
2090:   (fact)->info.fill_ratio_given  = f;
2091:   (fact)->info.fill_ratio_needed = ((PetscReal)bi[n])/((PetscReal)ai[n]);
2092:   (fact)->ops->lufactornumeric   =  MatLUFactorNumeric_SeqAIJ_inplace;
2093:   if (a->inode.size) {
2094:     (fact)->ops->lufactornumeric = MatLUFactorNumeric_SeqAIJ_Inode_inplace;
2095:   }
2096:   return(0);
2097: }

2101: PetscErrorCode MatCholeskyFactorNumeric_SeqAIJ(Mat B,Mat A,const MatFactorInfo *info)
2102: {
2103:   Mat            C = B;
2104:   Mat_SeqAIJ     *a=(Mat_SeqAIJ*)A->data;
2105:   Mat_SeqSBAIJ   *b=(Mat_SeqSBAIJ*)C->data;
2106:   IS             ip=b->row,iip = b->icol;
2108:   const PetscInt *rip,*riip;
2109:   PetscInt       i,j,mbs=A->rmap->n,*bi=b->i,*bj=b->j,*bdiag=b->diag,*bjtmp;
2110:   PetscInt       *ai=a->i,*aj=a->j;
2111:   PetscInt       k,jmin,jmax,*c2r,*il,col,nexti,ili,nz;
2112:   MatScalar      *rtmp,*ba=b->a,*bval,*aa=a->a,dk,uikdi;
2113:   PetscBool      perm_identity;
2114:   FactorShiftCtx sctx;
2115:   PetscReal      rs;
2116:   MatScalar      d,*v;

2119:   /* MatPivotSetUp(): initialize shift context sctx */
2120:   PetscMemzero(&sctx,sizeof(FactorShiftCtx));

2122:   if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) { /* set sctx.shift_top=max{rs} */
2123:     sctx.shift_top = info->zeropivot;
2124:     for (i=0; i<mbs; i++) {
2125:       /* calculate sum(|aij|)-RealPart(aii), amt of shift needed for this row */
2126:       d  = (aa)[a->diag[i]];
2127:       rs = -PetscAbsScalar(d) - PetscRealPart(d);
2128:       v  = aa+ai[i];
2129:       nz = ai[i+1] - ai[i];
2130:       for (j=0; j<nz; j++) rs += PetscAbsScalar(v[j]);
2131:       if (rs>sctx.shift_top) sctx.shift_top = rs;
2132:     }
2133:     sctx.shift_top *= 1.1;
2134:     sctx.nshift_max = 5;
2135:     sctx.shift_lo   = 0.;
2136:     sctx.shift_hi   = 1.;
2137:   }

2139:   ISGetIndices(ip,&rip);
2140:   ISGetIndices(iip,&riip);

2142:   /* allocate working arrays
2143:      c2r: linked list, keep track of pivot rows for a given column. c2r[col]: head of the list for a given col
2144:      il:  for active k row, il[i] gives the index of the 1st nonzero entry in U[i,k:n-1] in bj and ba arrays
2145:   */
2146:   PetscMalloc3(mbs,MatScalar,&rtmp,mbs,PetscInt,&il,mbs,PetscInt,&c2r);

2148:   do {
2149:     sctx.newshift = PETSC_FALSE;

2151:     for (i=0; i<mbs; i++) c2r[i] = mbs;
2152:     if (mbs) il[0] = 0;

2154:     for (k = 0; k<mbs; k++) {
2155:       /* zero rtmp */
2156:       nz    = bi[k+1] - bi[k];
2157:       bjtmp = bj + bi[k];
2158:       for (j=0; j<nz; j++) rtmp[bjtmp[j]] = 0.0;

2160:       /* load in initial unfactored row */
2161:       bval = ba + bi[k];
2162:       jmin = ai[rip[k]]; jmax = ai[rip[k]+1];
2163:       for (j = jmin; j < jmax; j++) {
2164:         col = riip[aj[j]];
2165:         if (col >= k) { /* only take upper triangular entry */
2166:           rtmp[col] = aa[j];
2167:           *bval++   = 0.0; /* for in-place factorization */
2168:         }
2169:       }
2170:       /* shift the diagonal of the matrix: ZeropivotApply() */
2171:       rtmp[k] += sctx.shift_amount;  /* shift the diagonal of the matrix */

2173:       /* modify k-th row by adding in those rows i with U(i,k)!=0 */
2174:       dk = rtmp[k];
2175:       i  = c2r[k]; /* first row to be added to k_th row  */

2177:       while (i < k) {
2178:         nexti = c2r[i]; /* next row to be added to k_th row */

2180:         /* compute multiplier, update diag(k) and U(i,k) */
2181:         ili     = il[i]; /* index of first nonzero element in U(i,k:bms-1) */
2182:         uikdi   = -ba[ili]*ba[bdiag[i]]; /* diagonal(k) */
2183:         dk     += uikdi*ba[ili]; /* update diag[k] */
2184:         ba[ili] = uikdi; /* -U(i,k) */

2186:         /* add multiple of row i to k-th row */
2187:         jmin = ili + 1; jmax = bi[i+1];
2188:         if (jmin < jmax) {
2189:           for (j=jmin; j<jmax; j++) rtmp[bj[j]] += uikdi*ba[j];
2190:           /* update il and c2r for row i */
2191:           il[i] = jmin;
2192:           j     = bj[jmin]; c2r[i] = c2r[j]; c2r[j] = i;
2193:         }
2194:         i = nexti;
2195:       }

2197:       /* copy data into U(k,:) */
2198:       rs   = 0.0;
2199:       jmin = bi[k]; jmax = bi[k+1]-1;
2200:       if (jmin < jmax) {
2201:         for (j=jmin; j<jmax; j++) {
2202:           col = bj[j]; ba[j] = rtmp[col]; rs += PetscAbsScalar(ba[j]);
2203:         }
2204:         /* add the k-th row into il and c2r */
2205:         il[k] = jmin;
2206:         i     = bj[jmin]; c2r[k] = c2r[i]; c2r[i] = k;
2207:       }

2209:       /* MatPivotCheck() */
2210:       sctx.rs = rs;
2211:       sctx.pv = dk;
2212:       MatPivotCheck(A,info,&sctx,i);
2213:       if (sctx.newshift) break;
2214:       dk = sctx.pv;

2216:       ba[bdiag[k]] = 1.0/dk; /* U(k,k) */
2217:     }
2218:   } while (sctx.newshift);

2220:   PetscFree3(rtmp,il,c2r);
2221:   ISRestoreIndices(ip,&rip);
2222:   ISRestoreIndices(iip,&riip);

2224:   ISIdentity(ip,&perm_identity);
2225:   if (perm_identity) {
2226:     B->ops->solve          = MatSolve_SeqSBAIJ_1_NaturalOrdering;
2227:     B->ops->solvetranspose = MatSolve_SeqSBAIJ_1_NaturalOrdering;
2228:     B->ops->forwardsolve   = MatForwardSolve_SeqSBAIJ_1_NaturalOrdering;
2229:     B->ops->backwardsolve  = MatBackwardSolve_SeqSBAIJ_1_NaturalOrdering;
2230:   } else {
2231:     B->ops->solve          = MatSolve_SeqSBAIJ_1;
2232:     B->ops->solvetranspose = MatSolve_SeqSBAIJ_1;
2233:     B->ops->forwardsolve   = MatForwardSolve_SeqSBAIJ_1;
2234:     B->ops->backwardsolve  = MatBackwardSolve_SeqSBAIJ_1;
2235:   }

2237:   C->assembled    = PETSC_TRUE;
2238:   C->preallocated = PETSC_TRUE;

2240:   PetscLogFlops(C->rmap->n);

2242:   /* MatPivotView() */
2243:   if (sctx.nshift) {
2244:     if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) {
2245:       PetscInfo4(A,"number of shift_pd tries %D, shift_amount %G, diagonal shifted up by %e fraction top_value %e\n",sctx.nshift,sctx.shift_amount,sctx.shift_fraction,sctx.shift_top);
2246:     } else if (info->shifttype == (PetscReal)MAT_SHIFT_NONZERO) {
2247:       PetscInfo2(A,"number of shift_nz tries %D, shift_amount %G\n",sctx.nshift,sctx.shift_amount);
2248:     } else if (info->shifttype == (PetscReal)MAT_SHIFT_INBLOCKS) {
2249:       PetscInfo2(A,"number of shift_inblocks applied %D, each shift_amount %G\n",sctx.nshift,info->shiftamount);
2250:     }
2251:   }
2252:   return(0);
2253: }

2257: PetscErrorCode MatCholeskyFactorNumeric_SeqAIJ_inplace(Mat B,Mat A,const MatFactorInfo *info)
2258: {
2259:   Mat            C = B;
2260:   Mat_SeqAIJ     *a=(Mat_SeqAIJ*)A->data;
2261:   Mat_SeqSBAIJ   *b=(Mat_SeqSBAIJ*)C->data;
2262:   IS             ip=b->row,iip = b->icol;
2264:   const PetscInt *rip,*riip;
2265:   PetscInt       i,j,mbs=A->rmap->n,*bi=b->i,*bj=b->j,*bcol,*bjtmp;
2266:   PetscInt       *ai=a->i,*aj=a->j;
2267:   PetscInt       k,jmin,jmax,*jl,*il,col,nexti,ili,nz;
2268:   MatScalar      *rtmp,*ba=b->a,*bval,*aa=a->a,dk,uikdi;
2269:   PetscBool      perm_identity;
2270:   FactorShiftCtx sctx;
2271:   PetscReal      rs;
2272:   MatScalar      d,*v;

2275:   /* MatPivotSetUp(): initialize shift context sctx */
2276:   PetscMemzero(&sctx,sizeof(FactorShiftCtx));

2278:   if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) { /* set sctx.shift_top=max{rs} */
2279:     sctx.shift_top = info->zeropivot;
2280:     for (i=0; i<mbs; i++) {
2281:       /* calculate sum(|aij|)-RealPart(aii), amt of shift needed for this row */
2282:       d  = (aa)[a->diag[i]];
2283:       rs = -PetscAbsScalar(d) - PetscRealPart(d);
2284:       v  = aa+ai[i];
2285:       nz = ai[i+1] - ai[i];
2286:       for (j=0; j<nz; j++) rs += PetscAbsScalar(v[j]);
2287:       if (rs>sctx.shift_top) sctx.shift_top = rs;
2288:     }
2289:     sctx.shift_top *= 1.1;
2290:     sctx.nshift_max = 5;
2291:     sctx.shift_lo   = 0.;
2292:     sctx.shift_hi   = 1.;
2293:   }

2295:   ISGetIndices(ip,&rip);
2296:   ISGetIndices(iip,&riip);

2298:   /* initialization */
2299:   PetscMalloc3(mbs,MatScalar,&rtmp,mbs,PetscInt,&il,mbs,PetscInt,&jl);

2301:   do {
2302:     sctx.newshift = PETSC_FALSE;

2304:     for (i=0; i<mbs; i++) jl[i] = mbs;
2305:     il[0] = 0;

2307:     for (k = 0; k<mbs; k++) {
2308:       /* zero rtmp */
2309:       nz    = bi[k+1] - bi[k];
2310:       bjtmp = bj + bi[k];
2311:       for (j=0; j<nz; j++) rtmp[bjtmp[j]] = 0.0;

2313:       bval = ba + bi[k];
2314:       /* initialize k-th row by the perm[k]-th row of A */
2315:       jmin = ai[rip[k]]; jmax = ai[rip[k]+1];
2316:       for (j = jmin; j < jmax; j++) {
2317:         col = riip[aj[j]];
2318:         if (col >= k) { /* only take upper triangular entry */
2319:           rtmp[col] = aa[j];
2320:           *bval++   = 0.0; /* for in-place factorization */
2321:         }
2322:       }
2323:       /* shift the diagonal of the matrix */
2324:       if (sctx.nshift) rtmp[k] += sctx.shift_amount;

2326:       /* modify k-th row by adding in those rows i with U(i,k)!=0 */
2327:       dk = rtmp[k];
2328:       i  = jl[k]; /* first row to be added to k_th row  */

2330:       while (i < k) {
2331:         nexti = jl[i]; /* next row to be added to k_th row */

2333:         /* compute multiplier, update diag(k) and U(i,k) */
2334:         ili     = il[i]; /* index of first nonzero element in U(i,k:bms-1) */
2335:         uikdi   = -ba[ili]*ba[bi[i]]; /* diagonal(k) */
2336:         dk     += uikdi*ba[ili];
2337:         ba[ili] = uikdi; /* -U(i,k) */

2339:         /* add multiple of row i to k-th row */
2340:         jmin = ili + 1; jmax = bi[i+1];
2341:         if (jmin < jmax) {
2342:           for (j=jmin; j<jmax; j++) rtmp[bj[j]] += uikdi*ba[j];
2343:           /* update il and jl for row i */
2344:           il[i] = jmin;
2345:           j     = bj[jmin]; jl[i] = jl[j]; jl[j] = i;
2346:         }
2347:         i = nexti;
2348:       }

2350:       /* shift the diagonals when zero pivot is detected */
2351:       /* compute rs=sum of abs(off-diagonal) */
2352:       rs   = 0.0;
2353:       jmin = bi[k]+1;
2354:       nz   = bi[k+1] - jmin;
2355:       bcol = bj + jmin;
2356:       for (j=0; j<nz; j++) {
2357:         rs += PetscAbsScalar(rtmp[bcol[j]]);
2358:       }

2360:       sctx.rs = rs;
2361:       sctx.pv = dk;
2362:       MatPivotCheck(A,info,&sctx,k);
2363:       if (sctx.newshift) break;
2364:       dk = sctx.pv;

2366:       /* copy data into U(k,:) */
2367:       ba[bi[k]] = 1.0/dk; /* U(k,k) */
2368:       jmin      = bi[k]+1; jmax = bi[k+1];
2369:       if (jmin < jmax) {
2370:         for (j=jmin; j<jmax; j++) {
2371:           col = bj[j]; ba[j] = rtmp[col];
2372:         }
2373:         /* add the k-th row into il and jl */
2374:         il[k] = jmin;
2375:         i     = bj[jmin]; jl[k] = jl[i]; jl[i] = k;
2376:       }
2377:     }
2378:   } while (sctx.newshift);

2380:   PetscFree3(rtmp,il,jl);
2381:   ISRestoreIndices(ip,&rip);
2382:   ISRestoreIndices(iip,&riip);

2384:   ISIdentity(ip,&perm_identity);
2385:   if (perm_identity) {
2386:     B->ops->solve          = MatSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
2387:     B->ops->solvetranspose = MatSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
2388:     B->ops->forwardsolve   = MatForwardSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
2389:     B->ops->backwardsolve  = MatBackwardSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
2390:   } else {
2391:     B->ops->solve          = MatSolve_SeqSBAIJ_1_inplace;
2392:     B->ops->solvetranspose = MatSolve_SeqSBAIJ_1_inplace;
2393:     B->ops->forwardsolve   = MatForwardSolve_SeqSBAIJ_1_inplace;
2394:     B->ops->backwardsolve  = MatBackwardSolve_SeqSBAIJ_1_inplace;
2395:   }

2397:   C->assembled    = PETSC_TRUE;
2398:   C->preallocated = PETSC_TRUE;

2400:   PetscLogFlops(C->rmap->n);
2401:   if (sctx.nshift) {
2402:     if (info->shifttype == (PetscReal)MAT_SHIFT_NONZERO) {
2403:       PetscInfo2(A,"number of shiftnz tries %D, shift_amount %G\n",sctx.nshift,sctx.shift_amount);
2404:     } else if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) {
2405:       PetscInfo2(A,"number of shiftpd tries %D, shift_amount %G\n",sctx.nshift,sctx.shift_amount);
2406:     }
2407:   }
2408:   return(0);
2409: }

2411: /*
2412:    icc() under revised new data structure.
2413:    Factored arrays bj and ba are stored as
2414:      U(0,:),...,U(i,:),U(n-1,:)

2416:    ui=fact->i is an array of size n+1, in which
2417:    ui+
2418:      ui[i]:  points to 1st entry of U(i,:),i=0,...,n-1
2419:      ui[n]:  points to U(n-1,n-1)+1

2421:   udiag=fact->diag is an array of size n,in which
2422:      udiag[i]: points to diagonal of U(i,:), i=0,...,n-1

2424:    U(i,:) contains udiag[i] as its last entry, i.e.,
2425:     U(i,:) = (u[i,i+1],...,u[i,n-1],diag[i])
2426: */

2430: PetscErrorCode MatICCFactorSymbolic_SeqAIJ(Mat fact,Mat A,IS perm,const MatFactorInfo *info)
2431: {
2432:   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data;
2433:   Mat_SeqSBAIJ       *b;
2434:   PetscErrorCode     ierr;
2435:   PetscBool          perm_identity,missing;
2436:   PetscInt           reallocs=0,i,*ai=a->i,*aj=a->j,am=A->rmap->n,*ui,*udiag;
2437:   const PetscInt     *rip,*riip;
2438:   PetscInt           jmin,jmax,nzk,k,j,*jl,prow,*il,nextprow;
2439:   PetscInt           nlnk,*lnk,*lnk_lvl=NULL,d;
2440:   PetscInt           ncols,ncols_upper,*cols,*ajtmp,*uj,**uj_ptr,**uj_lvl_ptr;
2441:   PetscReal          fill          =info->fill,levels=info->levels;
2442:   PetscFreeSpaceList free_space    =NULL,current_space=NULL;
2443:   PetscFreeSpaceList free_space_lvl=NULL,current_space_lvl=NULL;
2444:   PetscBT            lnkbt;
2445:   IS                 iperm;

2448:   if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
2449:   MatMissingDiagonal(A,&missing,&d);
2450:   if (missing) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",d);
2451:   ISIdentity(perm,&perm_identity);
2452:   ISInvertPermutation(perm,PETSC_DECIDE,&iperm);

2454:   PetscMalloc((am+1)*sizeof(PetscInt),&ui);
2455:   PetscMalloc((am+1)*sizeof(PetscInt),&udiag);
2456:   ui[0] = 0;

2458:   /* ICC(0) without matrix ordering: simply rearrange column indices */
2459:   if (!levels && perm_identity) {
2460:     for (i=0; i<am; i++) {
2461:       ncols    = ai[i+1] - a->diag[i];
2462:       ui[i+1]  = ui[i] + ncols;
2463:       udiag[i] = ui[i+1] - 1; /* points to the last entry of U(i,:) */
2464:     }
2465:     PetscMalloc((ui[am]+1)*sizeof(PetscInt),&uj);
2466:     cols = uj;
2467:     for (i=0; i<am; i++) {
2468:       aj    = a->j + a->diag[i] + 1; /* 1st entry of U(i,:) without diagonal */
2469:       ncols = ai[i+1] - a->diag[i] -1;
2470:       for (j=0; j<ncols; j++) *cols++ = aj[j];
2471:       *cols++ = i; /* diagoanl is located as the last entry of U(i,:) */
2472:     }
2473:   } else { /* case: levels>0 || (levels=0 && !perm_identity) */
2474:     ISGetIndices(iperm,&riip);
2475:     ISGetIndices(perm,&rip);

2477:     /* initialization */
2478:     PetscMalloc((am+1)*sizeof(PetscInt),&ajtmp);

2480:     /* jl: linked list for storing indices of the pivot rows
2481:        il: il[i] points to the 1st nonzero entry of U(i,k:am-1) */
2482:     PetscMalloc4(am,PetscInt*,&uj_ptr,am,PetscInt*,&uj_lvl_ptr,am,PetscInt,&jl,am,PetscInt,&il);
2483:     for (i=0; i<am; i++) {
2484:       jl[i] = am; il[i] = 0;
2485:     }

2487:     /* create and initialize a linked list for storing column indices of the active row k */
2488:     nlnk = am + 1;
2489:     PetscIncompleteLLCreate(am,am,nlnk,lnk,lnk_lvl,lnkbt);

2491:     /* initial FreeSpace size is fill*(ai[am]+am)/2 */
2492:     PetscFreeSpaceGet((PetscInt)(fill*(ai[am]+am)/2),&free_space);
2493:     current_space     = free_space;
2494:     PetscFreeSpaceGet((PetscInt)(fill*(ai[am]+am)/2),&free_space_lvl);
2495:     current_space_lvl = free_space_lvl;

2497:     for (k=0; k<am; k++) {  /* for each active row k */
2498:       /* initialize lnk by the column indices of row rip[k] of A */
2499:       nzk   = 0;
2500:       ncols = ai[rip[k]+1] - ai[rip[k]];
2501:       if (!ncols) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_MAT_CH_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",rip[k],k);
2502:       ncols_upper = 0;
2503:       for (j=0; j<ncols; j++) {
2504:         i = *(aj + ai[rip[k]] + j); /* unpermuted column index */
2505:         if (riip[i] >= k) { /* only take upper triangular entry */
2506:           ajtmp[ncols_upper] = i;
2507:           ncols_upper++;
2508:         }
2509:       }
2510:       PetscIncompleteLLInit(ncols_upper,ajtmp,am,riip,nlnk,lnk,lnk_lvl,lnkbt);
2511:       nzk += nlnk;

2513:       /* update lnk by computing fill-in for each pivot row to be merged in */
2514:       prow = jl[k]; /* 1st pivot row */

2516:       while (prow < k) {
2517:         nextprow = jl[prow];

2519:         /* merge prow into k-th row */
2520:         jmin  = il[prow] + 1; /* index of the 2nd nzero entry in U(prow,k:am-1) */
2521:         jmax  = ui[prow+1];
2522:         ncols = jmax-jmin;
2523:         i     = jmin - ui[prow];
2524:         cols  = uj_ptr[prow] + i; /* points to the 2nd nzero entry in U(prow,k:am-1) */
2525:         uj    = uj_lvl_ptr[prow] + i; /* levels of cols */
2526:         j     = *(uj - 1);
2527:         PetscICCLLAddSorted(ncols,cols,levels,uj,am,nlnk,lnk,lnk_lvl,lnkbt,j);
2528:         nzk  += nlnk;

2530:         /* update il and jl for prow */
2531:         if (jmin < jmax) {
2532:           il[prow] = jmin;
2533:           j        = *cols; jl[prow] = jl[j]; jl[j] = prow;
2534:         }
2535:         prow = nextprow;
2536:       }

2538:       /* if free space is not available, make more free space */
2539:       if (current_space->local_remaining<nzk) {
2540:         i    = am - k + 1; /* num of unfactored rows */
2541:         i   *= PetscMin(nzk, i-1); /* i*nzk, i*(i-1): estimated and max additional space needed */
2542:         PetscFreeSpaceGet(i,&current_space);
2543:         PetscFreeSpaceGet(i,&current_space_lvl);
2544:         reallocs++;
2545:       }

2547:       /* copy data into free_space and free_space_lvl, then initialize lnk */
2548:       if (nzk == 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Empty row %D in ICC matrix factor",k);
2549:       PetscIncompleteLLClean(am,am,nzk,lnk,lnk_lvl,current_space->array,current_space_lvl->array,lnkbt);

2551:       /* add the k-th row into il and jl */
2552:       if (nzk > 1) {
2553:         i     = current_space->array[1]; /* col value of the first nonzero element in U(k, k+1:am-1) */
2554:         jl[k] = jl[i]; jl[i] = k;
2555:         il[k] = ui[k] + 1;
2556:       }
2557:       uj_ptr[k]     = current_space->array;
2558:       uj_lvl_ptr[k] = current_space_lvl->array;

2560:       current_space->array           += nzk;
2561:       current_space->local_used      += nzk;
2562:       current_space->local_remaining -= nzk;

2564:       current_space_lvl->array           += nzk;
2565:       current_space_lvl->local_used      += nzk;
2566:       current_space_lvl->local_remaining -= nzk;

2568:       ui[k+1] = ui[k] + nzk;
2569:     }

2571:     ISRestoreIndices(perm,&rip);
2572:     ISRestoreIndices(iperm,&riip);
2573:     PetscFree4(uj_ptr,uj_lvl_ptr,jl,il);
2574:     PetscFree(ajtmp);

2576:     /* copy free_space into uj and free free_space; set ui, uj, udiag in new datastructure; */
2577:     PetscMalloc((ui[am]+1)*sizeof(PetscInt),&uj);
2578:     PetscFreeSpaceContiguous_Cholesky(&free_space,uj,am,ui,udiag); /* store matrix factor  */
2579:     PetscIncompleteLLDestroy(lnk,lnkbt);
2580:     PetscFreeSpaceDestroy(free_space_lvl);

2582:   } /* end of case: levels>0 || (levels=0 && !perm_identity) */

2584:   /* put together the new matrix in MATSEQSBAIJ format */
2585:   b               = (Mat_SeqSBAIJ*)(fact)->data;
2586:   b->singlemalloc = PETSC_FALSE;

2588:   PetscMalloc((ui[am]+1)*sizeof(MatScalar),&b->a);

2590:   b->j             = uj;
2591:   b->i             = ui;
2592:   b->diag          = udiag;
2593:   b->free_diag     = PETSC_TRUE;
2594:   b->ilen          = 0;
2595:   b->imax          = 0;
2596:   b->row           = perm;
2597:   b->col           = perm;
2598:   PetscObjectReference((PetscObject)perm);
2599:   PetscObjectReference((PetscObject)perm);
2600:   b->icol          = iperm;
2601:   b->pivotinblocks = PETSC_FALSE; /* need to get from MatFactorInfo */

2603:   PetscMalloc((am+1)*sizeof(PetscScalar),&b->solve_work);
2604:   PetscLogObjectMemory(fact,ui[am]*(sizeof(PetscInt)+sizeof(MatScalar)));

2606:   b->maxnz   = b->nz = ui[am];
2607:   b->free_a  = PETSC_TRUE;
2608:   b->free_ij = PETSC_TRUE;

2610:   fact->info.factor_mallocs   = reallocs;
2611:   fact->info.fill_ratio_given = fill;
2612:   if (ai[am] != 0) {
2613:     /* nonzeros in lower triangular part of A (including diagonals) = (ai[am]+am)/2 */
2614:     fact->info.fill_ratio_needed = ((PetscReal)2*ui[am])/(ai[am]+am);
2615:   } else {
2616:     fact->info.fill_ratio_needed = 0.0;
2617:   }
2618: #if defined(PETSC_USE_INFO)
2619:   if (ai[am] != 0) {
2620:     PetscReal af = fact->info.fill_ratio_needed;
2621:     PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,fill,af);
2622:     PetscInfo1(A,"Run with -pc_factor_fill %G or use \n",af);
2623:     PetscInfo1(A,"PCFactorSetFill(pc,%G) for best performance.\n",af);
2624:   } else {
2625:     PetscInfo(A,"Empty matrix.\n");
2626:   }
2627: #endif
2628:   fact->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqAIJ;
2629:   return(0);
2630: }

2634: PetscErrorCode MatICCFactorSymbolic_SeqAIJ_inplace(Mat fact,Mat A,IS perm,const MatFactorInfo *info)
2635: {
2636:   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data;
2637:   Mat_SeqSBAIJ       *b;
2638:   PetscErrorCode     ierr;
2639:   PetscBool          perm_identity,missing;
2640:   PetscInt           reallocs=0,i,*ai=a->i,*aj=a->j,am=A->rmap->n,*ui,*udiag;
2641:   const PetscInt     *rip,*riip;
2642:   PetscInt           jmin,jmax,nzk,k,j,*jl,prow,*il,nextprow;
2643:   PetscInt           nlnk,*lnk,*lnk_lvl=NULL,d;
2644:   PetscInt           ncols,ncols_upper,*cols,*ajtmp,*uj,**uj_ptr,**uj_lvl_ptr;
2645:   PetscReal          fill          =info->fill,levels=info->levels;
2646:   PetscFreeSpaceList free_space    =NULL,current_space=NULL;
2647:   PetscFreeSpaceList free_space_lvl=NULL,current_space_lvl=NULL;
2648:   PetscBT            lnkbt;
2649:   IS                 iperm;

2652:   if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
2653:   MatMissingDiagonal(A,&missing,&d);
2654:   if (missing) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",d);
2655:   ISIdentity(perm,&perm_identity);
2656:   ISInvertPermutation(perm,PETSC_DECIDE,&iperm);

2658:   PetscMalloc((am+1)*sizeof(PetscInt),&ui);
2659:   PetscMalloc((am+1)*sizeof(PetscInt),&udiag);
2660:   ui[0] = 0;

2662:   /* ICC(0) without matrix ordering: simply copies fill pattern */
2663:   if (!levels && perm_identity) {

2665:     for (i=0; i<am; i++) {
2666:       ui[i+1]  = ui[i] + ai[i+1] - a->diag[i];
2667:       udiag[i] = ui[i];
2668:     }
2669:     PetscMalloc((ui[am]+1)*sizeof(PetscInt),&uj);
2670:     cols = uj;
2671:     for (i=0; i<am; i++) {
2672:       aj    = a->j + a->diag[i];
2673:       ncols = ui[i+1] - ui[i];
2674:       for (j=0; j<ncols; j++) *cols++ = *aj++;
2675:     }
2676:   } else { /* case: levels>0 || (levels=0 && !perm_identity) */
2677:     ISGetIndices(iperm,&riip);
2678:     ISGetIndices(perm,&rip);

2680:     /* initialization */
2681:     PetscMalloc((am+1)*sizeof(PetscInt),&ajtmp);

2683:     /* jl: linked list for storing indices of the pivot rows
2684:        il: il[i] points to the 1st nonzero entry of U(i,k:am-1) */
2685:     PetscMalloc4(am,PetscInt*,&uj_ptr,am,PetscInt*,&uj_lvl_ptr,am,PetscInt,&jl,am,PetscInt,&il);
2686:     for (i=0; i<am; i++) {
2687:       jl[i] = am; il[i] = 0;
2688:     }

2690:     /* create and initialize a linked list for storing column indices of the active row k */
2691:     nlnk = am + 1;
2692:     PetscIncompleteLLCreate(am,am,nlnk,lnk,lnk_lvl,lnkbt);

2694:     /* initial FreeSpace size is fill*(ai[am]+1) */
2695:     PetscFreeSpaceGet((PetscInt)(fill*(ai[am]+1)),&free_space);
2696:     current_space     = free_space;
2697:     PetscFreeSpaceGet((PetscInt)(fill*(ai[am]+1)),&free_space_lvl);
2698:     current_space_lvl = free_space_lvl;

2700:     for (k=0; k<am; k++) {  /* for each active row k */
2701:       /* initialize lnk by the column indices of row rip[k] of A */
2702:       nzk   = 0;
2703:       ncols = ai[rip[k]+1] - ai[rip[k]];
2704:       if (!ncols) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_MAT_CH_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",rip[k],k);
2705:       ncols_upper = 0;
2706:       for (j=0; j<ncols; j++) {
2707:         i = *(aj + ai[rip[k]] + j); /* unpermuted column index */
2708:         if (riip[i] >= k) { /* only take upper triangular entry */
2709:           ajtmp[ncols_upper] = i;
2710:           ncols_upper++;
2711:         }
2712:       }
2713:       PetscIncompleteLLInit(ncols_upper,ajtmp,am,riip,nlnk,lnk,lnk_lvl,lnkbt);
2714:       nzk += nlnk;

2716:       /* update lnk by computing fill-in for each pivot row to be merged in */
2717:       prow = jl[k]; /* 1st pivot row */

2719:       while (prow < k) {
2720:         nextprow = jl[prow];

2722:         /* merge prow into k-th row */
2723:         jmin  = il[prow] + 1; /* index of the 2nd nzero entry in U(prow,k:am-1) */
2724:         jmax  = ui[prow+1];
2725:         ncols = jmax-jmin;
2726:         i     = jmin - ui[prow];
2727:         cols  = uj_ptr[prow] + i; /* points to the 2nd nzero entry in U(prow,k:am-1) */
2728:         uj    = uj_lvl_ptr[prow] + i; /* levels of cols */
2729:         j     = *(uj - 1);
2730:         PetscICCLLAddSorted(ncols,cols,levels,uj,am,nlnk,lnk,lnk_lvl,lnkbt,j);
2731:         nzk  += nlnk;

2733:         /* update il and jl for prow */
2734:         if (jmin < jmax) {
2735:           il[prow] = jmin;
2736:           j        = *cols; jl[prow] = jl[j]; jl[j] = prow;
2737:         }
2738:         prow = nextprow;
2739:       }

2741:       /* if free space is not available, make more free space */
2742:       if (current_space->local_remaining<nzk) {
2743:         i    = am - k + 1; /* num of unfactored rows */
2744:         i   *= PetscMin(nzk, (i-1)); /* i*nzk, i*(i-1): estimated and max additional space needed */
2745:         PetscFreeSpaceGet(i,&current_space);
2746:         PetscFreeSpaceGet(i,&current_space_lvl);
2747:         reallocs++;
2748:       }

2750:       /* copy data into free_space and free_space_lvl, then initialize lnk */
2751:       if (!nzk) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Empty row %D in ICC matrix factor",k);
2752:       PetscIncompleteLLClean(am,am,nzk,lnk,lnk_lvl,current_space->array,current_space_lvl->array,lnkbt);

2754:       /* add the k-th row into il and jl */
2755:       if (nzk > 1) {
2756:         i     = current_space->array[1]; /* col value of the first nonzero element in U(k, k+1:am-1) */
2757:         jl[k] = jl[i]; jl[i] = k;
2758:         il[k] = ui[k] + 1;
2759:       }
2760:       uj_ptr[k]     = current_space->array;
2761:       uj_lvl_ptr[k] = current_space_lvl->array;

2763:       current_space->array           += nzk;
2764:       current_space->local_used      += nzk;
2765:       current_space->local_remaining -= nzk;

2767:       current_space_lvl->array           += nzk;
2768:       current_space_lvl->local_used      += nzk;
2769:       current_space_lvl->local_remaining -= nzk;

2771:       ui[k+1] = ui[k] + nzk;
2772:     }

2774: #if defined(PETSC_USE_INFO)
2775:     if (ai[am] != 0) {
2776:       PetscReal af = (PetscReal)ui[am]/((PetscReal)ai[am]);
2777:       PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,fill,af);
2778:       PetscInfo1(A,"Run with -pc_factor_fill %G or use \n",af);
2779:       PetscInfo1(A,"PCFactorSetFill(pc,%G) for best performance.\n",af);
2780:     } else {
2781:       PetscInfo(A,"Empty matrix.\n");
2782:     }
2783: #endif

2785:     ISRestoreIndices(perm,&rip);
2786:     ISRestoreIndices(iperm,&riip);
2787:     PetscFree4(uj_ptr,uj_lvl_ptr,jl,il);
2788:     PetscFree(ajtmp);

2790:     /* destroy list of free space and other temporary array(s) */
2791:     PetscMalloc((ui[am]+1)*sizeof(PetscInt),&uj);
2792:     PetscFreeSpaceContiguous(&free_space,uj);
2793:     PetscIncompleteLLDestroy(lnk,lnkbt);
2794:     PetscFreeSpaceDestroy(free_space_lvl);

2796:   } /* end of case: levels>0 || (levels=0 && !perm_identity) */

2798:   /* put together the new matrix in MATSEQSBAIJ format */

2800:   b               = (Mat_SeqSBAIJ*)fact->data;
2801:   b->singlemalloc = PETSC_FALSE;

2803:   PetscMalloc((ui[am]+1)*sizeof(MatScalar),&b->a);

2805:   b->j         = uj;
2806:   b->i         = ui;
2807:   b->diag      = udiag;
2808:   b->free_diag = PETSC_TRUE;
2809:   b->ilen      = 0;
2810:   b->imax      = 0;
2811:   b->row       = perm;
2812:   b->col       = perm;

2814:   PetscObjectReference((PetscObject)perm);
2815:   PetscObjectReference((PetscObject)perm);

2817:   b->icol          = iperm;
2818:   b->pivotinblocks = PETSC_FALSE; /* need to get from MatFactorInfo */
2819:   PetscMalloc((am+1)*sizeof(PetscScalar),&b->solve_work);
2820:   PetscLogObjectMemory(fact,(ui[am]-am)*(sizeof(PetscInt)+sizeof(MatScalar)));
2821:   b->maxnz         = b->nz = ui[am];
2822:   b->free_a        = PETSC_TRUE;
2823:   b->free_ij       = PETSC_TRUE;

2825:   fact->info.factor_mallocs   = reallocs;
2826:   fact->info.fill_ratio_given = fill;
2827:   if (ai[am] != 0) {
2828:     fact->info.fill_ratio_needed = ((PetscReal)ui[am])/((PetscReal)ai[am]);
2829:   } else {
2830:     fact->info.fill_ratio_needed = 0.0;
2831:   }
2832:   fact->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqAIJ_inplace;
2833:   return(0);
2834: }

2838: PetscErrorCode MatCholeskyFactorSymbolic_SeqAIJ(Mat fact,Mat A,IS perm,const MatFactorInfo *info)
2839: {
2840:   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data;
2841:   Mat_SeqSBAIJ       *b;
2842:   PetscErrorCode     ierr;
2843:   PetscBool          perm_identity;
2844:   PetscReal          fill = info->fill;
2845:   const PetscInt     *rip,*riip;
2846:   PetscInt           i,am=A->rmap->n,*ai=a->i,*aj=a->j,reallocs=0,prow;
2847:   PetscInt           *jl,jmin,jmax,nzk,*ui,k,j,*il,nextprow;
2848:   PetscInt           nlnk,*lnk,ncols,ncols_upper,*cols,*uj,**ui_ptr,*uj_ptr,*udiag;
2849:   PetscFreeSpaceList free_space=NULL,current_space=NULL;
2850:   PetscBT            lnkbt;
2851:   IS                 iperm;

2854:   if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
2855:   /* check whether perm is the identity mapping */
2856:   ISIdentity(perm,&perm_identity);
2857:   ISInvertPermutation(perm,PETSC_DECIDE,&iperm);
2858:   ISGetIndices(iperm,&riip);
2859:   ISGetIndices(perm,&rip);

2861:   /* initialization */
2862:   PetscMalloc((am+1)*sizeof(PetscInt),&ui);
2863:   PetscMalloc((am+1)*sizeof(PetscInt),&udiag);
2864:   ui[0] = 0;

2866:   /* jl: linked list for storing indices of the pivot rows
2867:      il: il[i] points to the 1st nonzero entry of U(i,k:am-1) */
2868:   PetscMalloc4(am,PetscInt*,&ui_ptr,am,PetscInt,&jl,am,PetscInt,&il,am,PetscInt,&cols);
2869:   for (i=0; i<am; i++) {
2870:     jl[i] = am; il[i] = 0;
2871:   }

2873:   /* create and initialize a linked list for storing column indices of the active row k */
2874:   nlnk = am + 1;
2875:   PetscLLCreate(am,am,nlnk,lnk,lnkbt);

2877:   /* initial FreeSpace size is fill*(ai[am]+am)/2 */
2878:   PetscFreeSpaceGet((PetscInt)(fill*(ai[am]+am)/2),&free_space);
2879:   current_space = free_space;

2881:   for (k=0; k<am; k++) {  /* for each active row k */
2882:     /* initialize lnk by the column indices of row rip[k] of A */
2883:     nzk   = 0;
2884:     ncols = ai[rip[k]+1] - ai[rip[k]];
2885:     if (!ncols) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_MAT_CH_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",rip[k],k);
2886:     ncols_upper = 0;
2887:     for (j=0; j<ncols; j++) {
2888:       i = riip[*(aj + ai[rip[k]] + j)];
2889:       if (i >= k) { /* only take upper triangular entry */
2890:         cols[ncols_upper] = i;
2891:         ncols_upper++;
2892:       }
2893:     }
2894:     PetscLLAdd(ncols_upper,cols,am,nlnk,lnk,lnkbt);
2895:     nzk += nlnk;

2897:     /* update lnk by computing fill-in for each pivot row to be merged in */
2898:     prow = jl[k]; /* 1st pivot row */

2900:     while (prow < k) {
2901:       nextprow = jl[prow];
2902:       /* merge prow into k-th row */
2903:       jmin   = il[prow] + 1; /* index of the 2nd nzero entry in U(prow,k:am-1) */
2904:       jmax   = ui[prow+1];
2905:       ncols  = jmax-jmin;
2906:       uj_ptr = ui_ptr[prow] + jmin - ui[prow]; /* points to the 2nd nzero entry in U(prow,k:am-1) */
2907:       PetscLLAddSorted(ncols,uj_ptr,am,nlnk,lnk,lnkbt);
2908:       nzk   += nlnk;

2910:       /* update il and jl for prow */
2911:       if (jmin < jmax) {
2912:         il[prow] = jmin;
2913:         j        = *uj_ptr;
2914:         jl[prow] = jl[j];
2915:         jl[j]    = prow;
2916:       }
2917:       prow = nextprow;
2918:     }

2920:     /* if free space is not available, make more free space */
2921:     if (current_space->local_remaining<nzk) {
2922:       i    = am - k + 1; /* num of unfactored rows */
2923:       i   *= PetscMin(nzk,i-1); /* i*nzk, i*(i-1): estimated and max additional space needed */
2924:       PetscFreeSpaceGet(i,&current_space);
2925:       reallocs++;
2926:     }

2928:     /* copy data into free space, then initialize lnk */
2929:     PetscLLClean(am,am,nzk,lnk,current_space->array,lnkbt);

2931:     /* add the k-th row into il and jl */
2932:     if (nzk > 1) {
2933:       i     = current_space->array[1]; /* col value of the first nonzero element in U(k, k+1:am-1) */
2934:       jl[k] = jl[i]; jl[i] = k;
2935:       il[k] = ui[k] + 1;
2936:     }
2937:     ui_ptr[k] = current_space->array;

2939:     current_space->array           += nzk;
2940:     current_space->local_used      += nzk;
2941:     current_space->local_remaining -= nzk;

2943:     ui[k+1] = ui[k] + nzk;
2944:   }

2946:   ISRestoreIndices(perm,&rip);
2947:   ISRestoreIndices(iperm,&riip);
2948:   PetscFree4(ui_ptr,jl,il,cols);

2950:   /* copy free_space into uj and free free_space; set ui, uj, udiag in new datastructure; */
2951:   PetscMalloc((ui[am]+1)*sizeof(PetscInt),&uj);
2952:   PetscFreeSpaceContiguous_Cholesky(&free_space,uj,am,ui,udiag); /* store matrix factor */
2953:   PetscLLDestroy(lnk,lnkbt);

2955:   /* put together the new matrix in MATSEQSBAIJ format */

2957:   b               = (Mat_SeqSBAIJ*)fact->data;
2958:   b->singlemalloc = PETSC_FALSE;
2959:   b->free_a       = PETSC_TRUE;
2960:   b->free_ij      = PETSC_TRUE;

2962:   PetscMalloc((ui[am]+1)*sizeof(MatScalar),&b->a);

2964:   b->j         = uj;
2965:   b->i         = ui;
2966:   b->diag      = udiag;
2967:   b->free_diag = PETSC_TRUE;
2968:   b->ilen      = 0;
2969:   b->imax      = 0;
2970:   b->row       = perm;
2971:   b->col       = perm;

2973:   PetscObjectReference((PetscObject)perm);
2974:   PetscObjectReference((PetscObject)perm);

2976:   b->icol          = iperm;
2977:   b->pivotinblocks = PETSC_FALSE; /* need to get from MatFactorInfo */

2979:   PetscMalloc((am+1)*sizeof(PetscScalar),&b->solve_work);
2980:   PetscLogObjectMemory(fact,ui[am]*(sizeof(PetscInt)+sizeof(MatScalar)));

2982:   b->maxnz = b->nz = ui[am];

2984:   fact->info.factor_mallocs   = reallocs;
2985:   fact->info.fill_ratio_given = fill;
2986:   if (ai[am] != 0) {
2987:     /* nonzeros in lower triangular part of A (including diagonals) = (ai[am]+am)/2 */
2988:     fact->info.fill_ratio_needed = ((PetscReal)2*ui[am])/(ai[am]+am);
2989:   } else {
2990:     fact->info.fill_ratio_needed = 0.0;
2991:   }
2992: #if defined(PETSC_USE_INFO)
2993:   if (ai[am] != 0) {
2994:     PetscReal af = fact->info.fill_ratio_needed;
2995:     PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,fill,af);
2996:     PetscInfo1(A,"Run with -pc_factor_fill %G or use \n",af);
2997:     PetscInfo1(A,"PCFactorSetFill(pc,%G) for best performance.\n",af);
2998:   } else {
2999:     PetscInfo(A,"Empty matrix.\n");
3000:   }
3001: #endif
3002:   fact->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqAIJ;
3003:   return(0);
3004: }

3008: PetscErrorCode MatCholeskyFactorSymbolic_SeqAIJ_inplace(Mat fact,Mat A,IS perm,const MatFactorInfo *info)
3009: {
3010:   Mat_SeqAIJ         *a = (Mat_SeqAIJ*)A->data;
3011:   Mat_SeqSBAIJ       *b;
3012:   PetscErrorCode     ierr;
3013:   PetscBool          perm_identity;
3014:   PetscReal          fill = info->fill;
3015:   const PetscInt     *rip,*riip;
3016:   PetscInt           i,am=A->rmap->n,*ai=a->i,*aj=a->j,reallocs=0,prow;
3017:   PetscInt           *jl,jmin,jmax,nzk,*ui,k,j,*il,nextprow;
3018:   PetscInt           nlnk,*lnk,ncols,ncols_upper,*cols,*uj,**ui_ptr,*uj_ptr;
3019:   PetscFreeSpaceList free_space=NULL,current_space=NULL;
3020:   PetscBT            lnkbt;
3021:   IS                 iperm;

3024:   if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
3025:   /* check whether perm is the identity mapping */
3026:   ISIdentity(perm,&perm_identity);
3027:   ISInvertPermutation(perm,PETSC_DECIDE,&iperm);
3028:   ISGetIndices(iperm,&riip);
3029:   ISGetIndices(perm,&rip);

3031:   /* initialization */
3032:   PetscMalloc((am+1)*sizeof(PetscInt),&ui);
3033:   ui[0] = 0;

3035:   /* jl: linked list for storing indices of the pivot rows
3036:      il: il[i] points to the 1st nonzero entry of U(i,k:am-1) */
3037:   PetscMalloc4(am,PetscInt*,&ui_ptr,am,PetscInt,&jl,am,PetscInt,&il,am,PetscInt,&cols);
3038:   for (i=0; i<am; i++) {
3039:     jl[i] = am; il[i] = 0;
3040:   }

3042:   /* create and initialize a linked list for storing column indices of the active row k */
3043:   nlnk = am + 1;
3044:   PetscLLCreate(am,am,nlnk,lnk,lnkbt);

3046:   /* initial FreeSpace size is fill*(ai[am]+1) */
3047:   PetscFreeSpaceGet((PetscInt)(fill*(ai[am]+1)),&free_space);
3048:   current_space = free_space;

3050:   for (k=0; k<am; k++) {  /* for each active row k */
3051:     /* initialize lnk by the column indices of row rip[k] of A */
3052:     nzk   = 0;
3053:     ncols = ai[rip[k]+1] - ai[rip[k]];
3054:     if (!ncols) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_MAT_CH_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",rip[k],k);
3055:     ncols_upper = 0;
3056:     for (j=0; j<ncols; j++) {
3057:       i = riip[*(aj + ai[rip[k]] + j)];
3058:       if (i >= k) { /* only take upper triangular entry */
3059:         cols[ncols_upper] = i;
3060:         ncols_upper++;
3061:       }
3062:     }
3063:     PetscLLAdd(ncols_upper,cols,am,nlnk,lnk,lnkbt);
3064:     nzk += nlnk;

3066:     /* update lnk by computing fill-in for each pivot row to be merged in */
3067:     prow = jl[k]; /* 1st pivot row */

3069:     while (prow < k) {
3070:       nextprow = jl[prow];
3071:       /* merge prow into k-th row */
3072:       jmin   = il[prow] + 1; /* index of the 2nd nzero entry in U(prow,k:am-1) */
3073:       jmax   = ui[prow+1];
3074:       ncols  = jmax-jmin;
3075:       uj_ptr = ui_ptr[prow] + jmin - ui[prow]; /* points to the 2nd nzero entry in U(prow,k:am-1) */
3076:       PetscLLAddSorted(ncols,uj_ptr,am,nlnk,lnk,lnkbt);
3077:       nzk   += nlnk;

3079:       /* update il and jl for prow */
3080:       if (jmin < jmax) {
3081:         il[prow] = jmin;
3082:         j        = *uj_ptr; jl[prow] = jl[j]; jl[j] = prow;
3083:       }
3084:       prow = nextprow;
3085:     }

3087:     /* if free space is not available, make more free space */
3088:     if (current_space->local_remaining<nzk) {
3089:       i    = am - k + 1; /* num of unfactored rows */
3090:       i    = PetscMin(i*nzk, i*(i-1)); /* i*nzk, i*(i-1): estimated and max additional space needed */
3091:       PetscFreeSpaceGet(i,&current_space);
3092:       reallocs++;
3093:     }

3095:     /* copy data into free space, then initialize lnk */
3096:     PetscLLClean(am,am,nzk,lnk,current_space->array,lnkbt);

3098:     /* add the k-th row into il and jl */
3099:     if (nzk-1 > 0) {
3100:       i     = current_space->array[1]; /* col value of the first nonzero element in U(k, k+1:am-1) */
3101:       jl[k] = jl[i]; jl[i] = k;
3102:       il[k] = ui[k] + 1;
3103:     }
3104:     ui_ptr[k] = current_space->array;

3106:     current_space->array           += nzk;
3107:     current_space->local_used      += nzk;
3108:     current_space->local_remaining -= nzk;

3110:     ui[k+1] = ui[k] + nzk;
3111:   }

3113: #if defined(PETSC_USE_INFO)
3114:   if (ai[am] != 0) {
3115:     PetscReal af = (PetscReal)(ui[am])/((PetscReal)ai[am]);
3116:     PetscInfo3(A,"Reallocs %D Fill ratio:given %G needed %G\n",reallocs,fill,af);
3117:     PetscInfo1(A,"Run with -pc_factor_fill %G or use \n",af);
3118:     PetscInfo1(A,"PCFactorSetFill(pc,%G) for best performance.\n",af);
3119:   } else {
3120:     PetscInfo(A,"Empty matrix.\n");
3121:   }
3122: #endif

3124:   ISRestoreIndices(perm,&rip);
3125:   ISRestoreIndices(iperm,&riip);
3126:   PetscFree4(ui_ptr,jl,il,cols);

3128:   /* destroy list of free space and other temporary array(s) */
3129:   PetscMalloc((ui[am]+1)*sizeof(PetscInt),&uj);
3130:   PetscFreeSpaceContiguous(&free_space,uj);
3131:   PetscLLDestroy(lnk,lnkbt);

3133:   /* put together the new matrix in MATSEQSBAIJ format */

3135:   b               = (Mat_SeqSBAIJ*)fact->data;
3136:   b->singlemalloc = PETSC_FALSE;
3137:   b->free_a       = PETSC_TRUE;
3138:   b->free_ij      = PETSC_TRUE;

3140:   PetscMalloc((ui[am]+1)*sizeof(MatScalar),&b->a);

3142:   b->j    = uj;
3143:   b->i    = ui;
3144:   b->diag = 0;
3145:   b->ilen = 0;
3146:   b->imax = 0;
3147:   b->row  = perm;
3148:   b->col  = perm;

3150:   PetscObjectReference((PetscObject)perm);
3151:   PetscObjectReference((PetscObject)perm);

3153:   b->icol          = iperm;
3154:   b->pivotinblocks = PETSC_FALSE; /* need to get from MatFactorInfo */

3156:   PetscMalloc((am+1)*sizeof(PetscScalar),&b->solve_work);
3157:   PetscLogObjectMemory(fact,(ui[am]-am)*(sizeof(PetscInt)+sizeof(MatScalar)));
3158:   b->maxnz = b->nz = ui[am];

3160:   fact->info.factor_mallocs   = reallocs;
3161:   fact->info.fill_ratio_given = fill;
3162:   if (ai[am] != 0) {
3163:     fact->info.fill_ratio_needed = ((PetscReal)ui[am])/((PetscReal)ai[am]);
3164:   } else {
3165:     fact->info.fill_ratio_needed = 0.0;
3166:   }
3167:   fact->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqAIJ_inplace;
3168:   return(0);
3169: }

3173: PetscErrorCode MatSolve_SeqAIJ_NaturalOrdering(Mat A,Vec bb,Vec xx)
3174: {
3175:   Mat_SeqAIJ        *a = (Mat_SeqAIJ*)A->data;
3176:   PetscErrorCode    ierr;
3177:   PetscInt          n   = A->rmap->n;
3178:   const PetscInt    *ai = a->i,*aj = a->j,*adiag = a->diag,*vi;
3179:   PetscScalar       *x,sum;
3180:   const PetscScalar *b;
3181:   const MatScalar   *aa = a->a,*v;
3182:   PetscInt          i,nz;

3185:   if (!n) return(0);

3187:   VecGetArrayRead(bb,&b);
3188:   VecGetArray(xx,&x);

3190:   /* forward solve the lower triangular */
3191:   x[0] = b[0];
3192:   v    = aa;
3193:   vi   = aj;
3194:   for (i=1; i<n; i++) {
3195:     nz  = ai[i+1] - ai[i];
3196:     sum = b[i];
3197:     PetscSparseDenseMinusDot(sum,x,v,vi,nz);
3198:     v   += nz;
3199:     vi  += nz;
3200:     x[i] = sum;
3201:   }

3203:   /* backward solve the upper triangular */
3204:   for (i=n-1; i>=0; i--) {
3205:     v   = aa + adiag[i+1] + 1;
3206:     vi  = aj + adiag[i+1] + 1;
3207:     nz  = adiag[i] - adiag[i+1]-1;
3208:     sum = x[i];
3209:     PetscSparseDenseMinusDot(sum,x,v,vi,nz);
3210:     x[i] = sum*v[nz]; /* x[i]=aa[adiag[i]]*sum; v++; */
3211:   }

3213:   PetscLogFlops(2.0*a->nz - A->cmap->n);
3214:   VecRestoreArrayRead(bb,&b);
3215:   VecRestoreArray(xx,&x);
3216:   return(0);
3217: }

3221: PetscErrorCode MatSolve_SeqAIJ(Mat A,Vec bb,Vec xx)
3222: {
3223:   Mat_SeqAIJ        *a    = (Mat_SeqAIJ*)A->data;
3224:   IS                iscol = a->col,isrow = a->row;
3225:   PetscErrorCode    ierr;
3226:   PetscInt          i,n=A->rmap->n,*vi,*ai=a->i,*aj=a->j,*adiag = a->diag,nz;
3227:   const PetscInt    *rout,*cout,*r,*c;
3228:   PetscScalar       *x,*tmp,sum;
3229:   const PetscScalar *b;
3230:   const MatScalar   *aa = a->a,*v;

3233:   if (!n) return(0);

3235:   VecGetArrayRead(bb,&b);
3236:   VecGetArray(xx,&x);
3237:   tmp  = a->solve_work;

3239:   ISGetIndices(isrow,&rout); r = rout;
3240:   ISGetIndices(iscol,&cout); c = cout;

3242:   /* forward solve the lower triangular */
3243:   tmp[0] = b[r[0]];
3244:   v      = aa;
3245:   vi     = aj;
3246:   for (i=1; i<n; i++) {
3247:     nz  = ai[i+1] - ai[i];
3248:     sum = b[r[i]];
3249:     PetscSparseDenseMinusDot(sum,tmp,v,vi,nz);
3250:     tmp[i] = sum;
3251:     v     += nz; vi += nz;
3252:   }

3254:   /* backward solve the upper triangular */
3255:   for (i=n-1; i>=0; i--) {
3256:     v   = aa + adiag[i+1]+1;
3257:     vi  = aj + adiag[i+1]+1;
3258:     nz  = adiag[i]-adiag[i+1]-1;
3259:     sum = tmp[i];
3260:     PetscSparseDenseMinusDot(sum,tmp,v,vi,nz);
3261:     x[c[i]] = tmp[i] = sum*v[nz]; /* v[nz] = aa[adiag[i]] */
3262:   }

3264:   ISRestoreIndices(isrow,&rout);
3265:   ISRestoreIndices(iscol,&cout);
3266:   VecRestoreArrayRead(bb,&b);
3267:   VecRestoreArray(xx,&x);
3268:   PetscLogFlops(2*a->nz - A->cmap->n);
3269:   return(0);
3270: }

3274: /*
3275:     This will get a new name and become a varient of MatILUFactor_SeqAIJ() there is no longer seperate functions in the matrix function table for dt factors
3276: */
3277: PetscErrorCode MatILUDTFactor_SeqAIJ(Mat A,IS isrow,IS iscol,const MatFactorInfo *info,Mat *fact)
3278: {
3279:   Mat            B = *fact;
3280:   Mat_SeqAIJ     *a=(Mat_SeqAIJ*)A->data,*b;
3281:   IS             isicol;
3283:   const PetscInt *r,*ic;
3284:   PetscInt       i,n=A->rmap->n,*ai=a->i,*aj=a->j,*ajtmp,*adiag;
3285:   PetscInt       *bi,*bj,*bdiag,*bdiag_rev;
3286:   PetscInt       row,nzi,nzi_bl,nzi_bu,*im,nzi_al,nzi_au;
3287:   PetscInt       nlnk,*lnk;
3288:   PetscBT        lnkbt;
3289:   PetscBool      row_identity,icol_identity;
3290:   MatScalar      *aatmp,*pv,*batmp,*ba,*rtmp,*pc,multiplier,*vtmp,diag_tmp;
3291:   const PetscInt *ics;
3292:   PetscInt       j,nz,*pj,*bjtmp,k,ncut,*jtmp;
3293:   PetscReal      dt     =info->dt,shift=info->shiftamount;
3294:   PetscInt       dtcount=(PetscInt)info->dtcount,nnz_max;
3295:   PetscBool      missing;

3298:   if (dt      == PETSC_DEFAULT) dt = 0.005;
3299:   if (dtcount == PETSC_DEFAULT) dtcount = (PetscInt)(1.5*a->rmax);

3301:   /* ------- symbolic factorization, can be reused ---------*/
3302:   MatMissingDiagonal(A,&missing,&i);
3303:   if (missing) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",i);
3304:   adiag=a->diag;

3306:   ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);

3308:   /* bdiag is location of diagonal in factor */
3309:   PetscMalloc((n+1)*sizeof(PetscInt),&bdiag);     /* becomes b->diag */
3310:   PetscMalloc((n+1)*sizeof(PetscInt),&bdiag_rev); /* temporary */

3312:   /* allocate row pointers bi */
3313:   PetscMalloc((2*n+2)*sizeof(PetscInt),&bi);

3315:   /* allocate bj and ba; max num of nonzero entries is (ai[n]+2*n*dtcount+2) */
3316:   if (dtcount > n-1) dtcount = n-1; /* diagonal is excluded */
3317:   nnz_max = ai[n]+2*n*dtcount+2;

3319:   PetscMalloc((nnz_max+1)*sizeof(PetscInt),&bj);
3320:   PetscMalloc((nnz_max+1)*sizeof(MatScalar),&ba);

3322:   /* put together the new matrix */
3323:   MatSeqAIJSetPreallocation_SeqAIJ(B,MAT_SKIP_ALLOCATION,NULL);
3324:   PetscLogObjectParent(B,isicol);
3325:   b    = (Mat_SeqAIJ*)B->data;

3327:   b->free_a       = PETSC_TRUE;
3328:   b->free_ij      = PETSC_TRUE;
3329:   b->singlemalloc = PETSC_FALSE;

3331:   b->a    = ba;
3332:   b->j    = bj;
3333:   b->i    = bi;
3334:   b->diag = bdiag;
3335:   b->ilen = 0;
3336:   b->imax = 0;
3337:   b->row  = isrow;
3338:   b->col  = iscol;
3339:   PetscObjectReference((PetscObject)isrow);
3340:   PetscObjectReference((PetscObject)iscol);
3341:   b->icol = isicol;

3343:   PetscMalloc((n+1)*sizeof(PetscScalar),&b->solve_work);
3344:   PetscLogObjectMemory(B,nnz_max*(sizeof(PetscInt)+sizeof(MatScalar)));
3345:   b->maxnz = nnz_max;

3347:   B->factortype            = MAT_FACTOR_ILUDT;
3348:   B->info.factor_mallocs   = 0;
3349:   B->info.fill_ratio_given = ((PetscReal)nnz_max)/((PetscReal)ai[n]);
3350:   /* ------- end of symbolic factorization ---------*/

3352:   ISGetIndices(isrow,&r);
3353:   ISGetIndices(isicol,&ic);
3354:   ics  = ic;

3356:   /* linked list for storing column indices of the active row */
3357:   nlnk = n + 1;
3358:   PetscLLCreate(n,n,nlnk,lnk,lnkbt);

3360:   /* im: used by PetscLLAddSortedLU(); jtmp: working array for column indices of active row */
3361:   PetscMalloc2(n,PetscInt,&im,n,PetscInt,&jtmp);
3362:   /* rtmp, vtmp: working arrays for sparse and contiguous row entries of active row */
3363:   PetscMalloc2(n,MatScalar,&rtmp,n,MatScalar,&vtmp);
3364:   PetscMemzero(rtmp,n*sizeof(MatScalar));

3366:   bi[0]        = 0;
3367:   bdiag[0]     = nnz_max-1; /* location of diag[0] in factor B */
3368:   bdiag_rev[n] = bdiag[0];
3369:   bi[2*n+1]    = bdiag[0]+1; /* endof bj and ba array */
3370:   for (i=0; i<n; i++) {
3371:     /* copy initial fill into linked list */
3372:     nzi = ai[r[i]+1] - ai[r[i]];
3373:     if (!nzi) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Empty row in matrix: row in original ordering %D in permuted ordering %D",r[i],i);
3374:     nzi_al = adiag[r[i]] - ai[r[i]];
3375:     nzi_au = ai[r[i]+1] - adiag[r[i]] -1;
3376:     ajtmp  = aj + ai[r[i]];
3377:     PetscLLAddPerm(nzi,ajtmp,ic,n,nlnk,lnk,lnkbt);

3379:     /* load in initial (unfactored row) */
3380:     aatmp = a->a + ai[r[i]];
3381:     for (j=0; j<nzi; j++) {
3382:       rtmp[ics[*ajtmp++]] = *aatmp++;
3383:     }

3385:     /* add pivot rows into linked list */
3386:     row = lnk[n];
3387:     while (row < i) {
3388:       nzi_bl = bi[row+1] - bi[row] + 1;
3389:       bjtmp  = bj + bdiag[row+1]+1; /* points to 1st column next to the diagonal in U */
3390:       PetscLLAddSortedLU(bjtmp,row,nlnk,lnk,lnkbt,i,nzi_bl,im);
3391:       nzi   += nlnk;
3392:       row    = lnk[row];
3393:     }

3395:     /* copy data from lnk into jtmp, then initialize lnk */
3396:     PetscLLClean(n,n,nzi,lnk,jtmp,lnkbt);

3398:     /* numerical factorization */
3399:     bjtmp = jtmp;
3400:     row   = *bjtmp++; /* 1st pivot row */
3401:     while (row < i) {
3402:       pc         = rtmp + row;
3403:       pv         = ba + bdiag[row]; /* 1./(diag of the pivot row) */
3404:       multiplier = (*pc) * (*pv);
3405:       *pc        = multiplier;
3406:       if (PetscAbsScalar(*pc) > dt) { /* apply tolerance dropping rule */
3407:         pj = bj + bdiag[row+1] + 1;         /* point to 1st entry of U(row,:) */
3408:         pv = ba + bdiag[row+1] + 1;
3409:         /* if (multiplier < -1.0 or multiplier >1.0) printf("row/prow %d, %d, multiplier %g\n",i,row,multiplier); */
3410:         nz = bdiag[row] - bdiag[row+1] - 1;         /* num of entries in U(row,:), excluding diagonal */
3411:         for (j=0; j<nz; j++) rtmp[*pj++] -= multiplier * (*pv++);
3412:         PetscLogFlops(1+2*nz);
3413:       }
3414:       row = *bjtmp++;
3415:     }

3417:     /* copy sparse rtmp into contiguous vtmp; separate L and U part */
3418:     diag_tmp = rtmp[i];  /* save diagonal value - may not needed?? */
3419:     nzi_bl   = 0; j = 0;
3420:     while (jtmp[j] < i) { /* Note: jtmp is sorted */
3421:       vtmp[j] = rtmp[jtmp[j]]; rtmp[jtmp[j]]=0.0;
3422:       nzi_bl++; j++;
3423:     }
3424:     nzi_bu = nzi - nzi_bl -1;
3425:     while (j < nzi) {
3426:       vtmp[j] = rtmp[jtmp[j]]; rtmp[jtmp[j]]=0.0;
3427:       j++;
3428:     }

3430:     bjtmp = bj + bi[i];
3431:     batmp = ba + bi[i];
3432:     /* apply level dropping rule to L part */
3433:     ncut = nzi_al + dtcount;
3434:     if (ncut < nzi_bl) {
3435:       PetscSortSplit(ncut,nzi_bl,vtmp,jtmp);
3436:       PetscSortIntWithScalarArray(ncut,jtmp,vtmp);
3437:     } else {
3438:       ncut = nzi_bl;
3439:     }
3440:     for (j=0; j<ncut; j++) {
3441:       bjtmp[j] = jtmp[j];
3442:       batmp[j] = vtmp[j];
3443:       /* printf(" (%d,%g),",bjtmp[j],batmp[j]); */
3444:     }
3445:     bi[i+1] = bi[i] + ncut;
3446:     nzi     = ncut + 1;

3448:     /* apply level dropping rule to U part */
3449:     ncut = nzi_au + dtcount;
3450:     if (ncut < nzi_bu) {
3451:       PetscSortSplit(ncut,nzi_bu,vtmp+nzi_bl+1,jtmp+nzi_bl+1);
3452:       PetscSortIntWithScalarArray(ncut,jtmp+nzi_bl+1,vtmp+nzi_bl+1);
3453:     } else {
3454:       ncut = nzi_bu;
3455:     }
3456:     nzi += ncut;

3458:     /* mark bdiagonal */
3459:     bdiag[i+1]       = bdiag[i] - (ncut + 1);
3460:     bdiag_rev[n-i-1] = bdiag[i+1];
3461:     bi[2*n - i]      = bi[2*n - i +1] - (ncut + 1);
3462:     bjtmp            = bj + bdiag[i];
3463:     batmp            = ba + bdiag[i];
3464:     *bjtmp           = i;
3465:     *batmp           = diag_tmp; /* rtmp[i]; */
3466:     if (*batmp == 0.0) {
3467:       *batmp = dt+shift;
3468:       /* printf(" row %d add shift %g\n",i,shift); */
3469:     }
3470:     *batmp = 1.0/(*batmp); /* invert diagonal entries for simplier triangular solves */
3471:     /* printf(" (%d,%g),",*bjtmp,*batmp); */

3473:     bjtmp = bj + bdiag[i+1]+1;
3474:     batmp = ba + bdiag[i+1]+1;
3475:     for (k=0; k<ncut; k++) {
3476:       bjtmp[k] = jtmp[nzi_bl+1+k];
3477:       batmp[k] = vtmp[nzi_bl+1+k];
3478:       /* printf(" (%d,%g),",bjtmp[k],batmp[k]); */
3479:     }
3480:     /* printf("\n"); */

3482:     im[i] = nzi;   /* used by PetscLLAddSortedLU() */
3483:     /*
3484:     printf("row %d: bi %d, bdiag %d\n",i,bi[i],bdiag[i]);
3485:     printf(" ----------------------------\n");
3486:     */
3487:   } /* for (i=0; i<n; i++) */
3488:     /* printf("end of L %d, beginning of U %d\n",bi[n],bdiag[n]); */
3489:   if (bi[n] >= bdiag[n]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"end of L array %d cannot >= the beginning of U array %d",bi[n],bdiag[n]);

3491:   ISRestoreIndices(isrow,&r);
3492:   ISRestoreIndices(isicol,&ic);

3494:   PetscLLDestroy(lnk,lnkbt);
3495:   PetscFree2(im,jtmp);
3496:   PetscFree2(rtmp,vtmp);
3497:   PetscFree(bdiag_rev);

3499:   PetscLogFlops(B->cmap->n);
3500:   b->maxnz = b->nz = bi[n] + bdiag[0] - bdiag[n];

3502:   ISIdentity(isrow,&row_identity);
3503:   ISIdentity(isicol,&icol_identity);
3504:   if (row_identity && icol_identity) {
3505:     B->ops->solve = MatSolve_SeqAIJ_NaturalOrdering;
3506:   } else {
3507:     B->ops->solve = MatSolve_SeqAIJ;
3508:   }

3510:   B->ops->solveadd          = 0;
3511:   B->ops->solvetranspose    = 0;
3512:   B->ops->solvetransposeadd = 0;
3513:   B->ops->matsolve          = 0;
3514:   B->assembled              = PETSC_TRUE;
3515:   B->preallocated           = PETSC_TRUE;
3516:   return(0);
3517: }

3519: /* a wraper of MatILUDTFactor_SeqAIJ() */
3522: /*
3523:     This will get a new name and become a varient of MatILUFactor_SeqAIJ() there is no longer seperate functions in the matrix function table for dt factors
3524: */

3526: PetscErrorCode  MatILUDTFactorSymbolic_SeqAIJ(Mat fact,Mat A,IS row,IS col,const MatFactorInfo *info)
3527: {

3531:   MatILUDTFactor_SeqAIJ(A,row,col,info,&fact);
3532:   return(0);
3533: }

3535: /*
3536:    same as MatLUFactorNumeric_SeqAIJ(), except using contiguous array matrix factors
3537:    - intend to replace existing MatLUFactorNumeric_SeqAIJ()
3538: */
3541: /*
3542:     This will get a new name and become a varient of MatILUFactor_SeqAIJ() there is no longer seperate functions in the matrix function table for dt factors
3543: */

3545: PetscErrorCode  MatILUDTFactorNumeric_SeqAIJ(Mat fact,Mat A,const MatFactorInfo *info)
3546: {
3547:   Mat            C     =fact;
3548:   Mat_SeqAIJ     *a    =(Mat_SeqAIJ*)A->data,*b=(Mat_SeqAIJ*)C->data;
3549:   IS             isrow = b->row,isicol = b->icol;
3551:   const PetscInt *r,*ic,*ics;
3552:   PetscInt       i,j,k,n=A->rmap->n,*ai=a->i,*aj=a->j,*bi=b->i,*bj=b->j;
3553:   PetscInt       *ajtmp,*bjtmp,nz,nzl,nzu,row,*bdiag = b->diag,*pj;
3554:   MatScalar      *rtmp,*pc,multiplier,*v,*pv,*aa=a->a;
3555:   PetscReal      dt=info->dt,shift=info->shiftamount;
3556:   PetscBool      row_identity, col_identity;

3559:   ISGetIndices(isrow,&r);
3560:   ISGetIndices(isicol,&ic);
3561:   PetscMalloc((n+1)*sizeof(MatScalar),&rtmp);
3562:   ics  = ic;

3564:   for (i=0; i<n; i++) {
3565:     /* initialize rtmp array */
3566:     nzl   = bi[i+1] - bi[i];       /* num of nozeros in L(i,:) */
3567:     bjtmp = bj + bi[i];
3568:     for  (j=0; j<nzl; j++) rtmp[*bjtmp++] = 0.0;
3569:     rtmp[i] = 0.0;
3570:     nzu     = bdiag[i] - bdiag[i+1]; /* num of nozeros in U(i,:) */
3571:     bjtmp   = bj + bdiag[i+1] + 1;
3572:     for  (j=0; j<nzu; j++) rtmp[*bjtmp++] = 0.0;

3574:     /* load in initial unfactored row of A */
3575:     /* printf("row %d\n",i); */
3576:     nz    = ai[r[i]+1] - ai[r[i]];
3577:     ajtmp = aj + ai[r[i]];
3578:     v     = aa + ai[r[i]];
3579:     for (j=0; j<nz; j++) {
3580:       rtmp[ics[*ajtmp++]] = v[j];
3581:       /* printf(" (%d,%g),",ics[ajtmp[j]],rtmp[ics[ajtmp[j]]]); */
3582:     }
3583:     /* printf("\n"); */

3585:     /* numerical factorization */
3586:     bjtmp = bj + bi[i]; /* point to 1st entry of L(i,:) */
3587:     nzl   = bi[i+1] - bi[i]; /* num of entries in L(i,:) */
3588:     k     = 0;
3589:     while (k < nzl) {
3590:       row = *bjtmp++;
3591:       /* printf("  prow %d\n",row); */
3592:       pc         = rtmp + row;
3593:       pv         = b->a + bdiag[row]; /* 1./(diag of the pivot row) */
3594:       multiplier = (*pc) * (*pv);
3595:       *pc        = multiplier;
3596:       if (PetscAbsScalar(multiplier) > dt) {
3597:         pj = bj + bdiag[row+1] + 1;         /* point to 1st entry of U(row,:) */
3598:         pv = b->a + bdiag[row+1] + 1;
3599:         nz = bdiag[row] - bdiag[row+1] - 1;         /* num of entries in U(row,:), excluding diagonal */
3600:         for (j=0; j<nz; j++) rtmp[*pj++] -= multiplier * (*pv++);
3601:         PetscLogFlops(1+2*nz);
3602:       }
3603:       k++;
3604:     }

3606:     /* finished row so stick it into b->a */
3607:     /* L-part */
3608:     pv  = b->a + bi[i];
3609:     pj  = bj + bi[i];
3610:     nzl = bi[i+1] - bi[i];
3611:     for (j=0; j<nzl; j++) {
3612:       pv[j] = rtmp[pj[j]];
3613:       /* printf(" (%d,%g),",pj[j],pv[j]); */
3614:     }

3616:     /* diagonal: invert diagonal entries for simplier triangular solves */
3617:     if (rtmp[i] == 0.0) rtmp[i] = dt+shift;
3618:     b->a[bdiag[i]] = 1.0/rtmp[i];
3619:     /* printf(" (%d,%g),",i,b->a[bdiag[i]]); */

3621:     /* U-part */
3622:     pv  = b->a + bdiag[i+1] + 1;
3623:     pj  = bj + bdiag[i+1] + 1;
3624:     nzu = bdiag[i] - bdiag[i+1] - 1;
3625:     for (j=0; j<nzu; j++) {
3626:       pv[j] = rtmp[pj[j]];
3627:       /* printf(" (%d,%g),",pj[j],pv[j]); */
3628:     }
3629:     /* printf("\n"); */
3630:   }

3632:   PetscFree(rtmp);
3633:   ISRestoreIndices(isicol,&ic);
3634:   ISRestoreIndices(isrow,&r);

3636:   ISIdentity(isrow,&row_identity);
3637:   ISIdentity(isicol,&col_identity);
3638:   if (row_identity && col_identity) {
3639:     C->ops->solve = MatSolve_SeqAIJ_NaturalOrdering;
3640:   } else {
3641:     C->ops->solve = MatSolve_SeqAIJ;
3642:   }
3643:   C->ops->solveadd          = 0;
3644:   C->ops->solvetranspose    = 0;
3645:   C->ops->solvetransposeadd = 0;
3646:   C->ops->matsolve          = 0;
3647:   C->assembled              = PETSC_TRUE;
3648:   C->preallocated           = PETSC_TRUE;

3650:   PetscLogFlops(C->cmap->n);
3651:   return(0);
3652: }