Actual source code: baijfact.c

petsc-3.5.1 2014-07-24
Report Typos and Errors
  2: /*
  3:     Factorization code for BAIJ format.
  4: */
  5: #include <../src/mat/impls/baij/seq/baij.h>
  6: #include <petsc-private/kernels/blockinvert.h>

 10: PetscErrorCode MatLUFactorNumeric_SeqBAIJ_2(Mat B,Mat A,const MatFactorInfo *info)
 11: {
 12:   Mat            C     =B;
 13:   Mat_SeqBAIJ    *a    =(Mat_SeqBAIJ*)A->data,*b=(Mat_SeqBAIJ*)C->data;
 14:   IS             isrow = b->row,isicol = b->icol;
 16:   const PetscInt *r,*ic;
 17:   PetscInt       i,j,k,nz,nzL,row,*pj;
 18:   const PetscInt n=a->mbs,*ai=a->i,*aj=a->j,*bi=b->i,*bj=b->j,bs2=a->bs2;
 19:   const PetscInt *ajtmp,*bjtmp,*bdiag=b->diag;
 20:   MatScalar      *rtmp,*pc,*mwork,*pv;
 21:   MatScalar      *aa=a->a,*v;
 22:   PetscInt       flg;
 23:   PetscReal      shift = info->shiftamount;

 26:   ISGetIndices(isrow,&r);
 27:   ISGetIndices(isicol,&ic);

 29:   /* generate work space needed by the factorization */
 30:   PetscMalloc2(bs2*n,&rtmp,bs2,&mwork);
 31:   PetscMemzero(rtmp,bs2*n*sizeof(MatScalar));

 33:   for (i=0; i<n; i++) {
 34:     /* zero rtmp */
 35:     /* L part */
 36:     nz    = bi[i+1] - bi[i];
 37:     bjtmp = bj + bi[i];
 38:     for  (j=0; j<nz; j++) {
 39:       PetscMemzero(rtmp+bs2*bjtmp[j],bs2*sizeof(MatScalar));
 40:     }

 42:     /* U part */
 43:     nz    = bdiag[i] - bdiag[i+1];
 44:     bjtmp = bj + bdiag[i+1]+1;
 45:     for  (j=0; j<nz; j++) {
 46:       PetscMemzero(rtmp+bs2*bjtmp[j],bs2*sizeof(MatScalar));
 47:     }

 49:     /* load in initial (unfactored row) */
 50:     nz    = ai[r[i]+1] - ai[r[i]];
 51:     ajtmp = aj + ai[r[i]];
 52:     v     = aa + bs2*ai[r[i]];
 53:     for (j=0; j<nz; j++) {
 54:       PetscMemcpy(rtmp+bs2*ic[ajtmp[j]],v+bs2*j,bs2*sizeof(MatScalar));
 55:     }

 57:     /* elimination */
 58:     bjtmp = bj + bi[i];
 59:     nzL   = bi[i+1] - bi[i];
 60:     for (k=0; k < nzL; k++) {
 61:       row = bjtmp[k];
 62:       pc  = rtmp + bs2*row;
 63:       for (flg=0,j=0; j<bs2; j++) {
 64:         if (pc[j] != (PetscScalar)0.0) {
 65:           flg = 1;
 66:           break;
 67:         }
 68:       }
 69:       if (flg) {
 70:         pv = b->a + bs2*bdiag[row];
 71:         /* PetscKernel_A_gets_A_times_B(bs,pc,pv,mwork); *pc = *pc * (*pv); */
 72:         PetscKernel_A_gets_A_times_B_2(pc,pv,mwork);

 74:         pj = b->j + bdiag[row+1]+1; /* begining of U(row,:) */
 75:         pv = b->a + bs2*(bdiag[row+1]+1);
 76:         nz = bdiag[row] - bdiag[row+1] - 1; /* num of entries inU(row,:), excluding diag */
 77:         for (j=0; j<nz; j++) {
 78:           /* PetscKernel_A_gets_A_minus_B_times_C(bs,rtmp+bs2*pj[j],pc,pv+bs2*j); */
 79:           /* rtmp+bs2*pj[j] = rtmp+bs2*pj[j] - (*pc)*(pv+bs2*j) */
 80:           v    = rtmp + 4*pj[j];
 81:           PetscKernel_A_gets_A_minus_B_times_C_2(v,pc,pv);
 82:           pv  += 4;
 83:         }
 84:         PetscLogFlops(16*nz+12); /* flops = 2*bs^3*nz + 2*bs^3 - bs2) */
 85:       }
 86:     }

 88:     /* finished row so stick it into b->a */
 89:     /* L part */
 90:     pv = b->a + bs2*bi[i];
 91:     pj = b->j + bi[i];
 92:     nz = bi[i+1] - bi[i];
 93:     for (j=0; j<nz; j++) {
 94:       PetscMemcpy(pv+bs2*j,rtmp+bs2*pj[j],bs2*sizeof(MatScalar));
 95:     }

 97:     /* Mark diagonal and invert diagonal for simplier triangular solves */
 98:     pv   = b->a + bs2*bdiag[i];
 99:     pj   = b->j + bdiag[i];
100:     PetscMemcpy(pv,rtmp+bs2*pj[0],bs2*sizeof(MatScalar));
101:     /* PetscKernel_A_gets_inverse_A(bs,pv,v_pivots,v_work); */
102:     PetscKernel_A_gets_inverse_A_2(pv,shift);

104:     /* U part */
105:     pv = b->a + bs2*(bdiag[i+1]+1);
106:     pj = b->j + bdiag[i+1]+1;
107:     nz = bdiag[i] - bdiag[i+1] - 1;
108:     for (j=0; j<nz; j++) {
109:       PetscMemcpy(pv+bs2*j,rtmp+bs2*pj[j],bs2*sizeof(MatScalar));
110:     }
111:   }

113:   PetscFree2(rtmp,mwork);
114:   ISRestoreIndices(isicol,&ic);
115:   ISRestoreIndices(isrow,&r);

117:   C->ops->solve          = MatSolve_SeqBAIJ_2;
118:   C->ops->solvetranspose = MatSolveTranspose_SeqBAIJ_2;
119:   C->assembled           = PETSC_TRUE;

121:   PetscLogFlops(1.333333333333*2*2*2*n); /* from inverting diagonal blocks */
122:   return(0);
123: }

127: PetscErrorCode MatLUFactorNumeric_SeqBAIJ_2_NaturalOrdering(Mat B,Mat A,const MatFactorInfo *info)
128: {
129:   Mat            C =B;
130:   Mat_SeqBAIJ    *a=(Mat_SeqBAIJ*)A->data,*b=(Mat_SeqBAIJ*)C->data;
132:   PetscInt       i,j,k,nz,nzL,row,*pj;
133:   const PetscInt n=a->mbs,*ai=a->i,*aj=a->j,*bi=b->i,*bj=b->j,bs2=a->bs2;
134:   const PetscInt *ajtmp,*bjtmp,*bdiag=b->diag;
135:   MatScalar      *rtmp,*pc,*mwork,*pv;
136:   MatScalar      *aa=a->a,*v;
137:   PetscInt       flg;
138:   PetscReal      shift = info->shiftamount;

141:   /* generate work space needed by the factorization */
142:   PetscMalloc2(bs2*n,&rtmp,bs2,&mwork);
143:   PetscMemzero(rtmp,bs2*n*sizeof(MatScalar));

145:   for (i=0; i<n; i++) {
146:     /* zero rtmp */
147:     /* L part */
148:     nz    = bi[i+1] - bi[i];
149:     bjtmp = bj + bi[i];
150:     for  (j=0; j<nz; j++) {
151:       PetscMemzero(rtmp+bs2*bjtmp[j],bs2*sizeof(MatScalar));
152:     }

154:     /* U part */
155:     nz    = bdiag[i] - bdiag[i+1];
156:     bjtmp = bj + bdiag[i+1]+1;
157:     for  (j=0; j<nz; j++) {
158:       PetscMemzero(rtmp+bs2*bjtmp[j],bs2*sizeof(MatScalar));
159:     }

161:     /* load in initial (unfactored row) */
162:     nz    = ai[i+1] - ai[i];
163:     ajtmp = aj + ai[i];
164:     v     = aa + bs2*ai[i];
165:     for (j=0; j<nz; j++) {
166:       PetscMemcpy(rtmp+bs2*ajtmp[j],v+bs2*j,bs2*sizeof(MatScalar));
167:     }

169:     /* elimination */
170:     bjtmp = bj + bi[i];
171:     nzL   = bi[i+1] - bi[i];
172:     for (k=0; k < nzL; k++) {
173:       row = bjtmp[k];
174:       pc  = rtmp + bs2*row;
175:       for (flg=0,j=0; j<bs2; j++) {
176:         if (pc[j]!=(PetscScalar)0.0) {
177:           flg = 1;
178:           break;
179:         }
180:       }
181:       if (flg) {
182:         pv = b->a + bs2*bdiag[row];
183:         /* PetscKernel_A_gets_A_times_B(bs,pc,pv,mwork); *pc = *pc * (*pv); */
184:         PetscKernel_A_gets_A_times_B_2(pc,pv,mwork);

186:         pj = b->j + bdiag[row+1]+1; /* beginning of U(row,:) */
187:         pv = b->a + bs2*(bdiag[row+1]+1);
188:         nz = bdiag[row]-bdiag[row+1] - 1; /* num of entries in U(row,:) excluding diag */
189:         for (j=0; j<nz; j++) {
190:           /* PetscKernel_A_gets_A_minus_B_times_C(bs,rtmp+bs2*pj[j],pc,pv+bs2*j); */
191:           /* rtmp+bs2*pj[j] = rtmp+bs2*pj[j] - (*pc)*(pv+bs2*j) */
192:           v    = rtmp + 4*pj[j];
193:           PetscKernel_A_gets_A_minus_B_times_C_2(v,pc,pv);
194:           pv  += 4;
195:         }
196:         PetscLogFlops(16*nz+12); /* flops = 2*bs^3*nz + 2*bs^3 - bs2) */
197:       }
198:     }

200:     /* finished row so stick it into b->a */
201:     /* L part */
202:     pv = b->a + bs2*bi[i];
203:     pj = b->j + bi[i];
204:     nz = bi[i+1] - bi[i];
205:     for (j=0; j<nz; j++) {
206:       PetscMemcpy(pv+bs2*j,rtmp+bs2*pj[j],bs2*sizeof(MatScalar));
207:     }

209:     /* Mark diagonal and invert diagonal for simplier triangular solves */
210:     pv   = b->a + bs2*bdiag[i];
211:     pj   = b->j + bdiag[i];
212:     PetscMemcpy(pv,rtmp+bs2*pj[0],bs2*sizeof(MatScalar));
213:     /* PetscKernel_A_gets_inverse_A(bs,pv,v_pivots,v_work); */
214:     PetscKernel_A_gets_inverse_A_2(pv,shift);

216:     /* U part */
217:     /*
218:     pv = b->a + bs2*bi[2*n-i];
219:     pj = b->j + bi[2*n-i];
220:     nz = bi[2*n-i+1] - bi[2*n-i] - 1;
221:     */
222:     pv = b->a + bs2*(bdiag[i+1]+1);
223:     pj = b->j + bdiag[i+1]+1;
224:     nz = bdiag[i] - bdiag[i+1] - 1;
225:     for (j=0; j<nz; j++) {
226:       PetscMemcpy(pv+bs2*j,rtmp+bs2*pj[j],bs2*sizeof(MatScalar));
227:     }
228:   }
229:   PetscFree2(rtmp,mwork);

231:   C->ops->solve          = MatSolve_SeqBAIJ_2_NaturalOrdering;
232:   C->ops->solvetranspose = MatSolveTranspose_SeqBAIJ_2_NaturalOrdering;
233:   C->assembled           = PETSC_TRUE;

235:   PetscLogFlops(1.333333333333*2*2*2*n); /* from inverting diagonal blocks */
236:   return(0);
237: }

