1 /*$Id: aijfact.c,v 1.167 2001/09/11 16:32:26 bsmith Exp $*/ 2 3 #include "src/mat/impls/aij/seq/aij.h" 4 #include "src/vec/vecimpl.h" 5 #include "src/inline/dot.h" 6 7 #undef __FUNCT__ 8 #define __FUNCT__ "MatOrdering_Flow_SeqAIJ" 9 int MatOrdering_Flow_SeqAIJ(Mat mat,MatOrderingType type,IS *irow,IS *icol) 10 { 11 PetscFunctionBegin; 12 13 SETERRQ(PETSC_ERR_SUP,"Code not written"); 14 #if !defined(PETSC_USE_DEBUG) 15 PetscFunctionReturn(0); 16 #endif 17 } 18 19 20 EXTERN int MatMarkDiagonal_SeqAIJ(Mat); 21 EXTERN int Mat_AIJ_CheckInode(Mat,PetscTruth); 22 23 EXTERN int SPARSEKIT2dperm(int*,PetscScalar*,int*,int*,PetscScalar*,int*,int*,int*,int*,int*); 24 EXTERN int SPARSEKIT2ilutp(int*,PetscScalar*,int*,int*,int*,PetscReal,PetscReal*,int*,PetscScalar*,int*,int*,int*,PetscScalar*,int*,int*,int*); 25 EXTERN int SPARSEKIT2msrcsr(int*,PetscScalar*,int*,PetscScalar*,int*,int*,PetscScalar*,int*); 26 27 #undef __FUNCT__ 28 #define __FUNCT__ "MatILUDTFactor_SeqAIJ" 29 /* ------------------------------------------------------------ 30 31 This interface was contribed by Tony Caola 32 33 This routine is an interface to the pivoting drop-tolerance 34 ILU routine written by Yousef Saad (saad@cs.umn.edu) as part of 35 SPARSEKIT2. 36 37 The SPARSEKIT2 routines used here are covered by the GNU 38 copyright; see the file gnu in this directory. 39 40 Thanks to Prof. Saad, Dr. Hysom, and Dr. Smith for their 41 help in getting this routine ironed out. 42 43 The major drawback to this routine is that if info->fill is 44 not large enough it fails rather than allocating more space; 45 this can be fixed by hacking/improving the f2c version of 46 Yousef Saad's code. 47 48 ishift = 0, for indices start at 1 49 ishift = 1, for indices starting at 0 50 ------------------------------------------------------------ 51 */ 52 53 int MatILUDTFactor_SeqAIJ(Mat A,MatILUInfo *info,IS isrow,IS iscol,Mat *fact) 54 { 55 Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data,*b; 56 IS iscolf,isicol,isirow; 57 PetscTruth reorder; 58 int *c,*r,*ic,ierr,i,n = A->m; 59 int *old_i = a->i,*old_j = a->j,*new_i,*old_i2 = 0,*old_j2 = 0,*new_j; 60 int *ordcol,*iwk,*iperm,*jw; 61 int ishift = !a->indexshift; 62 int jmax,lfill,job,*o_i,*o_j; 63 PetscScalar *old_a = a->a,*w,*new_a,*old_a2 = 0,*wk,*o_a; 64 PetscReal permtol,af; 65 66 PetscFunctionBegin; 67 68 if (info->dt == PETSC_DEFAULT) info->dt = .005; 69 if (info->dtcount == PETSC_DEFAULT) info->dtcount = (int)(1.5*a->rmax); 70 if (info->dtcol == PETSC_DEFAULT) info->dtcol = .01; 71 if (info->fill == PETSC_DEFAULT) info->fill = ((double)(n*(info->dtcount+1)))/a->nz; 72 lfill = (int)(info->dtcount/2.0); 73 jmax = (int)(info->fill*a->nz); 74 permtol = info->dtcol; 75 76 77 /* ------------------------------------------------------------ 78 If reorder=.TRUE., then the original matrix has to be 79 reordered to reflect the user selected ordering scheme, and 80 then de-reordered so it is in it's original format. 81 Because Saad's dperm() is NOT in place, we have to copy 82 the original matrix and allocate more storage. . . 83 ------------------------------------------------------------ 84 */ 85 86 /* set reorder to true if either isrow or iscol is not identity */ 87 ierr = ISIdentity(isrow,&reorder);CHKERRQ(ierr); 88 if (reorder) {ierr = ISIdentity(iscol,&reorder);CHKERRQ(ierr);} 89 reorder = PetscNot(reorder); 90 91 92 /* storage for ilu factor */ 93 ierr = PetscMalloc((n+1)*sizeof(int),&new_i);CHKERRQ(ierr); 94 ierr = PetscMalloc(jmax*sizeof(int),&new_j);CHKERRQ(ierr); 95 ierr = PetscMalloc(jmax*sizeof(PetscScalar),&new_a);CHKERRQ(ierr); 96 ierr = PetscMalloc(n*sizeof(int),&ordcol);CHKERRQ(ierr); 97 98 /* ------------------------------------------------------------ 99 Make sure that everything is Fortran formatted (1-Based) 100 ------------------------------------------------------------ 101 */ 102 if (ishift) { 103 for (i=old_i[0];i<old_i[n];i++) { 104 old_j[i]++; 105 } 106 for(i=0;i<n+1;i++) { 107 old_i[i]++; 108 }; 109 }; 110 111 if (reorder) { 112 ierr = ISGetIndices(iscol,&c); CHKERRQ(ierr); 113 ierr = ISGetIndices(isrow,&r); CHKERRQ(ierr); 114 for(i=0;i<n;i++) { 115 r[i] = r[i]+1; 116 c[i] = c[i]+1; 117 } 118 ierr = PetscMalloc((n+1)*sizeof(int),&old_i2);CHKERRQ(ierr); 119 ierr = PetscMalloc((old_i[n]-old_i[0]+1)*sizeof(int),&old_j2);CHKERRQ(ierr); 120 ierr = PetscMalloc((old_i[n]-old_i[0]+1)*sizeof(PetscScalar),&old_a2);CHKERRQ(ierr); 121 job = 3; SPARSEKIT2dperm(&n,old_a,old_j,old_i,old_a2,old_j2,old_i2,r,c,&job); 122 for (i=0;i<n;i++) { 123 r[i] = r[i]-1; 124 c[i] = c[i]-1; 125 } 126 ierr = ISRestoreIndices(iscol,&c);CHKERRQ(ierr); 127 ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr); 128 o_a = old_a2; 129 o_j = old_j2; 130 o_i = old_i2; 131 } else { 132 o_a = old_a; 133 o_j = old_j; 134 o_i = old_i; 135 } 136 137 /* ------------------------------------------------------------ 138 Call Saad's ilutp() routine to generate the factorization 139 ------------------------------------------------------------ 140 */ 141 142 ierr = PetscMalloc(2*n*sizeof(int),&iperm);CHKERRQ(ierr); 143 ierr = PetscMalloc(2*n*sizeof(int),&jw);CHKERRQ(ierr); 144 ierr = PetscMalloc(n*sizeof(PetscScalar),&w);CHKERRQ(ierr); 145 146 SPARSEKIT2ilutp(&n,o_a,o_j,o_i,&lfill,(PetscReal)info->dt,&permtol,&n,new_a,new_j,new_i,&jmax,w,jw,iperm,&ierr); 147 if (ierr) { 148 switch (ierr) { 149 case -3: SETERRQ2(1,"ilutp(), matrix U overflows, need larger info->fill current fill %g space allocated %d",info->fill,jmax); 150 case -2: SETERRQ2(1,"ilutp(), matrix L overflows, need larger info->fill current fill %g space allocated %d",info->fill,jmax); 151 case -5: SETERRQ(1,"ilutp(), zero row encountered"); 152 case -1: SETERRQ(1,"ilutp(), input matrix may be wrong"); 153 case -4: SETERRQ1(1,"ilutp(), illegal info->fill value %d",jmax); 154 default: SETERRQ1(1,"ilutp(), zero pivot detected on row %d",ierr); 155 } 156 } 157 158 ierr = PetscFree(w);CHKERRQ(ierr); 159 ierr = PetscFree(jw);CHKERRQ(ierr); 160 161 /* ------------------------------------------------------------ 162 Saad's routine gives the result in Modified Sparse Row (msr) 163 Convert to Compressed Sparse Row format (csr) 164 ------------------------------------------------------------ 165 */ 166 167 ierr = PetscMalloc(n*sizeof(PetscScalar),&wk);CHKERRQ(ierr); 168 ierr = PetscMalloc((n+1)*sizeof(int),&iwk);CHKERRQ(ierr); 169 170 SPARSEKIT2msrcsr(&n,new_a,new_j,new_a,new_j,new_i,wk,iwk); 171 172 ierr = PetscFree(iwk);CHKERRQ(ierr); 173 ierr = PetscFree(wk);CHKERRQ(ierr); 174 175 if (reorder) { 176 ierr = PetscFree(old_a2);CHKERRQ(ierr); 177 ierr = PetscFree(old_j2);CHKERRQ(ierr); 178 ierr = PetscFree(old_i2);CHKERRQ(ierr); 179 } else { 180 /* fix permutation of old_j that the factorization introduced */ 181 for (i=old_i[0]; i<old_i[n]; i++) { 182 old_j[i-1] = iperm[old_j[i-1]-1]; 183 } 184 } 185 186 /* get rid of the shift to indices starting at 1 */ 187 if (ishift) { 188 for (i=0; i<n+1; i++) { 189 old_i[i]--; 190 } 191 for (i=old_i[0];i<old_i[n];i++) { 192 old_j[i]--; 193 } 194 } 195 196 /* Make the factored matrix 0-based */ 197 if (ishift) { 198 for (i=0; i<n+1; i++) { 199 new_i[i]--; 200 } 201 for (i=new_i[0];i<new_i[n];i++) { 202 new_j[i]--; 203 } 204 } 205 206 /*-- due to the pivoting, we need to reorder iscol to correctly --*/ 207 /*-- permute the right-hand-side and solution vectors --*/ 208 ierr = ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);CHKERRQ(ierr); 209 ierr = ISInvertPermutation(isrow,PETSC_DECIDE,&isirow);CHKERRQ(ierr); 210 ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr); 211 for(i=0; i<n; i++) { 212 ordcol[i] = ic[iperm[i]-1]; 213 }; 214 ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr); 215 ierr = ISDestroy(isicol);CHKERRQ(ierr); 216 217 ierr = PetscFree(iperm);CHKERRQ(ierr); 218 219 ierr = ISCreateGeneral(PETSC_COMM_SELF,n,ordcol,&iscolf);CHKERRQ(ierr); 220 ierr = PetscFree(ordcol);CHKERRQ(ierr); 221 222 /*----- put together the new matrix -----*/ 223 224 ierr = MatCreateSeqAIJ(A->comm,n,n,0,PETSC_NULL,fact);CHKERRQ(ierr); 225 (*fact)->factor = FACTOR_LU; 226 (*fact)->assembled = PETSC_TRUE; 227 228 b = (Mat_SeqAIJ*)(*fact)->data; 229 ierr = PetscFree(b->imax);CHKERRQ(ierr); 230 b->sorted = PETSC_FALSE; 231 b->singlemalloc = PETSC_FALSE; 232 /* the next line frees the default space generated by the MatCreate() */ 233 ierr = PetscFree(b->a);CHKERRQ(ierr); 234 ierr = PetscFree(b->ilen);CHKERRQ(ierr); 235 b->a = new_a; 236 b->j = new_j; 237 b->i = new_i; 238 b->ilen = 0; 239 b->imax = 0; 240 /* I am not sure why these are the inverses of the row and column permutations; but the other way is NO GOOD */ 241 b->row = isirow; 242 b->col = iscolf; 243 ierr = PetscMalloc((n+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr); 244 b->maxnz = b->nz = new_i[n]; 245 b->indexshift = a->indexshift; 246 ierr = MatMarkDiagonal_SeqAIJ(*fact);CHKERRQ(ierr); 247 (*fact)->info.factor_mallocs = 0; 248 249 ierr = MatMarkDiagonal_SeqAIJ(A);CHKERRQ(ierr); 250 251 /* check out for identical nodes. If found, use inode functions */ 252 ierr = Mat_AIJ_CheckInode(*fact,PETSC_FALSE);CHKERRQ(ierr); 253 254 af = ((double)b->nz)/((double)a->nz) + .001; 255 PetscLogInfo(A,"MatILUDTFactor_SeqAIJ:Fill ratio:given %g needed %g\n",info->fill,af); 256 PetscLogInfo(A,"MatILUDTFactor_SeqAIJ:Run with -pc_ilu_fill %g or use \n",af); 257 PetscLogInfo(A,"MatILUDTFactor_SeqAIJ:PCILUSetFill(pc,%g);\n",af); 258 PetscLogInfo(A,"MatILUDTFactor_SeqAIJ:for best performance.\n"); 259 260 PetscFunctionReturn(0); 261 } 262 263 /* 264 Factorization code for AIJ format. 265 */ 266 #undef __FUNCT__ 267 #define __FUNCT__ "MatLUFactorSymbolic_SeqAIJ" 268 int MatLUFactorSymbolic_SeqAIJ(Mat A,IS isrow,IS iscol,MatLUInfo *info,Mat *B) 269 { 270 Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data,*b; 271 IS isicol; 272 int *r,*ic,ierr,i,n = A->m,*ai = a->i,*aj = a->j; 273 int *ainew,*ajnew,jmax,*fill,*ajtmp,nz,shift = a->indexshift; 274 int *idnew,idx,row,m,fm,nnz,nzi,realloc = 0,nzbd,*im; 275 PetscReal f; 276 277 PetscFunctionBegin; 278 if (A->M != A->N) SETERRQ(PETSC_ERR_ARG_WRONG,"matrix must be square"); 279 ierr = ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);CHKERRQ(ierr); 280 ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr); 281 ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr); 282 283 /* get new row pointers */ 284 ierr = PetscMalloc((n+1)*sizeof(int),&ainew);CHKERRQ(ierr); 285 ainew[0] = -shift; 286 /* don't know how many column pointers are needed so estimate */ 287 f = info->fill; 288 jmax = (int)(f*ai[n]+(!shift)); 289 ierr = PetscMalloc((jmax)*sizeof(int),&ajnew);CHKERRQ(ierr); 290 /* fill is a linked list of nonzeros in active row */ 291 ierr = PetscMalloc((2*n+1)*sizeof(int),&fill);CHKERRQ(ierr); 292 im = fill + n + 1; 293 /* idnew is location of diagonal in factor */ 294 ierr = PetscMalloc((n+1)*sizeof(int),&idnew);CHKERRQ(ierr); 295 idnew[0] = -shift; 296 297 for (i=0; i<n; i++) { 298 /* first copy previous fill into linked list */ 299 nnz = nz = ai[r[i]+1] - ai[r[i]]; 300 if (!nz) SETERRQ(PETSC_ERR_MAT_LU_ZRPVT,"Empty row in matrix"); 301 ajtmp = aj + ai[r[i]] + shift; 302 fill[n] = n; 303 while (nz--) { 304 fm = n; 305 idx = ic[*ajtmp++ + shift]; 306 do { 307 m = fm; 308 fm = fill[m]; 309 } while (fm < idx); 310 fill[m] = idx; 311 fill[idx] = fm; 312 } 313 row = fill[n]; 314 while (row < i) { 315 ajtmp = ajnew + idnew[row] + (!shift); 316 nzbd = 1 + idnew[row] - ainew[row]; 317 nz = im[row] - nzbd; 318 fm = row; 319 while (nz-- > 0) { 320 idx = *ajtmp++ + shift; 321 nzbd++; 322 if (idx == i) im[row] = nzbd; 323 do { 324 m = fm; 325 fm = fill[m]; 326 } while (fm < idx); 327 if (fm != idx) { 328 fill[m] = idx; 329 fill[idx] = fm; 330 fm = idx; 331 nnz++; 332 } 333 } 334 row = fill[row]; 335 } 336 /* copy new filled row into permanent storage */ 337 ainew[i+1] = ainew[i] + nnz; 338 if (ainew[i+1] > jmax) { 339 340 /* estimate how much additional space we will need */ 341 /* use the strategy suggested by David Hysom <hysom@perch-t.icase.edu> */ 342 /* just double the memory each time */ 343 int maxadd = jmax; 344 /* maxadd = (int)((f*(ai[n]+(!shift))*(n-i+5))/n); */ 345 if (maxadd < nnz) maxadd = (n-i)*(nnz+1); 346 jmax += maxadd; 347 348 /* allocate a longer ajnew */ 349 ierr = PetscMalloc(jmax*sizeof(int),&ajtmp);CHKERRQ(ierr); 350 ierr = PetscMemcpy(ajtmp,ajnew,(ainew[i]+shift)*sizeof(int));CHKERRQ(ierr); 351 ierr = PetscFree(ajnew);CHKERRQ(ierr); 352 ajnew = ajtmp; 353 realloc++; /* count how many times we realloc */ 354 } 355 ajtmp = ajnew + ainew[i] + shift; 356 fm = fill[n]; 357 nzi = 0; 358 im[i] = nnz; 359 while (nnz--) { 360 if (fm < i) nzi++; 361 *ajtmp++ = fm - shift; 362 fm = fill[fm]; 363 } 364 idnew[i] = ainew[i] + nzi; 365 } 366 if (ai[n] != 0) { 367 PetscReal af = ((PetscReal)ainew[n])/((PetscReal)ai[n]); 368 PetscLogInfo(A,"MatLUFactorSymbolic_SeqAIJ:Reallocs %d Fill ratio:given %g needed %g\n",realloc,f,af); 369 PetscLogInfo(A,"MatLUFactorSymbolic_SeqAIJ:Run with -pc_lu_fill %g or use \n",af); 370 PetscLogInfo(A,"MatLUFactorSymbolic_SeqAIJ:PCLUSetFill(pc,%g);\n",af); 371 PetscLogInfo(A,"MatLUFactorSymbolic_SeqAIJ:for best performance.\n"); 372 } else { 373 PetscLogInfo(A,"MatLUFactorSymbolic_SeqAIJ: Empty matrix\n"); 374 } 375 376 ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr); 377 ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr); 378 379 ierr = PetscFree(fill);CHKERRQ(ierr); 380 381 /* put together the new matrix */ 382 ierr = MatCreateSeqAIJ(A->comm,n,n,0,PETSC_NULL,B);CHKERRQ(ierr); 383 PetscLogObjectParent(*B,isicol); 384 b = (Mat_SeqAIJ*)(*B)->data; 385 ierr = PetscFree(b->imax);CHKERRQ(ierr); 386 b->singlemalloc = PETSC_FALSE; 387 /* the next line frees the default space generated by the Create() */ 388 ierr = PetscFree(b->a);CHKERRQ(ierr); 389 ierr = PetscFree(b->ilen);CHKERRQ(ierr); 390 ierr = PetscMalloc((ainew[n]+shift+1)*sizeof(PetscScalar),&b->a);CHKERRQ(ierr); 391 b->j = ajnew; 392 b->i = ainew; 393 b->diag = idnew; 394 b->ilen = 0; 395 b->imax = 0; 396 b->row = isrow; 397 b->col = iscol; 398 b->lu_damping = info->damping; 399 b->lu_zeropivot = info->zeropivot; 400 ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr); 401 ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr); 402 b->icol = isicol; 403 ierr = PetscMalloc((n+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr); 404 /* In b structure: Free imax, ilen, old a, old j. 405 Allocate idnew, solve_work, new a, new j */ 406 PetscLogObjectMemory(*B,(ainew[n]+shift-n)*(sizeof(int)+sizeof(PetscScalar))); 407 b->maxnz = b->nz = ainew[n] + shift; 408 409 (*B)->factor = FACTOR_LU; 410 (*B)->info.factor_mallocs = realloc; 411 (*B)->info.fill_ratio_given = f; 412 ierr = Mat_AIJ_CheckInode(*B,PETSC_FALSE);CHKERRQ(ierr); 413 (*B)->ops->lufactornumeric = A->ops->lufactornumeric; /* Use Inode variant ONLY if A has inodes */ 414 415 if (ai[n] != 0) { 416 (*B)->info.fill_ratio_needed = ((PetscReal)ainew[n])/((PetscReal)ai[n]); 417 } else { 418 (*B)->info.fill_ratio_needed = 0.0; 419 } 420 PetscFunctionReturn(0); 421 } 422 /* ----------------------------------------------------------- */ 423 EXTERN int Mat_AIJ_CheckInode(Mat,PetscTruth); 424 425 #undef __FUNCT__ 426 #define __FUNCT__ "MatLUFactorNumeric_SeqAIJ" 427 int MatLUFactorNumeric_SeqAIJ(Mat A,Mat *B) 428 { 429 Mat C = *B; 430 Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data,*b = (Mat_SeqAIJ *)C->data; 431 IS isrow = b->row,isicol = b->icol; 432 int *r,*ic,ierr,i,j,n = A->m,*ai = b->i,*aj = b->j; 433 int *ajtmpold,*ajtmp,nz,row,*ics,shift = a->indexshift; 434 int *diag_offset = b->diag,diag; 435 int *pj,ndamp = 0; 436 PetscScalar *rtmp,*v,*pc,multiplier,*pv,*rtmps; 437 PetscReal damping = b->lu_damping, zeropivot = b->lu_zeropivot,rs; 438 PetscTruth damp = PETSC_FALSE; 439 440 PetscFunctionBegin; 441 ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr); 442 ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr); 443 ierr = PetscMalloc((n+1)*sizeof(PetscScalar),&rtmp);CHKERRQ(ierr); 444 ierr = PetscMemzero(rtmp,(n+1)*sizeof(PetscScalar));CHKERRQ(ierr); 445 rtmps = rtmp + shift; ics = ic + shift; 446 447 do { 448 for (i=0; i<n; i++) { 449 nz = ai[i+1] - ai[i]; 450 ajtmp = aj + ai[i] + shift; 451 for (j=0; j<nz; j++) rtmps[ajtmp[j]] = 0.0; 452 453 /* load in initial (unfactored row) */ 454 nz = a->i[r[i]+1] - a->i[r[i]]; 455 ajtmpold = a->j + a->i[r[i]] + shift; 456 v = a->a + a->i[r[i]] + shift; 457 for (j=0; j<nz; j++) { 458 rtmp[ics[ajtmpold[j]]] = v[j]; 459 if (damp && ajtmpold[j] == r[i]) { /* damp the diagonal of the matrix */ 460 rtmp[ics[ajtmpold[j]]] += damping; 461 } 462 } 463 464 row = *ajtmp++ + shift; 465 while (row < i) { 466 pc = rtmp + row; 467 if (*pc != 0.0) { 468 pv = b->a + diag_offset[row] + shift; 469 pj = b->j + diag_offset[row] + (!shift); 470 multiplier = *pc / *pv++; 471 *pc = multiplier; 472 nz = ai[row+1] - diag_offset[row] - 1; 473 for (j=0; j<nz; j++) rtmps[pj[j]] -= multiplier * pv[j]; 474 PetscLogFlops(2*nz); 475 } 476 row = *ajtmp++ + shift; 477 } 478 /* finished row so stick it into b->a */ 479 pv = b->a + ai[i] + shift; 480 pj = b->j + ai[i] + shift; 481 nz = ai[i+1] - ai[i]; 482 diag = diag_offset[i] - ai[i]; 483 /* 9/13/02 Victor Eijkhout suggested scaling zeropivot by rs for matrices with funny scalings */ 484 rs = 0.0; 485 for (j=0; j<nz; j++) { 486 pv[j] = rtmps[pj[j]]; 487 if (j != diag) rs += PetscAbsScalar(pv[j]); 488 } 489 if (PetscAbsScalar(pv[diag]) < zeropivot*rs) { 490 if (damping) { 491 if (damp) damping *= 2.0; 492 damp = PETSC_TRUE; 493 ndamp++; 494 break; 495 } else { 496 SETERRQ3(PETSC_ERR_MAT_LU_ZRPVT,"Zero pivot row %d value %g tolerance %g",i,PetscAbsScalar(pv[diag]),zeropivot); 497 } 498 } 499 } 500 } while (damp); 501 502 /* invert diagonal entries for simplier triangular solves */ 503 for (i=0; i<n; i++) { 504 b->a[diag_offset[i]+shift] = 1.0/b->a[diag_offset[i]+shift]; 505 } 506 507 ierr = PetscFree(rtmp);CHKERRQ(ierr); 508 ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr); 509 ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr); 510 C->factor = FACTOR_LU; 511 (*B)->ops->lufactornumeric = A->ops->lufactornumeric; /* Use Inode variant ONLY if A has inodes */ 512 C->assembled = PETSC_TRUE; 513 PetscLogFlops(C->n); 514 if (ndamp) { 515 PetscLogInfo(0,"MatLUFactorNumerical_SeqAIJ: number of damping tries %d damping value %g\n",ndamp,damping); 516 } 517 PetscFunctionReturn(0); 518 } 519 /* ----------------------------------------------------------- */ 520 #undef __FUNCT__ 521 #define __FUNCT__ "MatLUFactor_SeqAIJ" 522 int MatLUFactor_SeqAIJ(Mat A,IS row,IS col,MatLUInfo *info) 523 { 524 int ierr; 525 Mat C; 526 527 PetscFunctionBegin; 528 ierr = MatLUFactorSymbolic(A,row,col,info,&C);CHKERRQ(ierr); 529 ierr = MatLUFactorNumeric(A,&C);CHKERRQ(ierr); 530 ierr = MatHeaderCopy(A,C);CHKERRQ(ierr); 531 PetscLogObjectParent(A,((Mat_SeqAIJ*)(A->data))->icol); 532 PetscFunctionReturn(0); 533 } 534 /* ----------------------------------------------------------- */ 535 #undef __FUNCT__ 536 #define __FUNCT__ "MatSolve_SeqAIJ" 537 int MatSolve_SeqAIJ(Mat A,Vec bb,Vec xx) 538 { 539 Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data; 540 IS iscol = a->col,isrow = a->row; 541 int *r,*c,ierr,i, n = A->m,*vi,*ai = a->i,*aj = a->j; 542 int nz,shift = a->indexshift,*rout,*cout; 543 PetscScalar *x,*b,*tmp,*tmps,*aa = a->a,sum,*v; 544 545 PetscFunctionBegin; 546 if (!n) PetscFunctionReturn(0); 547 548 ierr = VecGetArray(bb,&b);CHKERRQ(ierr); 549 ierr = VecGetArray(xx,&x);CHKERRQ(ierr); 550 tmp = a->solve_work; 551 552 ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout; 553 ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout + (n-1); 554 555 /* forward solve the lower triangular */ 556 tmp[0] = b[*r++]; 557 tmps = tmp + shift; 558 for (i=1; i<n; i++) { 559 v = aa + ai[i] + shift; 560 vi = aj + ai[i] + shift; 561 nz = a->diag[i] - ai[i]; 562 sum = b[*r++]; 563 while (nz--) sum -= *v++ * tmps[*vi++]; 564 tmp[i] = sum; 565 } 566 567 /* backward solve the upper triangular */ 568 for (i=n-1; i>=0; i--){ 569 v = aa + a->diag[i] + (!shift); 570 vi = aj + a->diag[i] + (!shift); 571 nz = ai[i+1] - a->diag[i] - 1; 572 sum = tmp[i]; 573 while (nz--) sum -= *v++ * tmps[*vi++]; 574 x[*c--] = tmp[i] = sum*aa[a->diag[i]+shift]; 575 } 576 577 ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr); 578 ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr); 579 ierr = VecRestoreArray(bb,&b);CHKERRQ(ierr); 580 ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr); 581 PetscLogFlops(2*a->nz - A->n); 582 PetscFunctionReturn(0); 583 } 584 585 /* ----------------------------------------------------------- */ 586 #undef __FUNCT__ 587 #define __FUNCT__ "MatSolve_SeqAIJ_NaturalOrdering" 588 int MatSolve_SeqAIJ_NaturalOrdering(Mat A,Vec bb,Vec xx) 589 { 590 Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data; 591 int n = A->m,*ai = a->i,*aj = a->j,*adiag = a->diag,ierr; 592 PetscScalar *x,*b,*aa = a->a; 593 #if !defined(PETSC_USE_FORTRAN_KERNEL_SOLVEAIJ) 594 int adiag_i,i,*vi,nz,ai_i; 595 PetscScalar *v,sum; 596 #endif 597 598 PetscFunctionBegin; 599 if (!n) PetscFunctionReturn(0); 600 if (a->indexshift) { 601 ierr = MatSolve_SeqAIJ(A,bb,xx);CHKERRQ(ierr); 602 PetscFunctionReturn(0); 603 } 604 605 ierr = VecGetArray(bb,&b);CHKERRQ(ierr); 606 ierr = VecGetArray(xx,&x);CHKERRQ(ierr); 607 608 #if defined(PETSC_USE_FORTRAN_KERNEL_SOLVEAIJ) 609 fortransolveaij_(&n,x,ai,aj,adiag,aa,b); 610 #else 611 /* forward solve the lower triangular */ 612 x[0] = b[0]; 613 for (i=1; i<n; i++) { 614 ai_i = ai[i]; 615 v = aa + ai_i; 616 vi = aj + ai_i; 617 nz = adiag[i] - ai_i; 618 sum = b[i]; 619 while (nz--) sum -= *v++ * x[*vi++]; 620 x[i] = sum; 621 } 622 623 /* backward solve the upper triangular */ 624 for (i=n-1; i>=0; i--){ 625 adiag_i = adiag[i]; 626 v = aa + adiag_i + 1; 627 vi = aj + adiag_i + 1; 628 nz = ai[i+1] - adiag_i - 1; 629 sum = x[i]; 630 while (nz--) sum -= *v++ * x[*vi++]; 631 x[i] = sum*aa[adiag_i]; 632 } 633 #endif 634 PetscLogFlops(2*a->nz - A->n); 635 ierr = VecRestoreArray(bb,&b);CHKERRQ(ierr); 636 ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr); 637 PetscFunctionReturn(0); 638 } 639 640 #undef __FUNCT__ 641 #define __FUNCT__ "MatSolveAdd_SeqAIJ" 642 int MatSolveAdd_SeqAIJ(Mat A,Vec bb,Vec yy,Vec xx) 643 { 644 Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data; 645 IS iscol = a->col,isrow = a->row; 646 int *r,*c,ierr,i, n = A->m,*vi,*ai = a->i,*aj = a->j; 647 int nz,shift = a->indexshift,*rout,*cout; 648 PetscScalar *x,*b,*tmp,*aa = a->a,sum,*v; 649 650 PetscFunctionBegin; 651 if (yy != xx) {ierr = VecCopy(yy,xx);CHKERRQ(ierr);} 652 653 ierr = VecGetArray(bb,&b);CHKERRQ(ierr); 654 ierr = VecGetArray(xx,&x);CHKERRQ(ierr); 655 tmp = a->solve_work; 656 657 ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout; 658 ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout + (n-1); 659 660 /* forward solve the lower triangular */ 661 tmp[0] = b[*r++]; 662 for (i=1; i<n; i++) { 663 v = aa + ai[i] + shift; 664 vi = aj + ai[i] + shift; 665 nz = a->diag[i] - ai[i]; 666 sum = b[*r++]; 667 while (nz--) sum -= *v++ * tmp[*vi++ + shift]; 668 tmp[i] = sum; 669 } 670 671 /* backward solve the upper triangular */ 672 for (i=n-1; i>=0; i--){ 673 v = aa + a->diag[i] + (!shift); 674 vi = aj + a->diag[i] + (!shift); 675 nz = ai[i+1] - a->diag[i] - 1; 676 sum = tmp[i]; 677 while (nz--) sum -= *v++ * tmp[*vi++ + shift]; 678 tmp[i] = sum*aa[a->diag[i]+shift]; 679 x[*c--] += tmp[i]; 680 } 681 682 ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr); 683 ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr); 684 ierr = VecRestoreArray(bb,&b);CHKERRQ(ierr); 685 ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr); 686 PetscLogFlops(2*a->nz); 687 688 PetscFunctionReturn(0); 689 } 690 /* -------------------------------------------------------------------*/ 691 #undef __FUNCT__ 692 #define __FUNCT__ "MatSolveTranspose_SeqAIJ" 693 int MatSolveTranspose_SeqAIJ(Mat A,Vec bb,Vec xx) 694 { 695 Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data; 696 IS iscol = a->col,isrow = a->row; 697 int *r,*c,ierr,i,n = A->m,*vi,*ai = a->i,*aj = a->j; 698 int nz,shift = a->indexshift,*rout,*cout,*diag = a->diag; 699 PetscScalar *x,*b,*tmp,*aa = a->a,*v,s1; 700 701 PetscFunctionBegin; 702 ierr = VecGetArray(bb,&b);CHKERRQ(ierr); 703 ierr = VecGetArray(xx,&x);CHKERRQ(ierr); 704 tmp = a->solve_work; 705 706 ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout; 707 ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout; 708 709 /* copy the b into temp work space according to permutation */ 710 for (i=0; i<n; i++) tmp[i] = b[c[i]]; 711 712 /* forward solve the U^T */ 713 for (i=0; i<n; i++) { 714 v = aa + diag[i] + shift; 715 vi = aj + diag[i] + (!shift); 716 nz = ai[i+1] - diag[i] - 1; 717 s1 = tmp[i]; 718 s1 *= (*v++); /* multiply by inverse of diagonal entry */ 719 while (nz--) { 720 tmp[*vi++ + shift] -= (*v++)*s1; 721 } 722 tmp[i] = s1; 723 } 724 725 /* backward solve the L^T */ 726 for (i=n-1; i>=0; i--){ 727 v = aa + diag[i] - 1 + shift; 728 vi = aj + diag[i] - 1 + shift; 729 nz = diag[i] - ai[i]; 730 s1 = tmp[i]; 731 while (nz--) { 732 tmp[*vi-- + shift] -= (*v--)*s1; 733 } 734 } 735 736 /* copy tmp into x according to permutation */ 737 for (i=0; i<n; i++) x[r[i]] = tmp[i]; 738 739 ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr); 740 ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr); 741 ierr = VecRestoreArray(bb,&b);CHKERRQ(ierr); 742 ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr); 743 744 PetscLogFlops(2*a->nz-A->n); 745 PetscFunctionReturn(0); 746 } 747 748 #undef __FUNCT__ 749 #define __FUNCT__ "MatSolveTransposeAdd_SeqAIJ" 750 int MatSolveTransposeAdd_SeqAIJ(Mat A,Vec bb,Vec zz,Vec xx) 751 { 752 Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data; 753 IS iscol = a->col,isrow = a->row; 754 int *r,*c,ierr,i,n = A->m,*vi,*ai = a->i,*aj = a->j; 755 int nz,shift = a->indexshift,*rout,*cout,*diag = a->diag; 756 PetscScalar *x,*b,*tmp,*aa = a->a,*v; 757 758 PetscFunctionBegin; 759 if (zz != xx) VecCopy(zz,xx); 760 761 ierr = VecGetArray(bb,&b);CHKERRQ(ierr); 762 ierr = VecGetArray(xx,&x);CHKERRQ(ierr); 763 tmp = a->solve_work; 764 765 ierr = ISGetIndices(isrow,&rout);CHKERRQ(ierr); r = rout; 766 ierr = ISGetIndices(iscol,&cout);CHKERRQ(ierr); c = cout; 767 768 /* copy the b into temp work space according to permutation */ 769 for (i=0; i<n; i++) tmp[i] = b[c[i]]; 770 771 /* forward solve the U^T */ 772 for (i=0; i<n; i++) { 773 v = aa + diag[i] + shift; 774 vi = aj + diag[i] + (!shift); 775 nz = ai[i+1] - diag[i] - 1; 776 tmp[i] *= *v++; 777 while (nz--) { 778 tmp[*vi++ + shift] -= (*v++)*tmp[i]; 779 } 780 } 781 782 /* backward solve the L^T */ 783 for (i=n-1; i>=0; i--){ 784 v = aa + diag[i] - 1 + shift; 785 vi = aj + diag[i] - 1 + shift; 786 nz = diag[i] - ai[i]; 787 while (nz--) { 788 tmp[*vi-- + shift] -= (*v--)*tmp[i]; 789 } 790 } 791 792 /* copy tmp into x according to permutation */ 793 for (i=0; i<n; i++) x[r[i]] += tmp[i]; 794 795 ierr = ISRestoreIndices(isrow,&rout);CHKERRQ(ierr); 796 ierr = ISRestoreIndices(iscol,&cout);CHKERRQ(ierr); 797 ierr = VecRestoreArray(bb,&b);CHKERRQ(ierr); 798 ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr); 799 800 PetscLogFlops(2*a->nz); 801 PetscFunctionReturn(0); 802 } 803 /* ----------------------------------------------------------------*/ 804 EXTERN int MatMissingDiagonal_SeqAIJ(Mat); 805 806 #undef __FUNCT__ 807 #define __FUNCT__ "MatILUFactorSymbolic_SeqAIJ" 808 int MatILUFactorSymbolic_SeqAIJ(Mat A,IS isrow,IS iscol,MatILUInfo *info,Mat *fact) 809 { 810 Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data,*b; 811 IS isicol; 812 int *r,*ic,ierr,prow,n = A->m,*ai = a->i,*aj = a->j; 813 int *ainew,*ajnew,jmax,*fill,*xi,nz,*im,*ajfill,*flev; 814 int *dloc,idx,row,m,fm,nzf,nzi,len, realloc = 0,dcount = 0; 815 int incrlev,nnz,i,shift = a->indexshift,levels,diagonal_fill; 816 PetscTruth col_identity,row_identity; 817 PetscReal f; 818 819 PetscFunctionBegin; 820 f = info->fill; 821 levels = (int)info->levels; 822 diagonal_fill = (int)info->diagonal_fill; 823 ierr = ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);CHKERRQ(ierr); 824 825 /* special case that simply copies fill pattern */ 826 ierr = ISIdentity(isrow,&row_identity);CHKERRQ(ierr); 827 ierr = ISIdentity(iscol,&col_identity);CHKERRQ(ierr); 828 if (!levels && row_identity && col_identity) { 829 ierr = MatDuplicate_SeqAIJ(A,MAT_DO_NOT_COPY_VALUES,fact);CHKERRQ(ierr); 830 (*fact)->factor = FACTOR_LU; 831 b = (Mat_SeqAIJ*)(*fact)->data; 832 if (!b->diag) { 833 ierr = MatMarkDiagonal_SeqAIJ(*fact);CHKERRQ(ierr); 834 } 835 ierr = MatMissingDiagonal_SeqAIJ(*fact);CHKERRQ(ierr); 836 b->row = isrow; 837 b->col = iscol; 838 b->icol = isicol; 839 b->lu_damping = info->damping; 840 b->lu_zeropivot = info->zeropivot; 841 ierr = PetscMalloc(((*fact)->m+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr); 842 (*fact)->ops->solve = MatSolve_SeqAIJ_NaturalOrdering; 843 ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr); 844 ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr); 845 PetscFunctionReturn(0); 846 } 847 848 ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr); 849 ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr); 850 851 /* get new row pointers */ 852 ierr = PetscMalloc((n+1)*sizeof(int),&ainew);CHKERRQ(ierr); 853 ainew[0] = -shift; 854 /* don't know how many column pointers are needed so estimate */ 855 jmax = (int)(f*(ai[n]+!shift)); 856 ierr = PetscMalloc((jmax)*sizeof(int),&ajnew);CHKERRQ(ierr); 857 /* ajfill is level of fill for each fill entry */ 858 ierr = PetscMalloc((jmax)*sizeof(int),&ajfill);CHKERRQ(ierr); 859 /* fill is a linked list of nonzeros in active row */ 860 ierr = PetscMalloc((n+1)*sizeof(int),&fill);CHKERRQ(ierr); 861 /* im is level for each filled value */ 862 ierr = PetscMalloc((n+1)*sizeof(int),&im);CHKERRQ(ierr); 863 /* dloc is location of diagonal in factor */ 864 ierr = PetscMalloc((n+1)*sizeof(int),&dloc);CHKERRQ(ierr); 865 dloc[0] = 0; 866 for (prow=0; prow<n; prow++) { 867 868 /* copy current row into linked list */ 869 nzf = nz = ai[r[prow]+1] - ai[r[prow]]; 870 if (!nz) SETERRQ(PETSC_ERR_MAT_LU_ZRPVT,"Empty row in matrix"); 871 xi = aj + ai[r[prow]] + shift; 872 fill[n] = n; 873 fill[prow] = -1; /* marker to indicate if diagonal exists */ 874 while (nz--) { 875 fm = n; 876 idx = ic[*xi++ + shift]; 877 do { 878 m = fm; 879 fm = fill[m]; 880 } while (fm < idx); 881 fill[m] = idx; 882 fill[idx] = fm; 883 im[idx] = 0; 884 } 885 886 /* make sure diagonal entry is included */ 887 if (diagonal_fill && fill[prow] == -1) { 888 fm = n; 889 while (fill[fm] < prow) fm = fill[fm]; 890 fill[prow] = fill[fm]; /* insert diagonal into linked list */ 891 fill[fm] = prow; 892 im[prow] = 0; 893 nzf++; 894 dcount++; 895 } 896 897 nzi = 0; 898 row = fill[n]; 899 while (row < prow) { 900 incrlev = im[row] + 1; 901 nz = dloc[row]; 902 xi = ajnew + ainew[row] + shift + nz + 1; 903 flev = ajfill + ainew[row] + shift + nz + 1; 904 nnz = ainew[row+1] - ainew[row] - nz - 1; 905 fm = row; 906 while (nnz-- > 0) { 907 idx = *xi++ + shift; 908 if (*flev + incrlev > levels) { 909 flev++; 910 continue; 911 } 912 do { 913 m = fm; 914 fm = fill[m]; 915 } while (fm < idx); 916 if (fm != idx) { 917 im[idx] = *flev + incrlev; 918 fill[m] = idx; 919 fill[idx] = fm; 920 fm = idx; 921 nzf++; 922 } else { 923 if (im[idx] > *flev + incrlev) im[idx] = *flev+incrlev; 924 } 925 flev++; 926 } 927 row = fill[row]; 928 nzi++; 929 } 930 /* copy new filled row into permanent storage */ 931 ainew[prow+1] = ainew[prow] + nzf; 932 if (ainew[prow+1] > jmax-shift) { 933 934 /* estimate how much additional space we will need */ 935 /* use the strategy suggested by David Hysom <hysom@perch-t.icase.edu> */ 936 /* just double the memory each time */ 937 /* maxadd = (int)((f*(ai[n]+!shift)*(n-prow+5))/n); */ 938 int maxadd = jmax; 939 if (maxadd < nzf) maxadd = (n-prow)*(nzf+1); 940 jmax += maxadd; 941 942 /* allocate a longer ajnew and ajfill */ 943 ierr = PetscMalloc(jmax*sizeof(int),&xi);CHKERRQ(ierr); 944 ierr = PetscMemcpy(xi,ajnew,(ainew[prow]+shift)*sizeof(int));CHKERRQ(ierr); 945 ierr = PetscFree(ajnew);CHKERRQ(ierr); 946 ajnew = xi; 947 ierr = PetscMalloc(jmax*sizeof(int),&xi);CHKERRQ(ierr); 948 ierr = PetscMemcpy(xi,ajfill,(ainew[prow]+shift)*sizeof(int));CHKERRQ(ierr); 949 ierr = PetscFree(ajfill);CHKERRQ(ierr); 950 ajfill = xi; 951 realloc++; /* count how many times we realloc */ 952 } 953 xi = ajnew + ainew[prow] + shift; 954 flev = ajfill + ainew[prow] + shift; 955 dloc[prow] = nzi; 956 fm = fill[n]; 957 while (nzf--) { 958 *xi++ = fm - shift; 959 *flev++ = im[fm]; 960 fm = fill[fm]; 961 } 962 /* make sure row has diagonal entry */ 963 if (ajnew[ainew[prow]+shift+dloc[prow]]+shift != prow) { 964 SETERRQ1(PETSC_ERR_MAT_LU_ZRPVT,"Row %d has missing diagonal in factored matrix\n\ 965 try running with -pc_ilu_nonzeros_along_diagonal or -pc_ilu_diagonal_fill",prow); 966 } 967 } 968 ierr = PetscFree(ajfill);CHKERRQ(ierr); 969 ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr); 970 ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr); 971 ierr = PetscFree(fill);CHKERRQ(ierr); 972 ierr = PetscFree(im);CHKERRQ(ierr); 973 974 { 975 PetscReal af = ((PetscReal)ainew[n])/((PetscReal)ai[n]); 976 PetscLogInfo(A,"MatILUFactorSymbolic_SeqAIJ:Reallocs %d Fill ratio:given %g needed %g\n",realloc,f,af); 977 PetscLogInfo(A,"MatILUFactorSymbolic_SeqAIJ:Run with -[sub_]pc_ilu_fill %g or use \n",af); 978 PetscLogInfo(A,"MatILUFactorSymbolic_SeqAIJ:PCILUSetFill([sub]pc,%g);\n",af); 979 PetscLogInfo(A,"MatILUFactorSymbolic_SeqAIJ:for best performance.\n"); 980 if (diagonal_fill) { 981 PetscLogInfo(A,"MatILUFactorSymbolic_SeqAIJ:Detected and replaced %d missing diagonals",dcount); 982 } 983 } 984 985 /* put together the new matrix */ 986 ierr = MatCreateSeqAIJ(A->comm,n,n,0,PETSC_NULL,fact);CHKERRQ(ierr); 987 PetscLogObjectParent(*fact,isicol); 988 b = (Mat_SeqAIJ*)(*fact)->data; 989 ierr = PetscFree(b->imax);CHKERRQ(ierr); 990 b->singlemalloc = PETSC_FALSE; 991 len = (ainew[n] + shift)*sizeof(PetscScalar); 992 /* the next line frees the default space generated by the Create() */ 993 ierr = PetscFree(b->a);CHKERRQ(ierr); 994 ierr = PetscFree(b->ilen);CHKERRQ(ierr); 995 ierr = PetscMalloc(len+1,&b->a);CHKERRQ(ierr); 996 b->j = ajnew; 997 b->i = ainew; 998 for (i=0; i<n; i++) dloc[i] += ainew[i]; 999 b->diag = dloc; 1000 b->ilen = 0; 1001 b->imax = 0; 1002 b->row = isrow; 1003 b->col = iscol; 1004 ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr); 1005 ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr); 1006 b->icol = isicol; 1007 ierr = PetscMalloc((n+1)*sizeof(PetscScalar),&b->solve_work);CHKERRQ(ierr); 1008 /* In b structure: Free imax, ilen, old a, old j. 1009 Allocate dloc, solve_work, new a, new j */ 1010 PetscLogObjectMemory(*fact,(ainew[n]+shift-n) * (sizeof(int)+sizeof(PetscScalar))); 1011 b->maxnz = b->nz = ainew[n] + shift; 1012 b->lu_damping = info->damping; 1013 b->lu_zeropivot = info->zeropivot; 1014 (*fact)->factor = FACTOR_LU; 1015 ierr = Mat_AIJ_CheckInode(*fact,PETSC_FALSE);CHKERRQ(ierr); 1016 (*fact)->ops->lufactornumeric = A->ops->lufactornumeric; /* Use Inode variant ONLY if A has inodes */ 1017 1018 (*fact)->info.factor_mallocs = realloc; 1019 (*fact)->info.fill_ratio_given = f; 1020 (*fact)->info.fill_ratio_needed = ((PetscReal)ainew[n])/((PetscReal)ai[prow]); 1021 (*fact)->factor = FACTOR_LU; 1022 PetscFunctionReturn(0); 1023 } 1024 1025 1026 1027 1028