241: PetscErrorCode MatLUFactorNumeric_SeqBAIJ_2_inplace(Mat B,Mat A,const MatFactorInfo *info)
242: {
243:   Mat            C     = B;
244:   Mat_SeqBAIJ    *a    = (Mat_SeqBAIJ*)A->data,*b = (Mat_SeqBAIJ*)C->data;
245:   IS             isrow = b->row,isicol = b->icol;
247:   const PetscInt *r,*ic;
248:   PetscInt       i,j,n = a->mbs,*bi = b->i,*bj = b->j;
249:   PetscInt       *ajtmpold,*ajtmp,nz,row;
250:   PetscInt       *diag_offset=b->diag,idx,*ai=a->i,*aj=a->j,*pj;
251:   MatScalar      *pv,*v,*rtmp,m1,m2,m3,m4,*pc,*w,*x,x1,x2,x3,x4;
252:   MatScalar      p1,p2,p3,p4;
253:   MatScalar      *ba   = b->a,*aa = a->a;
254:   PetscReal      shift = info->shiftamount;

257:   ISGetIndices(isrow,&r);
258:   ISGetIndices(isicol,&ic);
259:   PetscMalloc1(4*(n+1),&rtmp);

261:   for (i=0; i<n; i++) {
262:     nz    = bi[i+1] - bi[i];
263:     ajtmp = bj + bi[i];
264:     for  (j=0; j<nz; j++) {
265:       x = rtmp+4*ajtmp[j]; x[0] = x[1] = x[2] = x[3] = 0.0;
266:     }
267:     /* load in initial (unfactored row) */
268:     idx      = r[i];
269:     nz       = ai[idx+1] - ai[idx];
270:     ajtmpold = aj + ai[idx];
271:     v        = aa + 4*ai[idx];
272:     for (j=0; j<nz; j++) {
273:       x    = rtmp+4*ic[ajtmpold[j]];
274:       x[0] = v[0]; x[1] = v[1]; x[2] = v[2]; x[3] = v[3];
275:       v   += 4;
276:     }
277:     row = *ajtmp++;
278:     while (row < i) {
279:       pc = rtmp + 4*row;
280:       p1 = pc[0]; p2 = pc[1]; p3 = pc[2]; p4 = pc[3];
281:       if (p1 != (PetscScalar)0.0 || p2 != (PetscScalar)0.0 || p3 != (PetscScalar)0.0 || p4 != (PetscScalar)0.0) {
282:         pv    = ba + 4*diag_offset[row];
283:         pj    = bj + diag_offset[row] + 1;
284:         x1    = pv[0]; x2 = pv[1]; x3 = pv[2]; x4 = pv[3];
285:         pc[0] = m1 = p1*x1 + p3*x2;
286:         pc[1] = m2 = p2*x1 + p4*x2;
287:         pc[2] = m3 = p1*x3 + p3*x4;
288:         pc[3] = m4 = p2*x3 + p4*x4;
289:         nz    = bi[row+1] - diag_offset[row] - 1;
290:         pv   += 4;
291:         for (j=0; j<nz; j++) {
292:           x1    = pv[0]; x2 = pv[1]; x3 = pv[2]; x4 = pv[3];
293:           x     = rtmp + 4*pj[j];
294:           x[0] -= m1*x1 + m3*x2;
295:           x[1] -= m2*x1 + m4*x2;
296:           x[2] -= m1*x3 + m3*x4;
297:           x[3] -= m2*x3 + m4*x4;
298:           pv   += 4;
299:         }
300:         PetscLogFlops(16.0*nz+12.0);
301:       }
302:       row = *ajtmp++;
303:     }
304:     /* finished row so stick it into b->a */
305:     pv = ba + 4*bi[i];
306:     pj = bj + bi[i];
307:     nz = bi[i+1] - bi[i];
308:     for (j=0; j<nz; j++) {
309:       x     = rtmp+4*pj[j];
310:       pv[0] = x[0]; pv[1] = x[1]; pv[2] = x[2]; pv[3] = x[3];
311:       pv   += 4;
312:     }
313:     /* invert diagonal block */
314:     w    = ba + 4*diag_offset[i];
315:     PetscKernel_A_gets_inverse_A_2(w,shift);
316:   }

318:   PetscFree(rtmp);
319:   ISRestoreIndices(isicol,&ic);
320:   ISRestoreIndices(isrow,&r);

322:   C->ops->solve          = MatSolve_SeqBAIJ_2_inplace;
323:   C->ops->solvetranspose = MatSolveTranspose_SeqBAIJ_2_inplace;
324:   C->assembled           = PETSC_TRUE;

326:   PetscLogFlops(1.333333333333*8*b->mbs); /* from inverting diagonal blocks */
327:   return(0);
328: }
329: /*
330:       Version for when blocks are 2 by 2 Using natural ordering
331: */
334: PetscErrorCode MatLUFactorNumeric_SeqBAIJ_2_NaturalOrdering_inplace(Mat C,Mat A,const MatFactorInfo *info)
335: {
336:   Mat_SeqBAIJ    *a = (Mat_SeqBAIJ*)A->data,*b = (Mat_SeqBAIJ*)C->data;
338:   PetscInt       i,j,n = a->mbs,*bi = b->i,*bj = b->j;
339:   PetscInt       *ajtmpold,*ajtmp,nz,row;
340:   PetscInt       *diag_offset = b->diag,*ai=a->i,*aj=a->j,*pj;
341:   MatScalar      *pv,*v,*rtmp,*pc,*w,*x;
342:   MatScalar      p1,p2,p3,p4,m1,m2,m3,m4,x1,x2,x3,x4;
343:   MatScalar      *ba   = b->a,*aa = a->a;
344:   PetscReal      shift = info->shiftamount;

347:   PetscMalloc1(4*(n+1),&rtmp);
348:   for (i=0; i<n; i++) {
349:     nz    = bi[i+1] - bi[i];
350:     ajtmp = bj + bi[i];
351:     for  (j=0; j<nz; j++) {
352:       x    = rtmp+4*ajtmp[j];
353:       x[0] = x[1]  = x[2]  = x[3]  = 0.0;
354:     }
355:     /* load in initial (unfactored row) */
356:     nz       = ai[i+1] - ai[i];
357:     ajtmpold = aj + ai[i];
358:     v        = aa + 4*ai[i];
359:     for (j=0; j<nz; j++) {
360:       x    = rtmp+4*ajtmpold[j];
361:       x[0] = v[0];  x[1]  = v[1];  x[2]  = v[2];  x[3]  = v[3];
362:       v   += 4;
363:     }
364:     row = *ajtmp++;
365:     while (row < i) {
366:       pc = rtmp + 4*row;
367:       p1 = pc[0];  p2  = pc[1];  p3  = pc[2];  p4  = pc[3];
368:       if (p1 != (PetscScalar)0.0 || p2 != (PetscScalar)0.0 || p3 != (PetscScalar)0.0 || p4 != (PetscScalar)0.0) {
369:         pv    = ba + 4*diag_offset[row];
370:         pj    = bj + diag_offset[row] + 1;
371:         x1    = pv[0];  x2  = pv[1];  x3  = pv[2];  x4  = pv[3];
372:         pc[0] = m1 = p1*x1 + p3*x2;
373:         pc[1] = m2 = p2*x1 + p4*x2;
374:         pc[2] = m3 = p1*x3 + p3*x4;
375:         pc[3] = m4 = p2*x3 + p4*x4;
376:         nz    = bi[row+1] - diag_offset[row] - 1;
377:         pv   += 4;
378:         for (j=0; j<nz; j++) {
379:           x1    = pv[0];  x2  = pv[1];   x3 = pv[2];  x4  = pv[3];
380:           x     = rtmp + 4*pj[j];
381:           x[0] -= m1*x1 + m3*x2;
382:           x[1] -= m2*x1 + m4*x2;
383:           x[2] -= m1*x3 + m3*x4;
384:           x[3] -= m2*x3 + m4*x4;
385:           pv   += 4;
386:         }
387:         PetscLogFlops(16.0*nz+12.0);
388:       }
389:       row = *ajtmp++;
390:     }
391:     /* finished row so stick it into b->a */
392:     pv = ba + 4*bi[i];
393:     pj = bj + bi[i];
394:     nz = bi[i+1] - bi[i];
395:     for (j=0; j<nz; j++) {
396:       x     = rtmp+4*pj[j];
397:       pv[0] = x[0];  pv[1]  = x[1];  pv[2]  = x[2];  pv[3]  = x[3];
398:       /*
399:       printf(" col %d:",pj[j]);
400:       PetscInt j1;
401:       for (j1=0; j1<4; j1++) printf(" %g,",*(pv+j1));
402:       printf("\n");
403:       */
404:       pv += 4;
405:     }
406:     /* invert diagonal block */
407:     w = ba + 4*diag_offset[i];
408:     /*
409:     printf(" \n%d -th: diag: ",i);
410:     for (j=0; j<4; j++) {
411:       printf(" %g,",w[j]);
412:     }
413:     printf("\n----------------------------\n");
414:     */
415:     PetscKernel_A_gets_inverse_A_2(w,shift);
416:   }

418:   PetscFree(rtmp);

420:   C->ops->solve          = MatSolve_SeqBAIJ_2_NaturalOrdering_inplace;
421:   C->ops->solvetranspose = MatSolveTranspose_SeqBAIJ_2_NaturalOrdering_inplace;
422:   C->assembled           = PETSC_TRUE;

424:   PetscLogFlops(1.333333333333*8*b->mbs); /* from inverting diagonal blocks */
425:   return(0);
426: }

428: /* ----------------------------------------------------------- */
429: /*
430:      Version for when blocks are 1 by 1.
431: */
434: PetscErrorCode MatLUFactorNumeric_SeqBAIJ_1(Mat B,Mat A,const MatFactorInfo *info)
435: {
436:   Mat             C     =B;
437:   Mat_SeqBAIJ     *a    =(Mat_SeqBAIJ*)A->data,*b=(Mat_SeqBAIJ*)C->data;
438:   IS              isrow = b->row,isicol = b->icol;
439:   PetscErrorCode  ierr;
440:   const PetscInt  *r,*ic,*ics;
441:   const PetscInt  n=a->mbs,*ai=a->i,*aj=a->j,*bi=b->i,*bj=b->j,*bdiag=b->diag;
442:   PetscInt        i,j,k,nz,nzL,row,*pj;
443:   const PetscInt  *ajtmp,*bjtmp;
444:   MatScalar       *rtmp,*pc,multiplier,*pv;
445:   const MatScalar *aa=a->a,*v;
446:   PetscBool       row_identity,col_identity;
447:   FactorShiftCtx  sctx;
448:   const PetscInt  *ddiag;
449:   PetscReal       rs;
450:   MatScalar       d;

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

456:   if (info->shifttype == (PetscReal) MAT_SHIFT_POSITIVE_DEFINITE) { /* set sctx.shift_top=max{rs} */
457:     ddiag          = a->diag;
458:     sctx.shift_top = info->zeropivot;
459:     for (i=0; i<n; i++) {
460:       /* calculate sum(|aij|)-RealPart(aii), amt of shift needed for this row */
461:       d  = (aa)[ddiag[i]];
462:       rs = -PetscAbsScalar(d) - PetscRealPart(d);
463:       v  = aa+ai[i];
464:       nz = ai[i+1] - ai[i];
465:       for (j=0; j<nz; j++) rs += PetscAbsScalar(v[j]);
466:       if (rs>sctx.shift_top) sctx.shift_top = rs;
467:     }
468:     sctx.shift_top *= 1.1;
469:     sctx.nshift_max = 5;
470:     sctx.shift_lo   = 0.;
471:     sctx.shift_hi   = 1.;
472:   }

474:   ISGetIndices(isrow,&r);
475:   ISGetIndices(isicol,&ic);
476:   PetscMalloc1((n+1),&rtmp);
477:   ics  = ic;

479:   do {
480:     sctx.newshift = PETSC_FALSE;
481:     for (i=0; i<n; i++) {
482:       /* zero rtmp */
483:       /* L part */
484:       nz    = bi[i+1] - bi[i];
485:       bjtmp = bj + bi[i];
486:       for  (j=0; j<nz; j++) rtmp[bjtmp[j]] = 0.0;

488:       /* U part */
489:       nz    = bdiag[i]-bdiag[i+1];
490:       bjtmp = bj + bdiag[i+1]+1;
491:       for  (j=0; j<nz; j++) rtmp[bjtmp[j]] = 0.0;

493:       /* load in initial (unfactored row) */
494:       nz    = ai[r[i]+1] - ai[r[i]];
495:       ajtmp = aj + ai[r[i]];
496:       v     = aa + ai[r[i]];
497:       for (j=0; j<nz; j++) rtmp[ics[ajtmp[j]]] = v[j];

499:       /* ZeropivotApply() */
500:       rtmp[i] += sctx.shift_amount;  /* shift the diagonal of the matrix */

502:       /* elimination */
503:       bjtmp = bj + bi[i];
504:       row   = *bjtmp++;
505:       nzL   = bi[i+1] - bi[i];
506:       for (k=0; k < nzL; k++) {
507:         pc = rtmp + row;
508:         if (*pc != (PetscScalar)0.0) {
509:           pv         = b->a + bdiag[row];
510:           multiplier = *pc * (*pv);
511:           *pc        = multiplier;

513:           pj = b->j + bdiag[row+1]+1; /* beginning of U(row,:) */
514:           pv = b->a + bdiag[row+1]+1;
515:           nz = bdiag[row]-bdiag[row+1]-1; /* num of entries in U(row,:) excluding diag */
516:           for (j=0; j<nz; j++) rtmp[pj[j]] -= multiplier * pv[j];
517:           PetscLogFlops(2.0*nz);
518:         }
519:         row = *bjtmp++;
520:       }

522:       /* finished row so stick it into b->a */
523:       rs = 0.0;
524:       /* L part */
525:       pv = b->a + bi[i];
526:       pj = b->j + bi[i];
527:       nz = bi[i+1] - bi[i];
528:       for (j=0; j<nz; j++) {
529:         pv[j] = rtmp[pj[j]]; rs += PetscAbsScalar(pv[j]);
530:       }

532:       /* U part */
533:       pv = b->a + bdiag[i+1]+1;
534:       pj = b->j + bdiag[i+1]+1;
535:       nz = bdiag[i] - bdiag[i+1]-1;
536:       for (j=0; j<nz; j++) {
537:         pv[j] = rtmp[pj[j]]; rs += PetscAbsScalar(pv[j]);
538:       }

540:       sctx.rs = rs;
541:       sctx.pv = rtmp[i];
542:       MatPivotCheck(A,info,&sctx,i);
543:       if (sctx.newshift) break; /* break for-loop */
544:       rtmp[i] = sctx.pv; /* sctx.pv might be updated in the case of MAT_SHIFT_INBLOCKS */

546:       /* Mark diagonal and invert diagonal for simplier triangular solves */
547:       pv  = b->a + bdiag[i];
548:       *pv = (PetscScalar)1.0/rtmp[i];

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

552:     /* MatPivotRefine() */
553:     if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE && !sctx.newshift && sctx.shift_fraction>0 && sctx.nshift<sctx.nshift_max) {
554:       /*
555:        * if no shift in this attempt & shifting & started shifting & can refine,
556:        * then try lower shift
557:        */
558:       sctx.shift_hi       = sctx.shift_fraction;
559:       sctx.shift_fraction = (sctx.shift_hi+sctx.shift_lo)/2.;
560:       sctx.shift_amount   = sctx.shift_fraction * sctx.shift_top;
561:       sctx.newshift       = PETSC_TRUE;
562:       sctx.nshift++;
563:     }
564:   } while (sctx.newshift);

566:   PetscFree(rtmp);
567:   ISRestoreIndices(isicol,&ic);
568:   ISRestoreIndices(isrow,&r);

570:   ISIdentity(isrow,&row_identity);
571:   ISIdentity(isicol,&col_identity);
572:   if (row_identity && col_identity) {
573:     C->ops->solve          = MatSolve_SeqBAIJ_1_NaturalOrdering;
574:     C->ops->solvetranspose = MatSolveTranspose_SeqBAIJ_1_NaturalOrdering;
575:   } else {
576:     C->ops->solve          = MatSolve_SeqBAIJ_1;
577:     C->ops->solvetranspose = MatSolveTranspose_SeqBAIJ_1;
578:   }
579:   C->assembled = PETSC_TRUE;
580:   PetscLogFlops(C->cmap->n);

582:   /* MatShiftView(A,info,&sctx) */
583:   if (sctx.nshift) {
584:     if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) {
585:       PetscInfo4(A,"number of shift_pd tries %D, shift_amount %g, diagonal shifted up by %e fraction top_value %e\n",sctx.nshift,(double)sctx.shift_amount,(double)sctx.shift_fraction,(double)sctx.shift_top);
586:     } else if (info->shifttype == (PetscReal)MAT_SHIFT_NONZERO) {
587:       PetscInfo2(A,"number of shift_nz tries %D, shift_amount %g\n",sctx.nshift,(double)sctx.shift_amount);
588:     } else if (info->shifttype == (PetscReal)MAT_SHIFT_INBLOCKS) {
589:       PetscInfo2(A,"number of shift_inblocks applied %D, each shift_amount %g\n",sctx.nshift,(double)info->shiftamount);
590:     }
591:   }
592:   return(0);
593: }

597: PetscErrorCode MatLUFactorNumeric_SeqBAIJ_1_inplace(Mat C,Mat A,const MatFactorInfo *info)
598: {
599:   Mat_SeqBAIJ    *a    = (Mat_SeqBAIJ*)A->data,*b = (Mat_SeqBAIJ*)C->data;
600:   IS             isrow = b->row,isicol = b->icol;
602:   const PetscInt *r,*ic;
603:   PetscInt       i,j,n = a->mbs,*bi = b->i,*bj = b->j;
604:   PetscInt       *ajtmpold,*ajtmp,nz,row,*ai = a->i,*aj = a->j;
605:   PetscInt       *diag_offset = b->diag,diag,*pj;
606:   MatScalar      *pv,*v,*rtmp,multiplier,*pc;
607:   MatScalar      *ba = b->a,*aa = a->a;
608:   PetscBool      row_identity, col_identity;

611:   ISGetIndices(isrow,&r);
612:   ISGetIndices(isicol,&ic);
613:   PetscMalloc1((n+1),&rtmp);

615:   for (i=0; i<n; i++) {
616:     nz    = bi[i+1] - bi[i];
617:     ajtmp = bj + bi[i];
618:     for  (j=0; j<nz; j++) rtmp[ajtmp[j]] = 0.0;

620:     /* load in initial (unfactored row) */
621:     nz       = ai[r[i]+1] - ai[r[i]];
622:     ajtmpold = aj + ai[r[i]];
623:     v        = aa + ai[r[i]];
624:     for (j=0; j<nz; j++) rtmp[ic[ajtmpold[j]]] =  v[j];

626:     row = *ajtmp++;
627:     while (row < i) {
628:       pc = rtmp + row;
629:       if (*pc != 0.0) {
630:         pv         = ba + diag_offset[row];
631:         pj         = bj + diag_offset[row] + 1;
632:         multiplier = *pc * *pv++;
633:         *pc        = multiplier;
634:         nz         = bi[row+1] - diag_offset[row] - 1;
635:         for (j=0; j<nz; j++) rtmp[pj[j]] -= multiplier * pv[j];
636:         PetscLogFlops(1.0+2.0*nz);
637:       }
638:       row = *ajtmp++;
639:     }
640:     /* finished row so stick it into b->a */
641:     pv = ba + bi[i];
642:     pj = bj + bi[i];
643:     nz = bi[i+1] - bi[i];
644:     for (j=0; j<nz; j++) pv[j] = rtmp[pj[j]];
645:     diag = diag_offset[i] - bi[i];
646:     /* check pivot entry for current row */
647:     if (pv[diag] == 0.0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Zero pivot: row in original ordering %D in permuted ordering %D",r[i],i);
648:     pv[diag] = 1.0/pv[diag];
649:   }

651:   PetscFree(rtmp);
652:   ISRestoreIndices(isicol,&ic);
653:   ISRestoreIndices(isrow,&r);
654:   ISIdentity(isrow,&row_identity);
655:   ISIdentity(isicol,&col_identity);
656:   if (row_identity && col_identity) {
657:     C->ops->solve          = MatSolve_SeqBAIJ_1_NaturalOrdering_inplace;
658:     C->ops->solvetranspose = MatSolveTranspose_SeqBAIJ_1_NaturalOrdering_inplace;
659:   } else {
660:     C->ops->solve          = MatSolve_SeqBAIJ_1_inplace;
661:     C->ops->solvetranspose = MatSolveTranspose_SeqBAIJ_1_inplace;
662:   }
663:   C->assembled = PETSC_TRUE;
664:   PetscLogFlops(C->cmap->n);
665:   return(0);
666: }

670: PETSC_EXTERN PetscErrorCode MatGetFactor_seqbaij_petsc(Mat A,MatFactorType ftype,Mat *B)
671: {
672:   PetscInt       n = A->rmap->n;

676: #if defined(PETSC_USE_COMPLEX)
677:   if (A->hermitian && (ftype == MAT_FACTOR_CHOLESKY || ftype == MAT_FACTOR_ICC)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Hermitian Factor is not supported");
678: #endif
679:   MatCreate(PetscObjectComm((PetscObject)A),B);
680:   MatSetSizes(*B,n,n,n,n);
681:   if (ftype == MAT_FACTOR_LU || ftype == MAT_FACTOR_ILU || ftype == MAT_FACTOR_ILUDT) {
682:     MatSetType(*B,MATSEQBAIJ);

684:     (*B)->ops->lufactorsymbolic  = MatLUFactorSymbolic_SeqBAIJ;
685:     (*B)->ops->ilufactorsymbolic = MatILUFactorSymbolic_SeqBAIJ;
686:   } else if (ftype == MAT_FACTOR_CHOLESKY || ftype == MAT_FACTOR_ICC) {
687:     MatSetType(*B,MATSEQSBAIJ);
688:     MatSeqSBAIJSetPreallocation(*B,A->rmap->bs,MAT_SKIP_ALLOCATION,NULL);

690:     (*B)->ops->iccfactorsymbolic      = MatICCFactorSymbolic_SeqBAIJ;
691:     (*B)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqBAIJ;
692:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Factor type not supported");
693:   (*B)->factortype = ftype;
694:   return(0);
695: }

699: PetscErrorCode MatGetFactorAvailable_seqbaij_petsc(Mat A,MatFactorType ftype,PetscBool  *flg)
700: {
702:   *flg = PETSC_TRUE;
703:   return(0);
704: }

706: /* ----------------------------------------------------------- */
709: PetscErrorCode MatLUFactor_SeqBAIJ(Mat A,IS row,IS col,const MatFactorInfo *info)
710: {
712:   Mat            C;

715:   MatGetFactor(A,MATSOLVERPETSC,MAT_FACTOR_LU,&C);
716:   MatLUFactorSymbolic(C,A,row,col,info);
717:   MatLUFactorNumeric(C,A,info);

719:   A->ops->solve          = C->ops->solve;
720:   A->ops->solvetranspose = C->ops->solvetranspose;

722:   MatHeaderMerge(A,C);
723:   PetscLogObjectParent((PetscObject)A,(PetscObject)((Mat_SeqBAIJ*)(A->data))->icol);
724:   return(0);
725: }

727: #include <../src/mat/impls/sbaij/seq/sbaij.h>
730: PetscErrorCode MatCholeskyFactorNumeric_SeqBAIJ_N(Mat C,Mat A,const MatFactorInfo *info)
731: {
733:   Mat_SeqBAIJ    *a=(Mat_SeqBAIJ*)A->data;
734:   Mat_SeqSBAIJ   *b=(Mat_SeqSBAIJ*)C->data;
735:   IS             ip=b->row;
736:   const PetscInt *rip;
737:   PetscInt       i,j,mbs=a->mbs,bs=A->rmap->bs,*bi=b->i,*bj=b->j,*bcol;
738:   PetscInt       *ai=a->i,*aj=a->j;
739:   PetscInt       k,jmin,jmax,*jl,*il,col,nexti,ili,nz;
740:   MatScalar      *rtmp,*ba=b->a,*bval,*aa=a->a,dk,uikdi;
741:   PetscReal      rs;
742:   FactorShiftCtx sctx;

745:   if (bs > 1) { /* convert A to a SBAIJ matrix and apply Cholesky factorization from it */
746:     if (!a->sbaijMat) {
747:       MatConvert(A,MATSEQSBAIJ,MAT_INITIAL_MATRIX,&a->sbaijMat);
748:     }
749:     (a->sbaijMat)->ops->choleskyfactornumeric(C,a->sbaijMat,info);
750:     MatDestroy(&a->sbaijMat);
751:     return(0);
752:   }

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

757:   ISGetIndices(ip,&rip);
758:   PetscMalloc3(mbs,&rtmp,mbs,&il,mbs,&jl);

760:   sctx.shift_amount = 0.;
761:   sctx.nshift       = 0;
762:   do {
763:     sctx.newshift = PETSC_FALSE;
764:     for (i=0; i<mbs; i++) {
765:       rtmp[i] = 0.0; jl[i] = mbs; il[0] = 0;
766:     }

768:     for (k = 0; k<mbs; k++) {
769:       bval = ba + bi[k];
770:       /* initialize k-th row by the perm[k]-th row of A */
771:       jmin = ai[rip[k]]; jmax = ai[rip[k]+1];
772:       for (j = jmin; j < jmax; j++) {
773:         col = rip[aj[j]];
774:         if (col >= k) { /* only take upper triangular entry */
775:           rtmp[col] = aa[j];
776:           *bval++   = 0.0; /* for in-place factorization */
777:         }
778:       }

780:       /* shift the diagonal of the matrix */
781:       if (sctx.nshift) rtmp[k] += sctx.shift_amount;

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

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

790:         /* compute multiplier, update diag(k) and U(i,k) */
791:         ili     = il[i]; /* index of first nonzero element in U(i,k:bms-1) */
792:         uikdi   = -ba[ili]*ba[bi[i]]; /* diagonal(k) */
793:         dk     += uikdi*ba[ili];
794:         ba[ili] = uikdi; /* -U(i,k) */

796:         /* add multiple of row i to k-th row */
797:         jmin = ili + 1; jmax = bi[i+1];
798:         if (jmin < jmax) {
799:           for (j=jmin; j<jmax; j++) rtmp[bj[j]] += uikdi*ba[j];
800:           /* update il and jl for row i */
801:           il[i] = jmin;
802:           j     = bj[jmin]; jl[i] = jl[j]; jl[j] = i;
803:         }
804:         i = nexti;
805:       }

807:       /* shift the diagonals when zero pivot is detected */
808:       /* compute rs=sum of abs(off-diagonal) */
809:       rs   = 0.0;
810:       jmin = bi[k]+1;
811:       nz   = bi[k+1] - jmin;
812:       if (nz) {
813:         bcol = bj + jmin;
814:         while (nz--) {
815:           rs += PetscAbsScalar(rtmp[*bcol]);
816:           bcol++;
817:         }
818:       }

820:       sctx.rs = rs;
821:       sctx.pv = dk;
822:       MatPivotCheck(A,info,&sctx,k);
823:       if (sctx.newshift) break;
824:       dk = sctx.pv;

826:       /* copy data into U(k,:) */
827:       ba[bi[k]] = 1.0/dk; /* U(k,k) */
828:       jmin      = bi[k]+1; jmax = bi[k+1];
829:       if (jmin < jmax) {
830:         for (j=jmin; j<jmax; j++) {
831:           col = bj[j]; ba[j] = rtmp[col]; rtmp[col] = 0.0;
832:         }
833:         /* add the k-th row into il and jl */
834:         il[k] = jmin;
835:         i     = bj[jmin]; jl[k] = jl[i]; jl[i] = k;
836:       }
837:     }
838:   } while (sctx.newshift);
839:   PetscFree3(rtmp,il,jl);

841:   ISRestoreIndices(ip,&rip);

843:   C->assembled    = PETSC_TRUE;
844:   C->preallocated = PETSC_TRUE;

846:   PetscLogFlops(C->rmap->N);
847:   if (sctx.nshift) {
848:     if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) {
849:       PetscInfo2(A,"number of shiftpd tries %D, shift_amount %g\n",sctx.nshift,(double)sctx.shift_amount);
850:     } else if (info->shifttype == (PetscReal)MAT_SHIFT_NONZERO) {
851:       PetscInfo2(A,"number of shiftnz tries %D, shift_amount %g\n",sctx.nshift,(double)sctx.shift_amount);
852:     }
853:   }
854:   return(0);
855: }

859: PetscErrorCode MatCholeskyFactorNumeric_SeqBAIJ_N_NaturalOrdering(Mat C,Mat A,const MatFactorInfo *info)
860: {
861:   Mat_SeqBAIJ    *a=(Mat_SeqBAIJ*)A->data;
862:   Mat_SeqSBAIJ   *b=(Mat_SeqSBAIJ*)C->data;
864:   PetscInt       i,j,am=a->mbs;
865:   PetscInt       *ai=a->i,*aj=a->j,*bi=b->i,*bj=b->j;
866:   PetscInt       k,jmin,*jl,*il,nexti,ili,*acol,*bcol,nz;
867:   MatScalar      *rtmp,*ba=b->a,*aa=a->a,dk,uikdi,*aval,*bval;
868:   PetscReal      rs;
869:   FactorShiftCtx sctx;

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

875:   PetscMalloc3(am,&rtmp,am,&il,am,&jl);

877:   do {
878:     sctx.newshift = PETSC_FALSE;
879:     for (i=0; i<am; i++) {
880:       rtmp[i] = 0.0; jl[i] = am; il[0] = 0;
881:     }

883:     for (k = 0; k<am; k++) {
884:       /* initialize k-th row with elements nonzero in row perm(k) of A */
885:       nz   = ai[k+1] - ai[k];
886:       acol = aj + ai[k];
887:       aval = aa + ai[k];
888:       bval = ba + bi[k];
889:       while (nz--) {
890:         if (*acol < k) { /* skip lower triangular entries */
891:           acol++; aval++;
892:         } else {
893:           rtmp[*acol++] = *aval++;
894:           *bval++       = 0.0; /* for in-place factorization */
895:         }
896:       }

898:       /* shift the diagonal of the matrix */
899:       if (sctx.nshift) rtmp[k] += sctx.shift_amount;

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

905:       while (i < k) {
906:         nexti = jl[i]; /* next row to be added to k_th row */
907:         /* compute multiplier, update D(k) and U(i,k) */
908:         ili     = il[i]; /* index of first nonzero element in U(i,k:bms-1) */
909:         uikdi   = -ba[ili]*ba[bi[i]];
910:         dk     += uikdi*ba[ili];
911:         ba[ili] = uikdi; /* -U(i,k) */

913:         /* add multiple of row i to k-th row ... */
914:         jmin = ili + 1;
915:         nz   = bi[i+1] - jmin;
916:         if (nz > 0) {
917:           bcol = bj + jmin;
918:           bval = ba + jmin;
919:           while (nz--) rtmp[*bcol++] += uikdi*(*bval++);
920:           /* update il and jl for i-th row */
921:           il[i] = jmin;
922:           j     = bj[jmin]; jl[i] = jl[j]; jl[j] = i;
923:         }
924:         i = nexti;
925:       }

927:       /* shift the diagonals when zero pivot is detected */
928:       /* compute rs=sum of abs(off-diagonal) */
929:       rs   = 0.0;
930:       jmin = bi[k]+1;
931:       nz   = bi[k+1] - jmin;
932:       if (nz) {
933:         bcol = bj + jmin;
934:         while (nz--) {
935:           rs += PetscAbsScalar(rtmp[*bcol]);
936:           bcol++;
937:         }
938:       }

940:       sctx.rs = rs;
941:       sctx.pv = dk;
942:       MatPivotCheck(A,info,&sctx,k);
943:       if (sctx.newshift) break;    /* sctx.shift_amount is updated */
944:       dk = sctx.pv;

946:       /* copy data into U(k,:) */
947:       ba[bi[k]] = 1.0/dk;
948:       jmin      = bi[k]+1;
949:       nz        = bi[k+1] - jmin;
950:       if (nz) {
951:         bcol = bj + jmin;
952:         bval = ba + jmin;
953:         while (nz--) {
954:           *bval++       = rtmp[*bcol];
955:           rtmp[*bcol++] = 0.0;
956:         }
957:         /* add k-th row into il and jl */
958:         il[k] = jmin;
959:         i     = bj[jmin]; jl[k] = jl[i]; jl[i] = k;
960:       }
961:     }
962:   } while (sctx.newshift);
963:   PetscFree3(rtmp,il,jl);

965:   C->ops->solve          = MatSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
966:   C->ops->solvetranspose = MatSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
967:   C->assembled           = PETSC_TRUE;
968:   C->preallocated        = PETSC_TRUE;

970:   PetscLogFlops(C->rmap->N);
971:   if (sctx.nshift) {
972:     if (info->shifttype == (PetscReal)MAT_SHIFT_NONZERO) {
973:       PetscInfo2(A,"number of shiftnz tries %D, shift_amount %g\n",sctx.nshift,(double)sctx.shift_amount);
974:     } else if (info->shifttype == (PetscReal)MAT_SHIFT_POSITIVE_DEFINITE) {
975:       PetscInfo2(A,"number of shiftpd tries %D, shift_amount %g\n",sctx.nshift,(double)sctx.shift_amount);
976:     }
977:   }
978:   return(0);
979: }

981: #include <petscbt.h>
982: #include <../src/mat/utils/freespace.h>
985: PetscErrorCode MatICCFactorSymbolic_SeqBAIJ(Mat fact,Mat A,IS perm,const MatFactorInfo *info)
986: {
987:   Mat_SeqBAIJ        *a = (Mat_SeqBAIJ*)A->data;
988:   Mat_SeqSBAIJ       *b;
989:   Mat                B;
990:   PetscErrorCode     ierr;
991:   PetscBool          perm_identity,missing;
992:   PetscInt           reallocs=0,i,*ai=a->i,*aj=a->j,am=a->mbs,bs=A->rmap->bs,*ui;
993:   const PetscInt     *rip;
994:   PetscInt           jmin,jmax,nzk,k,j,*jl,prow,*il,nextprow;
995:   PetscInt           nlnk,*lnk,*lnk_lvl=NULL,ncols,ncols_upper,*cols,*cols_lvl,*uj,**uj_ptr,**uj_lvl_ptr;
996:   PetscReal          fill          =info->fill,levels=info->levels;
997:   PetscFreeSpaceList free_space    =NULL,current_space=NULL;
998:   PetscFreeSpaceList free_space_lvl=NULL,current_space_lvl=NULL;
999:   PetscBT            lnkbt;

1002:   MatMissingDiagonal(A,&missing,&i);
1003:   if (missing) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",i);

1005:   if (bs > 1) {
1006:     if (!a->sbaijMat) {
1007:       MatConvert(A,MATSEQSBAIJ,MAT_INITIAL_MATRIX,&a->sbaijMat);
1008:     }
1009:     (fact)->ops->iccfactorsymbolic = MatICCFactorSymbolic_SeqSBAIJ;  /* undue the change made in MatGetFactor_seqbaij_petsc */

1011:     MatICCFactorSymbolic(fact,a->sbaijMat,perm,info);
1012:     return(0);
1013:   }

1015:   ISIdentity(perm,&perm_identity);
1016:   ISGetIndices(perm,&rip);

1018:   /* special case that simply copies fill pattern */
1019:   if (!levels && perm_identity) {
1020:     PetscMalloc1((am+1),&ui);
1021:     for (i=0; i<am; i++) ui[i] = ai[i+1] - a->diag[i]; /* ui: rowlengths - changes when !perm_identity */
1022:     B    = fact;
1023:     MatSeqSBAIJSetPreallocation(B,1,0,ui);


1026:     b  = (Mat_SeqSBAIJ*)B->data;
1027:     uj = b->j;
1028:     for (i=0; i<am; i++) {
1029:       aj = a->j + a->diag[i];
1030:       for (j=0; j<ui[i]; j++) *uj++ = *aj++;
1031:       b->ilen[i] = ui[i];
1032:     }
1033:     PetscFree(ui);

1035:     B->factortype = MAT_FACTOR_NONE;

1037:     MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
1038:     MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
1039:     B->factortype = MAT_FACTOR_ICC;

1041:     B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqBAIJ_N_NaturalOrdering;
1042:     return(0);
1043:   }

1045:   /* initialization */
1046:   PetscMalloc1((am+1),&ui);
1047:   ui[0] = 0;
1048:   PetscMalloc1((2*am+1),&cols_lvl);

1050:   /* jl: linked list for storing indices of the pivot rows
1051:      il: il[i] points to the 1st nonzero entry of U(i,k:am-1) */
1052:   PetscMalloc4(am,&uj_ptr,am,&uj_lvl_ptr,am,&il,am,&jl);
1053:   for (i=0; i<am; i++) {
1054:     jl[i] = am; il[i] = 0;
1055:   }

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

1061:   /* initial FreeSpace size is fill*(ai[am]+am)/2 */
1062:   PetscFreeSpaceGet((PetscInt)(fill*(ai[am]+am)/2),&free_space);

1064:   current_space = free_space;

1066:   PetscFreeSpaceGet((PetscInt)(fill*(ai[am]+am)/2),&free_space_lvl);
1067:   current_space_lvl = free_space_lvl;

1069:   for (k=0; k<am; k++) {  /* for each active row k */
1070:     /* initialize lnk by the column indices of row rip[k] of A */
1071:     nzk         = 0;
1072:     ncols       = ai[rip[k]+1] - ai[rip[k]];
1073:     ncols_upper = 0;
1074:     cols        = cols_lvl + am;
1075:     for (j=0; j<ncols; j++) {
1076:       i = rip[*(aj + ai[rip[k]] + j)];
1077:       if (i >= k) { /* only take upper triangular entry */
1078:         cols[ncols_upper]     = i;
1079:         cols_lvl[ncols_upper] = -1;  /* initialize level for nonzero entries */
1080:         ncols_upper++;
1081:       }
1082:     }
1083:     PetscIncompleteLLAdd(ncols_upper,cols,levels,cols_lvl,am,nlnk,lnk,lnk_lvl,lnkbt);
1084:     nzk += nlnk;

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

1089:     while (prow < k) {
1090:       nextprow = jl[prow];

1092:       /* merge prow into k-th row */
1093:       jmin  = il[prow] + 1; /* index of the 2nd nzero entry in U(prow,k:am-1) */
1094:       jmax  = ui[prow+1];
1095:       ncols = jmax-jmin;
1096:       i     = jmin - ui[prow];
1097:       cols  = uj_ptr[prow] + i; /* points to the 2nd nzero entry in U(prow,k:am-1) */
1098:       for (j=0; j<ncols; j++) cols_lvl[j] = *(uj_lvl_ptr[prow] + i + j);
1099:       PetscIncompleteLLAddSorted(ncols,cols,levels,cols_lvl,am,nlnk,lnk,lnk_lvl,lnkbt);
1100:       nzk += nlnk;

1102:       /* update il and jl for prow */
1103:       if (jmin < jmax) {
1104:         il[prow] = jmin;

1106:         j = *cols; jl[prow] = jl[j]; jl[j] = prow;
1107:       }
1108:       prow = nextprow;
1109:     }

1111:     /* if free space is not available, make more free space */
1112:     if (current_space->local_remaining<nzk) {
1113:       i    = am - k + 1; /* num of unfactored rows */
1114:       i    = PetscMin(i*nzk, i*(i-1)); /* i*nzk, i*(i-1): estimated and max additional space needed */
1115:       PetscFreeSpaceGet(i,&current_space);
1116:       PetscFreeSpaceGet(i,&current_space_lvl);
1117:       reallocs++;
1118:     }

1120:     /* copy data into free_space and free_space_lvl, then initialize lnk */
1121:     PetscIncompleteLLClean(am,am,nzk,lnk,lnk_lvl,current_space->array,current_space_lvl->array,lnkbt);

1123:     /* add the k-th row into il and jl */
1124:     if (nzk-1 > 0) {
1125:       i     = current_space->array[1]; /* col value of the first nonzero element in U(k, k+1:am-1) */
1126:       jl[k] = jl[i]; jl[i] = k;
1127:       il[k] = ui[k] + 1;
1128:     }
1129:     uj_ptr[k]     = current_space->array;
1130:     uj_lvl_ptr[k] = current_space_lvl->array;

1132:     current_space->array           += nzk;
1133:     current_space->local_used      += nzk;
1134:     current_space->local_remaining -= nzk;

1136:     current_space_lvl->array           += nzk;
1137:     current_space_lvl->local_used      += nzk;
1138:     current_space_lvl->local_remaining -= nzk;

1140:     ui[k+1] = ui[k] + nzk;
1141:   }

1143:   ISRestoreIndices(perm,&rip);
1144:   PetscFree4(uj_ptr,uj_lvl_ptr,il,jl);
1145:   PetscFree(cols_lvl);

1147:   /* copy free_space into uj and free free_space; set uj in new datastructure; */
1148:   PetscMalloc1((ui[am]+1),&uj);
1149:   PetscFreeSpaceContiguous(&free_space,uj);
1150:   PetscIncompleteLLDestroy(lnk,lnkbt);
1151:   PetscFreeSpaceDestroy(free_space_lvl);

1153:   /* put together the new matrix in MATSEQSBAIJ format */
1154:   B    = fact;
1155:   MatSeqSBAIJSetPreallocation(B,1,MAT_SKIP_ALLOCATION,NULL);

1157:   b                = (Mat_SeqSBAIJ*)B->data;
1158:   b->singlemalloc  = PETSC_FALSE;
1159:   b->free_a        = PETSC_TRUE;
1160:   b->free_ij       = PETSC_TRUE;

1162:   PetscMalloc1((ui[am]+1),&b->a);

1164:   b->j             = uj;
1165:   b->i             = ui;
1166:   b->diag          = 0;
1167:   b->ilen          = 0;
1168:   b->imax          = 0;
1169:   b->row           = perm;
1170:   b->pivotinblocks = PETSC_FALSE; /* need to get from MatFactorInfo */

1172:   PetscObjectReference((PetscObject)perm);

1174:   b->icol = perm;

1176:   PetscObjectReference((PetscObject)perm);
1177:   PetscMalloc1((am+1),&b->solve_work);
1178:   PetscLogObjectMemory((PetscObject)B,(ui[am]-am)*(sizeof(PetscInt)+sizeof(MatScalar)));

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

1182:   B->info.factor_mallocs   = reallocs;
1183:   B->info.fill_ratio_given = fill;
1184:   if (ai[am] != 0.) {
1185:     /* nonzeros in lower triangular part of A (includign diagonals)= (ai[am]+am)/2 */
1186:     B->info.fill_ratio_needed = ((PetscReal)2*ui[am])/(ai[am]+am);
1187:   } else {
1188:     B->info.fill_ratio_needed = 0.0;
1189:   }
1190: #if defined(PETSC_USE_INFO)
1191:   if (ai[am] != 0) {
1192:     PetscReal af = B->info.fill_ratio_needed;
1193:     PetscInfo3(A,"Reallocs %D Fill ratio:given %g needed %g\n",reallocs,(double)fill,(double)af);
1194:     PetscInfo1(A,"Run with -pc_factor_fill %g or use \n",(double)af);
1195:     PetscInfo1(A,"PCFactorSetFill(pc,%g) for best performance.\n",(double)af);
1196:   } else {
1197:     PetscInfo(A,"Empty matrix.\n");
1198:   }
1199: #endif
1200:   if (perm_identity) {
1201:     B->ops->solve                 = MatSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
1202:     B->ops->solvetranspose        = MatSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
1203:     B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqBAIJ_N_NaturalOrdering;
1204:   } else {
1205:     (fact)->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqBAIJ_N;
1206:   }
1207:   return(0);
1208: }

1212: PetscErrorCode MatCholeskyFactorSymbolic_SeqBAIJ(Mat fact,Mat A,IS perm,const MatFactorInfo *info)
1213: {
1214:   Mat_SeqBAIJ        *a = (Mat_SeqBAIJ*)A->data;
1215:   Mat_SeqSBAIJ       *b;
1216:   Mat                B;
1217:   PetscErrorCode     ierr;
1218:   PetscBool          perm_identity,missing;
1219:   PetscReal          fill = info->fill;
1220:   const PetscInt     *rip;
1221:   PetscInt           i,mbs=a->mbs,bs=A->rmap->bs,*ai=a->i,*aj=a->j,reallocs=0,prow;
1222:   PetscInt           *jl,jmin,jmax,nzk,*ui,k,j,*il,nextprow;
1223:   PetscInt           nlnk,*lnk,ncols,ncols_upper,*cols,*uj,**ui_ptr,*uj_ptr;
1224:   PetscFreeSpaceList free_space=NULL,current_space=NULL;
1225:   PetscBT            lnkbt;

1228:   if (bs > 1) { /* convert to seqsbaij */
1229:     if (!a->sbaijMat) {
1230:       MatConvert(A,MATSEQSBAIJ,MAT_INITIAL_MATRIX,&a->sbaijMat);
1231:     }
1232:     (fact)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqSBAIJ; /* undue the change made in MatGetFactor_seqbaij_petsc */

1234:     MatCholeskyFactorSymbolic(fact,a->sbaijMat,perm,info);
1235:     return(0);
1236:   }

1238:   MatMissingDiagonal(A,&missing,&i);
1239:   if (missing) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",i);

1241:   /* check whether perm is the identity mapping */
1242:   ISIdentity(perm,&perm_identity);
1243:   if (!perm_identity) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Matrix reordering is not supported");
1244:   ISGetIndices(perm,&rip);

1246:   /* initialization */
1247:   PetscMalloc1((mbs+1),&ui);
1248:   ui[0] = 0;

1250:   /* jl: linked list for storing indices of the pivot rows
1251:      il: il[i] points to the 1st nonzero entry of U(i,k:mbs-1) */
1252:   PetscMalloc4(mbs,&ui_ptr,mbs,&il,mbs,&jl,mbs,&cols);
1253:   for (i=0; i<mbs; i++) {
1254:     jl[i] = mbs; il[i] = 0;
1255:   }

1257:   /* create and initialize a linked list for storing column indices of the active row k */
1258:   nlnk = mbs + 1;
1259:   PetscLLCreate(mbs,mbs,nlnk,lnk,lnkbt);

1261:   /* initial FreeSpace size is fill* (ai[mbs]+mbs)/2 */
1262:   PetscFreeSpaceGet((PetscInt)(fill*(ai[mbs]+mbs)/2),&free_space);

1264:   current_space = free_space;

1266:   for (k=0; k<mbs; k++) {  /* for each active row k */
1267:     /* initialize lnk by the column indices of row rip[k] of A */
1268:     nzk         = 0;
1269:     ncols       = ai[rip[k]+1] - ai[rip[k]];
1270:     ncols_upper = 0;
1271:     for (j=0; j<ncols; j++) {
1272:       i = rip[*(aj + ai[rip[k]] + j)];
1273:       if (i >= k) { /* only take upper triangular entry */
1274:         cols[ncols_upper] = i;
1275:         ncols_upper++;
1276:       }
1277:     }
1278:     PetscLLAdd(ncols_upper,cols,mbs,nlnk,lnk,lnkbt);
1279:     nzk += nlnk;

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

1284:     while (prow < k) {
1285:       nextprow = jl[prow];
1286:       /* merge prow into k-th row */
1287:       jmin   = il[prow] + 1; /* index of the 2nd nzero entry in U(prow,k:mbs-1) */
1288:       jmax   = ui[prow+1];
1289:       ncols  = jmax-jmin;
1290:       uj_ptr = ui_ptr[prow] + jmin - ui[prow]; /* points to the 2nd nzero entry in U(prow,k:mbs-1) */
1291:       PetscLLAddSorted(ncols,uj_ptr,mbs,nlnk,lnk,lnkbt);
1292:       nzk   += nlnk;

1294:       /* update il and jl for prow */
1295:       if (jmin < jmax) {
1296:         il[prow] = jmin;
1297:         j        = *uj_ptr;
1298:         jl[prow] = jl[j];
1299:         jl[j]    = prow;
1300:       }
1301:       prow = nextprow;
1302:     }

1304:     /* if free space is not available, make more free space */
1305:     if (current_space->local_remaining<nzk) {
1306:       i    = mbs - k + 1; /* num of unfactored rows */
1307:       i    = PetscMin(i*nzk, i*(i-1)); /* i*nzk, i*(i-1): estimated and max additional space needed */
1308:       PetscFreeSpaceGet(i,&current_space);
1309:       reallocs++;
1310:     }

1312:     /* copy data into free space, then initialize lnk */
1313:     PetscLLClean(mbs,mbs,nzk,lnk,current_space->array,lnkbt);

1315:     /* add the k-th row into il and jl */
1316:     if (nzk-1 > 0) {
1317:       i     = current_space->array[1]; /* col value of the first nonzero element in U(k, k+1:mbs-1) */
1318:       jl[k] = jl[i]; jl[i] = k;
1319:       il[k] = ui[k] + 1;
1320:     }
1321:     ui_ptr[k]                       = current_space->array;
1322:     current_space->array           += nzk;
1323:     current_space->local_used      += nzk;
1324:     current_space->local_remaining -= nzk;

1326:     ui[k+1] = ui[k] + nzk;
1327:   }

1329:   ISRestoreIndices(perm,&rip);
1330:   PetscFree4(ui_ptr,il,jl,cols);

1332:   /* copy free_space into uj and free free_space; set uj in new datastructure; */
1333:   PetscMalloc1((ui[mbs]+1),&uj);
1334:   PetscFreeSpaceContiguous(&free_space,uj);
1335:   PetscLLDestroy(lnk,lnkbt);

1337:   /* put together the new matrix in MATSEQSBAIJ format */
1338:   B    = fact;
1339:   MatSeqSBAIJSetPreallocation(B,bs,MAT_SKIP_ALLOCATION,NULL);

1341:   b               = (Mat_SeqSBAIJ*)B->data;
1342:   b->singlemalloc = PETSC_FALSE;
1343:   b->free_a       = PETSC_TRUE;
1344:   b->free_ij      = PETSC_TRUE;

1346:   PetscMalloc1((ui[mbs]+1),&b->a);

1348:   b->j             = uj;
1349:   b->i             = ui;
1350:   b->diag          = 0;
1351:   b->ilen          = 0;
1352:   b->imax          = 0;
1353:   b->row           = perm;
1354:   b->pivotinblocks = PETSC_FALSE; /* need to get from MatFactorInfo */

1356:   PetscObjectReference((PetscObject)perm);
1357:   b->icol  = perm;
1358:   PetscObjectReference((PetscObject)perm);
1359:   PetscMalloc1((mbs+1),&b->solve_work);
1360:   PetscLogObjectMemory((PetscObject)B,(ui[mbs]-mbs)*(sizeof(PetscInt)+sizeof(MatScalar)));
1361:   b->maxnz = b->nz = ui[mbs];

1363:   B->info.factor_mallocs   = reallocs;
1364:   B->info.fill_ratio_given = fill;
1365:   if (ai[mbs] != 0.) {
1366:     /* nonzeros in lower triangular part of A = (ai[mbs]+mbs)/2 */
1367:     B->info.fill_ratio_needed = ((PetscReal)2*ui[mbs])/(ai[mbs]+mbs);
1368:   } else {
1369:     B->info.fill_ratio_needed = 0.0;
1370:   }
1371: #if defined(PETSC_USE_INFO)
1372:   if (ai[mbs] != 0.) {
1373:     PetscReal af = B->info.fill_ratio_needed;
1374:     PetscInfo3(A,"Reallocs %D Fill ratio:given %g needed %g\n",reallocs,(double)fill,(double)af);
1375:     PetscInfo1(A,"Run with -pc_factor_fill %g or use \n",(double)af);
1376:     PetscInfo1(A,"PCFactorSetFill(pc,%g) for best performance.\n",(double)af);
1377:   } else {
1378:     PetscInfo(A,"Empty matrix.\n");
1379:   }
1380: #endif
1381:   if (perm_identity) {
1382:     B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqBAIJ_N_NaturalOrdering;
1383:   } else {
1384:     B->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqBAIJ_N;
1385:   }
1386:   return(0);
1387: }

1391: PetscErrorCode MatSolve_SeqBAIJ_N_NaturalOrdering(Mat A,Vec bb,Vec xx)
1392: {
1393:   Mat_SeqBAIJ    *a=(Mat_SeqBAIJ*)A->data;
1395:   const PetscInt *ai=a->i,*aj=a->j,*adiag=a->diag,*vi;
1396:   PetscInt       i,k,n=a->mbs;
1397:   PetscInt       nz,bs=A->rmap->bs,bs2=a->bs2;
1398:   MatScalar      *aa=a->a,*v;
1399:   PetscScalar    *x,*b,*s,*t,*ls;

1402:   VecGetArray(bb,&b);
1403:   VecGetArray(xx,&x);
1404:   t    = a->solve_work;

1406:   /* forward solve the lower triangular */
1407:   PetscMemcpy(t,b,bs*sizeof(PetscScalar)); /* copy 1st block of b to t */

1409:   for (i=1; i<n; i++) {
1410:     v    = aa + bs2*ai[i];
1411:     vi   = aj + ai[i];
1412:     nz   = ai[i+1] - ai[i];
1413:     s    = t + bs*i;
1414:     PetscMemcpy(s,b+bs*i,bs*sizeof(PetscScalar)); /* copy i_th block of b to t */
1415:     for (k=0;k<nz;k++) {
1416:       PetscKernel_v_gets_v_minus_A_times_w(bs,s,v,t+bs*vi[k]);
1417:       v += bs2;
1418:     }
1419:   }

1421:   /* backward solve the upper triangular */
1422:   ls = a->solve_work + A->cmap->n;
1423:   for (i=n-1; i>=0; i--) {
1424:     v    = aa + bs2*(adiag[i+1]+1);
1425:     vi   = aj + adiag[i+1]+1;
1426:     nz   = adiag[i] - adiag[i+1]-1;
1427:     PetscMemcpy(ls,t+i*bs,bs*sizeof(PetscScalar));
1428:     for (k=0; k<nz; k++) {
1429:       PetscKernel_v_gets_v_minus_A_times_w(bs,ls,v,t+bs*vi[k]);
1430:       v += bs2;
1431:     }
1432:     PetscKernel_w_gets_A_times_v(bs,ls,aa+bs2*adiag[i],t+i*bs); /* *inv(diagonal[i]) */
1433:     PetscMemcpy(x+i*bs,t+i*bs,bs*sizeof(PetscScalar));
1434:   }

1436:   VecRestoreArray(bb,&b);
1437:   VecRestoreArray(xx,&x);
1438:   PetscLogFlops(2.0*(a->bs2)*(a->nz) - A->rmap->bs*A->cmap->n);
1439:   return(0);
1440: }

1444: PetscErrorCode MatSolve_SeqBAIJ_N(Mat A,Vec bb,Vec xx)
1445: {
1446:   Mat_SeqBAIJ    *a   =(Mat_SeqBAIJ*)A->data;
1447:   IS             iscol=a->col,isrow=a->row;
1449:   const PetscInt *r,*c,*rout,*cout,*ai=a->i,*aj=a->j,*adiag=a->diag,*vi;
1450:   PetscInt       i,m,n=a->mbs;
1451:   PetscInt       nz,bs=A->rmap->bs,bs2=a->bs2;
1452:   MatScalar      *aa=a->a,*v;
1453:   PetscScalar    *x,*b,*s,*t,*ls;

1456:   VecGetArray(bb,&b);
1457:   VecGetArray(xx,&x);
1458:   t    = a->solve_work;

1460:   ISGetIndices(isrow,&rout); r = rout;
1461:   ISGetIndices(iscol,&cout); c = cout;

1463:   /* forward solve the lower triangular */
1464:   PetscMemcpy(t,b+bs*r[0],bs*sizeof(PetscScalar));
1465:   for (i=1; i<n; i++) {
1466:     v    = aa + bs2*ai[i];
1467:     vi   = aj + ai[i];
1468:     nz   = ai[i+1] - ai[i];
1469:     s    = t + bs*i;
1470:     PetscMemcpy(s,b+bs*r[i],bs*sizeof(PetscScalar));
1471:     for (m=0; m<nz; m++) {
1472:       PetscKernel_v_gets_v_minus_A_times_w(bs,s,v,t+bs*vi[m]);
1473:       v += bs2;
1474:     }
1475:   }

1477:   /* backward solve the upper triangular */
1478:   ls = a->solve_work + A->cmap->n;
1479:   for (i=n-1; i>=0; i--) {
1480:     v    = aa + bs2*(adiag[i+1]+1);
1481:     vi   = aj + adiag[i+1]+1;
1482:     nz   = adiag[i] - adiag[i+1] - 1;
1483:     PetscMemcpy(ls,t+i*bs,bs*sizeof(PetscScalar));
1484:     for (m=0; m<nz; m++) {
1485:       PetscKernel_v_gets_v_minus_A_times_w(bs,ls,v,t+bs*vi[m]);
1486:       v += bs2;
1487:     }
1488:     PetscKernel_w_gets_A_times_v(bs,ls,v,t+i*bs); /* *inv(diagonal[i]) */
1489:     PetscMemcpy(x + bs*c[i],t+i*bs,bs*sizeof(PetscScalar));
1490:   }
1491:   ISRestoreIndices(isrow,&rout);
1492:   ISRestoreIndices(iscol,&cout);
1493:   VecRestoreArray(bb,&b);
1494:   VecRestoreArray(xx,&x);
1495:   PetscLogFlops(2.0*(a->bs2)*(a->nz) - A->rmap->bs*A->cmap->n);
1496:   return(0);
1497: }

1501: /*
1502:     For each block in an block array saves the largest absolute value in the block into another array
1503: */
1504: static PetscErrorCode MatBlockAbs_private(PetscInt nbs,PetscInt bs2,PetscScalar *blockarray,PetscReal *absarray)
1505: {
1507:   PetscInt       i,j;

1510:   PetscMemzero(absarray,(nbs+1)*sizeof(PetscReal));
1511:   for (i=0; i<nbs; i++) {
1512:     for (j=0; j<bs2; j++) {
1513:       if (absarray[i] < PetscAbsScalar(blockarray[i*nbs+j])) absarray[i] = PetscAbsScalar(blockarray[i*nbs+j]);
1514:     }
1515:   }
1516:   return(0);
1517: }

1521: /*
1522:      This needs to be renamed and called by the regular MatILUFactor_SeqBAIJ when drop tolerance is used
1523: */
1524: PetscErrorCode MatILUDTFactor_SeqBAIJ(Mat A,IS isrow,IS iscol,const MatFactorInfo *info,Mat *fact)
1525: {
1526:   Mat            B = *fact;
1527:   Mat_SeqBAIJ    *a=(Mat_SeqBAIJ*)A->data,*b;
1528:   IS             isicol;
1530:   const PetscInt *r,*ic;
1531:   PetscInt       i,mbs=a->mbs,bs=A->rmap->bs,bs2=a->bs2,*ai=a->i,*aj=a->j,*ajtmp,*adiag;
1532:   PetscInt       *bi,*bj,*bdiag;

1534:   PetscInt  row,nzi,nzi_bl,nzi_bu,*im,dtcount,nzi_al,nzi_au;
1535:   PetscInt  nlnk,*lnk;
1536:   PetscBT   lnkbt;
1537:   PetscBool row_identity,icol_identity;
1538:   MatScalar *aatmp,*pv,*batmp,*ba,*rtmp,*pc,*multiplier,*vtmp;
1539:   PetscInt  j,nz,*pj,*bjtmp,k,ncut,*jtmp;

1541:   PetscReal dt=info->dt;          /* shift=info->shiftamount; */
1542:   PetscInt  nnz_max;
1543:   PetscBool missing;
1544:   PetscReal *vtmp_abs;
1545:   MatScalar *v_work;
1546:   PetscInt  *v_pivots;

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

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

1556:   /* bdiag is location of diagonal in factor */
1557:   PetscMalloc1((mbs+1),&bdiag);

1559:   /* allocate row pointers bi */
1560:   PetscMalloc1((2*mbs+2),&bi);

1562:   /* allocate bj and ba; max num of nonzero entries is (ai[n]+2*n*dtcount+2) */
1563:   dtcount = (PetscInt)info->dtcount;
1564:   if (dtcount > mbs-1) dtcount = mbs-1;
1565:   nnz_max = ai[mbs]+2*mbs*dtcount +2;
1566:   /* printf("MatILUDTFactor_SeqBAIJ, bs %d, ai[mbs] %d, nnz_max  %d, dtcount %d\n",bs,ai[mbs],nnz_max,dtcount); */
1567:   PetscMalloc1(nnz_max,&bj);
1568:   nnz_max = nnz_max*bs2;
1569:   PetscMalloc1(nnz_max,&ba);

1571:   /* put together the new matrix */
1572:   MatSeqBAIJSetPreallocation_SeqBAIJ(B,bs,MAT_SKIP_ALLOCATION,NULL);
1573:   PetscLogObjectParent((PetscObject)B,(PetscObject)isicol);

1575:   b               = (Mat_SeqBAIJ*)(B)->data;
1576:   b->free_a       = PETSC_TRUE;
1577:   b->free_ij      = PETSC_TRUE;
1578:   b->singlemalloc = PETSC_FALSE;

1580:   b->a    = ba;
1581:   b->j    = bj;
1582:   b->i    = bi;
1583:   b->diag = bdiag;
1584:   b->ilen = 0;
1585:   b->imax = 0;
1586:   b->row  = isrow;
1587:   b->col  = iscol;

1589:   PetscObjectReference((PetscObject)isrow);
1590:   PetscObjectReference((PetscObject)iscol);

1592:   b->icol  = isicol;
1593:   PetscMalloc1((bs*(mbs+1)),&b->solve_work);
1594:   PetscLogObjectMemory((PetscObject)B,nnz_max*(sizeof(PetscInt)+sizeof(MatScalar)));
1595:   b->maxnz = nnz_max/bs2;

1597:   (B)->factortype            = MAT_FACTOR_ILUDT;
1598:   (B)->info.factor_mallocs   = 0;
1599:   (B)->info.fill_ratio_given = ((PetscReal)nnz_max)/((PetscReal)(ai[mbs]*bs2));
1600:   /* ------- end of symbolic factorization ---------*/
1601:   ISGetIndices(isrow,&r);
1602:   ISGetIndices(isicol,&ic);

1604:   /* linked list for storing column indices of the active row */
1605:   nlnk = mbs + 1;
1606:   PetscLLCreate(mbs,mbs,nlnk,lnk,lnkbt);

1608:   /* im: used by PetscLLAddSortedLU(); jtmp: working array for column indices of active row */
1609:   PetscMalloc2(mbs,&im,mbs,&jtmp);
1610:   /* rtmp, vtmp: working arrays for sparse and contiguous row entries of active row */
1611:   PetscMalloc2(mbs*bs2,&rtmp,mbs*bs2,&vtmp);
1612:   PetscMalloc1((mbs+1),&vtmp_abs);
1613:   PetscMalloc3(bs,&v_work,bs2,&multiplier,bs,&v_pivots);

1615:   bi[0]       = 0;
1616:   bdiag[0]    = (nnz_max/bs2)-1; /* location of diagonal in factor B */
1617:   bi[2*mbs+1] = bdiag[0]+1; /* endof bj and ba array */
1618:   for (i=0; i<mbs; i++) {
1619:     /* copy initial fill into linked list */
1620:     nzi = 0; /* nonzeros for active row i */
1621:     nzi = ai[r[i]+1] - ai[r[i]];
1622:     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);
1623:     nzi_al = adiag[r[i]] - ai[r[i]];
1624:     nzi_au = ai[r[i]+1] - adiag[r[i]] -1;
1625:     /* printf("row %d, nzi_al/au %d %d\n",i,nzi_al,nzi_au); */

1627:     /* load in initial unfactored row */
1628:     ajtmp = aj + ai[r[i]];
1629:     PetscLLAddPerm(nzi,ajtmp,ic,mbs,nlnk,lnk,lnkbt);
1630:     PetscMemzero(rtmp,mbs*bs2*sizeof(PetscScalar));
1631:     aatmp = a->a + bs2*ai[r[i]];
1632:     for (j=0; j<nzi; j++) {
1633:       PetscMemcpy(rtmp+bs2*ic[ajtmp[j]],aatmp+bs2*j,bs2*sizeof(MatScalar));
1634:     }

1636:     /* add pivot rows into linked list */
1637:     row = lnk[mbs];
1638:     while (row < i) {
1639:       nzi_bl = bi[row+1] - bi[row] + 1;
1640:       bjtmp  = bj + bdiag[row+1]+1; /* points to 1st column next to the diagonal in U */
1641:       PetscLLAddSortedLU(bjtmp,row,nlnk,lnk,lnkbt,i,nzi_bl,im);
1642:       nzi   += nlnk;
1643:       row    = lnk[row];
1644:     }

1646:     /* copy data from lnk into jtmp, then initialize lnk */
1647:     PetscLLClean(mbs,mbs,nzi,lnk,jtmp,lnkbt);

1649:     /* numerical factorization */
1650:     bjtmp = jtmp;
1651:     row   = *bjtmp++; /* 1st pivot row */

1653:     while  (row < i) {
1654:       pc = rtmp + bs2*row;
1655:       pv = ba + bs2*bdiag[row]; /* inv(diag) of the pivot row */
1656:       PetscKernel_A_gets_A_times_B(bs,pc,pv,multiplier); /* pc= multiplier = pc*inv(diag[row]) */
1657:       MatBlockAbs_private(1,bs2,pc,vtmp_abs);
1658:       if (vtmp_abs[0] > dt) { /* apply tolerance dropping rule */
1659:         pj = bj + bdiag[row+1] + 1;         /* point to 1st entry of U(row,:) */
1660:         pv = ba + bs2*(bdiag[row+1] + 1);
1661:         nz = bdiag[row] - bdiag[row+1] - 1;         /* num of entries in U(row,:), excluding diagonal */
1662:         for (j=0; j<nz; j++) {
1663:           PetscKernel_A_gets_A_minus_B_times_C(bs,rtmp+bs2*pj[j],pc,pv+bs2*j);
1664:         }
1665:         /* PetscLogFlops(bslog*(nz+1.0)-bs); */
1666:       }
1667:       row = *bjtmp++;
1668:     }

1670:     /* copy sparse rtmp into contiguous vtmp; separate L and U part */
1671:     nzi_bl = 0; j = 0;
1672:     while (jtmp[j] < i) { /* L-part. Note: jtmp is sorted */
1673:       PetscMemcpy(vtmp+bs2*j,rtmp+bs2*jtmp[j],bs2*sizeof(MatScalar));
1674:       nzi_bl++; j++;
1675:     }
1676:     nzi_bu = nzi - nzi_bl -1;
1677:     /* printf("nzi %d, nzi_bl %d, nzi_bu %d\n",nzi,nzi_bl,nzi_bu); */

1679:     while (j < nzi) { /* U-part */
1680:       PetscMemcpy(vtmp+bs2*j,rtmp+bs2*jtmp[j],bs2*sizeof(MatScalar));
1681:       /*
1682:       printf(" col %d: ",jtmp[j]);
1683:       for (j1=0; j1<bs2; j1++) printf(" %g",*(vtmp+bs2*j+j1));
1684:       printf(" \n");
1685:       */
1686:       j++;
1687:     }

1689:     MatBlockAbs_private(nzi,bs2,vtmp,vtmp_abs);
1690:     /*
1691:     printf(" row %d, nzi %d, vtmp_abs\n",i,nzi);
1692:     for (j1=0; j1<nzi; j1++) printf(" (%d %g),",jtmp[j1],vtmp_abs[j1]);
1693:     printf(" \n");
1694:     */
1695:     bjtmp = bj + bi[i];
1696:     batmp = ba + bs2*bi[i];
1697:     /* apply level dropping rule to L part */
1698:     ncut = nzi_al + dtcount;
1699:     if (ncut < nzi_bl) {
1700:       PetscSortSplitReal(ncut,nzi_bl,vtmp_abs,jtmp);
1701:       PetscSortIntWithScalarArray(ncut,jtmp,vtmp);
1702:     } else {
1703:       ncut = nzi_bl;
1704:     }
1705:     for (j=0; j<ncut; j++) {
1706:       bjtmp[j] = jtmp[j];
1707:       PetscMemcpy(batmp+bs2*j,rtmp+bs2*bjtmp[j],bs2*sizeof(MatScalar));
1708:       /*
1709:       printf(" col %d: ",bjtmp[j]);
1710:       for (j1=0; j1<bs2; j1++) printf(" %g,",*(batmp+bs2*j+j1));
1711:       printf("\n");
1712:       */
1713:     }
1714:     bi[i+1] = bi[i] + ncut;
1715:     nzi     = ncut + 1;

1717:     /* apply level dropping rule to U part */
1718:     ncut = nzi_au + dtcount;
1719:     if (ncut < nzi_bu) {
1720:       PetscSortSplitReal(ncut,nzi_bu,vtmp_abs+nzi_bl+1,jtmp+nzi_bl+1);
1721:       PetscSortIntWithScalarArray(ncut,jtmp+nzi_bl+1,vtmp+nzi_bl+1);
1722:     } else {
1723:       ncut = nzi_bu;
1724:     }
1725:     nzi += ncut;

1727:     /* mark bdiagonal */
1728:     bdiag[i+1]    = bdiag[i] - (ncut + 1);
1729:     bi[2*mbs - i] = bi[2*mbs - i +1] - (ncut + 1);

1731:     bjtmp  = bj + bdiag[i];
1732:     batmp  = ba + bs2*bdiag[i];
1733:     PetscMemcpy(batmp,rtmp+bs2*i,bs2*sizeof(MatScalar));
1734:     *bjtmp = i;
1735:     /*
1736:     printf(" diag %d: ",*bjtmp);
1737:     for (j=0; j<bs2; j++) {
1738:       printf(" %g,",batmp[j]);
1739:     }
1740:     printf("\n");
1741:     */
1742:     bjtmp = bj + bdiag[i+1]+1;
1743:     batmp = ba + (bdiag[i+1]+1)*bs2;

1745:     for (k=0; k<ncut; k++) {
1746:       bjtmp[k] = jtmp[nzi_bl+1+k];
1747:       PetscMemcpy(batmp+bs2*k,rtmp+bs2*bjtmp[k],bs2*sizeof(MatScalar));
1748:       /*
1749:       printf(" col %d:",bjtmp[k]);
1750:       for (j1=0; j1<bs2; j1++) printf(" %g,",*(batmp+bs2*k+j1));
1751:       printf("\n");
1752:       */
1753:     }

1755:     im[i] = nzi; /* used by PetscLLAddSortedLU() */

1757:     /* invert diagonal block for simplier triangular solves - add shift??? */
1758:     batmp = ba + bs2*bdiag[i];
1759:     PetscKernel_A_gets_inverse_A(bs,batmp,v_pivots,v_work);
1760:   } /* for (i=0; i<mbs; i++) */
1761:   PetscFree3(v_work,multiplier,v_pivots);

1763:   /* printf("end of L %d, beginning of U %d\n",bi[mbs],bdiag[mbs]); */
1764:   if (bi[mbs] >= bdiag[mbs]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"end of L array %d cannot >= the beginning of U array %d",bi[mbs],bdiag[mbs]);

1766:   ISRestoreIndices(isrow,&r);
1767:   ISRestoreIndices(isicol,&ic);

1769:   PetscLLDestroy(lnk,lnkbt);

1771:   PetscFree2(im,jtmp);
1772:   PetscFree2(rtmp,vtmp);

1774:   PetscLogFlops(bs2*B->cmap->n);
1775:   b->maxnz = b->nz = bi[mbs] + bdiag[0] - bdiag[mbs];

1777:   ISIdentity(isrow,&row_identity);
1778:   ISIdentity(isicol,&icol_identity);
1779:   if (row_identity && icol_identity) {
1780:     B->ops->solve = MatSolve_SeqBAIJ_N_NaturalOrdering;
1781:   } else {
1782:     B->ops->solve = MatSolve_SeqBAIJ_N;
1783:   }

1785:   B->ops->solveadd          = 0;
1786:   B->ops->solvetranspose    = 0;
1787:   B->ops->solvetransposeadd = 0;
1788:   B->ops->matsolve          = 0;
1789:   B->assembled              = PETSC_TRUE;
1790:   B->preallocated           = PETSC_TRUE;
1791:   return(0);
1792: }