1 #ifndef lint 2 static char vcid[] = "$Id: aijfact.c,v 1.64 1996/08/06 23:01:07 curfman Exp bsmith $"; 3 #endif 4 5 #include "src/mat/impls/aij/seq/aij.h" 6 /* 7 Factorization code for AIJ format. 8 */ 9 10 int MatLUFactorSymbolic_SeqAIJ(Mat A,IS isrow,IS iscol,double f,Mat *B) 11 { 12 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data, *b; 13 IS isicol; 14 int *r,*ic, ierr, i, n = a->m, *ai = a->i, *aj = a->j; 15 int *ainew,*ajnew, jmax,*fill, *ajtmp, nz,shift = a->indexshift; 16 int *idnew, idx, row,m,fm, nnz, nzi,len, realloc = 0,nzbd,*im; 17 18 PetscValidHeaderSpecific(isrow,IS_COOKIE); 19 PetscValidHeaderSpecific(iscol,IS_COOKIE); 20 ierr = ISInvertPermutation(iscol,&isicol); CHKERRQ(ierr); 21 ISGetIndices(isrow,&r); ISGetIndices(isicol,&ic); 22 23 /* get new row pointers */ 24 ainew = (int *) PetscMalloc( (n+1)*sizeof(int) ); CHKPTRQ(ainew); 25 ainew[0] = -shift; 26 /* don't know how many column pointers are needed so estimate */ 27 jmax = (int) (f*ai[n]+(!shift)); 28 ajnew = (int *) PetscMalloc( (jmax)*sizeof(int) ); CHKPTRQ(ajnew); 29 /* fill is a linked list of nonzeros in active row */ 30 fill = (int *) PetscMalloc( (2*n+1)*sizeof(int)); CHKPTRQ(fill); 31 im = fill + n + 1; 32 /* idnew is location of diagonal in factor */ 33 idnew = (int *) PetscMalloc( (n+1)*sizeof(int)); CHKPTRQ(idnew); 34 idnew[0] = -shift; 35 36 for ( i=0; i<n; i++ ) { 37 /* first copy previous fill into linked list */ 38 nnz = nz = ai[r[i]+1] - ai[r[i]]; 39 ajtmp = aj + ai[r[i]] + shift; 40 fill[n] = n; 41 while (nz--) { 42 fm = n; 43 idx = ic[*ajtmp++ + shift]; 44 do { 45 m = fm; 46 fm = fill[m]; 47 } while (fm < idx); 48 fill[m] = idx; 49 fill[idx] = fm; 50 } 51 row = fill[n]; 52 while ( row < i ) { 53 ajtmp = ajnew + idnew[row] + (!shift); 54 nzbd = 1 + idnew[row] - ainew[row]; 55 nz = im[row] - nzbd; 56 fm = row; 57 while (nz-- > 0) { 58 idx = *ajtmp++ + shift; 59 nzbd++; 60 if (idx == i) im[row] = nzbd; 61 do { 62 m = fm; 63 fm = fill[m]; 64 } while (fm < idx); 65 if (fm != idx) { 66 fill[m] = idx; 67 fill[idx] = fm; 68 fm = idx; 69 nnz++; 70 } 71 } 72 row = fill[row]; 73 } 74 /* copy new filled row into permanent storage */ 75 ainew[i+1] = ainew[i] + nnz; 76 if (ainew[i+1] > jmax) { 77 /* allocate a longer ajnew */ 78 int maxadd; 79 maxadd = (int) ((f*(ai[n]+(!shift))*(n-i+5))/n); 80 if (maxadd < nnz) maxadd = (n-i)*(nnz+1); 81 jmax += maxadd; 82 ajtmp = (int *) PetscMalloc( jmax*sizeof(int) );CHKPTRQ(ajtmp); 83 PetscMemcpy(ajtmp,ajnew,(ainew[i]+shift)*sizeof(int)); 84 PetscFree(ajnew); 85 ajnew = ajtmp; 86 realloc++; /* count how many times we realloc */ 87 } 88 ajtmp = ajnew + ainew[i] + shift; 89 fm = fill[n]; 90 nzi = 0; 91 im[i] = nnz; 92 while (nnz--) { 93 if (fm < i) nzi++; 94 *ajtmp++ = fm - shift; 95 fm = fill[fm]; 96 } 97 idnew[i] = ainew[i] + nzi; 98 } 99 100 PLogInfo(A, 101 "Info:MatLUFactorSymbolic_SeqAIJ:Reallocs %d Fill ratio:given %g needed %g\n", 102 realloc,f,((double)ainew[n])/((double)ai[i])); 103 104 ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr); 105 ierr = ISRestoreIndices(isicol,&ic); CHKERRQ(ierr); 106 107 PetscFree(fill); 108 109 /* put together the new matrix */ 110 ierr = MatCreateSeqAIJ(A->comm,n,n,0,PETSC_NULL,B); CHKERRQ(ierr); 111 PLogObjectParent(*B,isicol); 112 ierr = ISDestroy(isicol); CHKERRQ(ierr); 113 b = (Mat_SeqAIJ *) (*B)->data; 114 PetscFree(b->imax); 115 b->singlemalloc = 0; 116 len = (ainew[n] + shift)*sizeof(Scalar); 117 /* the next line frees the default space generated by the Create() */ 118 PetscFree(b->a); PetscFree(b->ilen); 119 b->a = (Scalar *) PetscMalloc( len ); CHKPTRQ(b->a); 120 b->j = ajnew; 121 b->i = ainew; 122 b->diag = idnew; 123 b->ilen = 0; 124 b->imax = 0; 125 b->row = isrow; 126 b->col = iscol; 127 b->solve_work = (Scalar *) PetscMalloc( n*sizeof(Scalar)); 128 CHKPTRQ(b->solve_work); 129 /* In b structure: Free imax, ilen, old a, old j. 130 Allocate idnew, solve_work, new a, new j */ 131 PLogObjectMemory(*B,(ainew[n]+shift-n)*(sizeof(int)+sizeof(Scalar))); 132 b->maxnz = b->nz = ainew[n] + shift; 133 134 return 0; 135 } 136 /* ----------------------------------------------------------- */ 137 int Mat_AIJ_CheckInode(Mat); 138 139 int MatLUFactorNumeric_SeqAIJ(Mat A,Mat *B) 140 { 141 Mat C = *B; 142 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data, *b = (Mat_SeqAIJ *)C->data; 143 IS iscol = b->col, isrow = b->row, isicol; 144 int *r,*ic, ierr, i, j, n = a->m, *ai = b->i, *aj = b->j; 145 int *ajtmpold, *ajtmp, nz, row, *ics, shift = a->indexshift; 146 int *diag_offset = b->diag,diag,k; 147 int preserve_row_sums = (int) a->ilu_preserve_row_sums; 148 Scalar *rtmp,*v, *pc, multiplier,sum,inner_sum,*rowsums = 0; 149 double ssum; 150 /* These declarations are for optimizations. They reduce the number of 151 memory references that are made by locally storing information; the 152 word "register" used here with pointers can be viewed as "private" or 153 "known only to me" 154 */ 155 register Scalar *pv, *rtmps,*u_values; 156 register int *pj; 157 158 ierr = ISInvertPermutation(iscol,&isicol); CHKERRQ(ierr); 159 PLogObjectParent(*B,isicol); 160 ierr = ISGetIndices(isrow,&r); CHKERRQ(ierr); 161 ierr = ISGetIndices(isicol,&ic); CHKERRQ(ierr); 162 rtmp = (Scalar *) PetscMalloc( (n+1)*sizeof(Scalar) ); CHKPTRQ(rtmp); 163 PetscMemzero(rtmp,(n+1)*sizeof(Scalar)); 164 rtmps = rtmp + shift; ics = ic + shift; 165 166 /* precalcuate row sums */ 167 if (preserve_row_sums) { 168 rowsums = (Scalar *) PetscMalloc( n*sizeof(Scalar) ); CHKPTRQ(rowsums); 169 for ( i=0; i<n; i++ ) { 170 nz = a->i[r[i]+1] - a->i[r[i]]; 171 v = a->a + a->i[r[i]] + shift; 172 sum = 0.0; 173 for ( j=0; j<nz; j++ ) sum += v[j]; 174 rowsums[i] = sum; 175 } 176 } 177 178 for ( i=0; i<n; i++ ) { 179 nz = ai[i+1] - ai[i]; 180 ajtmp = aj + ai[i] + shift; 181 for ( j=0; j<nz; j++ ) rtmps[ajtmp[j]] = 0.0; 182 183 /* load in initial (unfactored row) */ 184 nz = a->i[r[i]+1] - a->i[r[i]]; 185 ajtmpold = a->j + a->i[r[i]] + shift; 186 v = a->a + a->i[r[i]] + shift; 187 for ( j=0; j<nz; j++ ) rtmp[ics[ajtmpold[j]]] = v[j]; 188 189 row = *ajtmp++ + shift; 190 while (row < i) { 191 pc = rtmp + row; 192 if (*pc != 0.0) { 193 pv = b->a + diag_offset[row] + shift; 194 pj = b->j + diag_offset[row] + (!shift); 195 multiplier = *pc / *pv++; 196 *pc = multiplier; 197 nz = ai[row+1] - diag_offset[row] - 1; 198 for (j=0; j<nz; j++) rtmps[pj[j]] -= multiplier * pv[j]; 199 PLogFlops(2*nz); 200 } 201 row = *ajtmp++ + shift; 202 } 203 /* finished row so stick it into b->a */ 204 pv = b->a + ai[i] + shift; 205 pj = b->j + ai[i] + shift; 206 nz = ai[i+1] - ai[i]; 207 for ( j=0; j<nz; j++ ) {pv[j] = rtmps[pj[j]];} 208 diag = diag_offset[i] - ai[i]; 209 /* 210 Possibly adjust diagonal entry on current row to force 211 LU matrix to have same row sum as initial matrix. 212 */ 213 if (preserve_row_sums) { 214 pj = b->j + ai[i] + shift; 215 sum = rowsums[i]; 216 for ( j=0; j<diag; j++ ) { 217 u_values = b->a + diag_offset[pj[j]] + shift; 218 nz = ai[pj[j]+1] - diag_offset[pj[j]]; 219 inner_sum = 0.0; 220 for ( k=0; k<nz; k++ ) { 221 inner_sum += u_values[k]; 222 } 223 sum -= pv[j]*inner_sum; 224 225 } 226 nz = ai[i+1] - diag_offset[i] - 1; 227 u_values = b->a + diag_offset[i] + 1 + shift; 228 for ( k=0; k<nz; k++ ) { 229 sum -= u_values[k]; 230 } 231 ssum = PetscAbsScalar(sum/pv[diag]); 232 if (ssum < 1000. && ssum > .001) pv[diag] = sum; 233 } 234 /* check pivot entry for current row */ 235 if (pv[diag] == 0.0) { 236 SETERRQ(1,"MatLUFactorNumeric_SeqAIJ:Zero pivot"); 237 } 238 } 239 240 /* invert diagonal entries for simplier triangular solves */ 241 for ( i=0; i<n; i++ ) { 242 b->a[diag_offset[i]+shift] = 1.0/b->a[diag_offset[i]+shift]; 243 } 244 245 if (preserve_row_sums) PetscFree(rowsums); 246 PetscFree(rtmp); 247 ierr = ISRestoreIndices(isicol,&ic); CHKERRQ(ierr); 248 ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr); 249 ierr = ISDestroy(isicol); CHKERRQ(ierr); 250 C->factor = FACTOR_LU; 251 ierr = Mat_AIJ_CheckInode(C); CHKERRQ(ierr); 252 C->assembled = PETSC_TRUE; 253 PLogFlops(b->n); 254 return 0; 255 } 256 /* ----------------------------------------------------------- */ 257 int MatLUFactor_SeqAIJ(Mat A,IS row,IS col,double f) 258 { 259 Mat_SeqAIJ *mat = (Mat_SeqAIJ *) A->data; 260 int ierr; 261 Mat C; 262 263 PetscValidHeaderSpecific(row,IS_COOKIE); 264 PetscValidHeaderSpecific(col,IS_COOKIE); 265 ierr = MatLUFactorSymbolic_SeqAIJ(A,row,col,f,&C); CHKERRQ(ierr); 266 ierr = MatLUFactorNumeric_SeqAIJ(A,&C); CHKERRQ(ierr); 267 268 /* free all the data structures from mat */ 269 PetscFree(mat->a); 270 if (!mat->singlemalloc) {PetscFree(mat->i); PetscFree(mat->j);} 271 if (mat->diag) PetscFree(mat->diag); 272 if (mat->ilen) PetscFree(mat->ilen); 273 if (mat->imax) PetscFree(mat->imax); 274 if (mat->solve_work) PetscFree(mat->solve_work); 275 if (mat->inode.size) PetscFree(mat->inode.size); 276 PetscFree(mat); 277 278 PetscMemcpy(A,C,sizeof(struct _Mat)); 279 PetscHeaderDestroy(C); 280 return 0; 281 } 282 /* ----------------------------------------------------------- */ 283 int MatSolve_SeqAIJ(Mat A,Vec bb, Vec xx) 284 { 285 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 286 IS iscol = a->col, isrow = a->row; 287 int *r,*c, ierr, i, n = a->m, *vi, *ai = a->i, *aj = a->j; 288 int nz,shift = a->indexshift; 289 Scalar *x,*b,*tmp, *tmps, *aa = a->a, sum, *v; 290 291 if (A->factor != FACTOR_LU) SETERRQ(1,"MatSolve_SeqAIJ:Not for unfactored matrix"); 292 293 ierr = VecGetArray(bb,&b); CHKERRQ(ierr); 294 ierr = VecGetArray(xx,&x); CHKERRQ(ierr); 295 tmp = a->solve_work; 296 297 ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr); 298 ierr = ISGetIndices(iscol,&c);CHKERRQ(ierr); c = c + (n-1); 299 300 /* forward solve the lower triangular */ 301 tmp[0] = b[*r++]; 302 tmps = tmp + shift; 303 for ( i=1; i<n; i++ ) { 304 v = aa + ai[i] + shift; 305 vi = aj + ai[i] + shift; 306 nz = a->diag[i] - ai[i]; 307 sum = b[*r++]; 308 while (nz--) sum -= *v++ * tmps[*vi++]; 309 tmp[i] = sum; 310 } 311 312 /* backward solve the upper triangular */ 313 for ( i=n-1; i>=0; i-- ){ 314 v = aa + a->diag[i] + (!shift); 315 vi = aj + a->diag[i] + (!shift); 316 nz = ai[i+1] - a->diag[i] - 1; 317 sum = tmp[i]; 318 while (nz--) sum -= *v++ * tmps[*vi++]; 319 x[*c--] = tmp[i] = sum*aa[a->diag[i]+shift]; 320 } 321 322 ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr); 323 ierr = ISRestoreIndices(iscol,&c); CHKERRQ(ierr); 324 PLogFlops(2*a->nz - a->n); 325 return 0; 326 } 327 int MatSolveAdd_SeqAIJ(Mat A,Vec bb, Vec yy, Vec xx) 328 { 329 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 330 IS iscol = a->col, isrow = a->row; 331 int *r,*c, ierr, i, n = a->m, *vi, *ai = a->i, *aj = a->j; 332 int nz, shift = a->indexshift; 333 Scalar *x,*b,*tmp, *aa = a->a, sum, *v; 334 335 if (A->factor != FACTOR_LU) SETERRQ(1,"MatSolveAdd_SeqAIJ:Not for unfactored matrix"); 336 if (yy != xx) {ierr = VecCopy(yy,xx); CHKERRQ(ierr);} 337 338 ierr = VecGetArray(bb,&b); CHKERRQ(ierr); 339 ierr = VecGetArray(xx,&x); CHKERRQ(ierr); 340 tmp = a->solve_work; 341 342 ierr = ISGetIndices(isrow,&r); CHKERRQ(ierr); 343 ierr = ISGetIndices(iscol,&c); CHKERRQ(ierr); c = c + (n-1); 344 345 /* forward solve the lower triangular */ 346 tmp[0] = b[*r++]; 347 for ( i=1; i<n; i++ ) { 348 v = aa + ai[i] + shift; 349 vi = aj + ai[i] + shift; 350 nz = a->diag[i] - ai[i]; 351 sum = b[*r++]; 352 while (nz--) sum -= *v++ * tmp[*vi++ + shift]; 353 tmp[i] = sum; 354 } 355 356 /* backward solve the upper triangular */ 357 for ( i=n-1; i>=0; i-- ){ 358 v = aa + a->diag[i] + (!shift); 359 vi = aj + a->diag[i] + (!shift); 360 nz = ai[i+1] - a->diag[i] - 1; 361 sum = tmp[i]; 362 while (nz--) sum -= *v++ * tmp[*vi++ + shift]; 363 tmp[i] = sum*aa[a->diag[i]+shift]; 364 x[*c--] += tmp[i]; 365 } 366 367 ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr); 368 ierr = ISRestoreIndices(iscol,&c); CHKERRQ(ierr); 369 PLogFlops(2*a->nz); 370 371 return 0; 372 } 373 /* -------------------------------------------------------------------*/ 374 int MatSolveTrans_SeqAIJ(Mat A,Vec bb, Vec xx) 375 { 376 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 377 IS iscol = a->col, isrow = a->row, invisrow,inviscol; 378 int *r,*c, ierr, i, n = a->m, *vi, *ai = a->i, *aj = a->j; 379 int nz,shift = a->indexshift; 380 Scalar *x,*b,*tmp, *aa = a->a, *v; 381 382 if (A->factor != FACTOR_LU) SETERRQ(1,"MatSolveTrans_SeqAIJ:Not unfactored matrix"); 383 ierr = VecGetArray(bb,&b); CHKERRQ(ierr); 384 ierr = VecGetArray(xx,&x); CHKERRQ(ierr); 385 tmp = a->solve_work; 386 387 /* invert the permutations */ 388 ierr = ISInvertPermutation(isrow,&invisrow); CHKERRQ(ierr); 389 ierr = ISInvertPermutation(iscol,&inviscol); CHKERRQ(ierr); 390 391 ierr = ISGetIndices(invisrow,&r); CHKERRQ(ierr); 392 ierr = ISGetIndices(inviscol,&c); CHKERRQ(ierr); 393 394 /* copy the b into temp work space according to permutation */ 395 for ( i=0; i<n; i++ ) tmp[c[i]] = b[i]; 396 397 /* forward solve the U^T */ 398 for ( i=0; i<n; i++ ) { 399 v = aa + a->diag[i] + shift; 400 vi = aj + a->diag[i] + (!shift); 401 nz = ai[i+1] - a->diag[i] - 1; 402 tmp[i] *= *v++; 403 while (nz--) { 404 tmp[*vi++ + shift] -= (*v++)*tmp[i]; 405 } 406 } 407 408 /* backward solve the L^T */ 409 for ( i=n-1; i>=0; i-- ){ 410 v = aa + a->diag[i] - 1 + shift; 411 vi = aj + a->diag[i] - 1 + shift; 412 nz = a->diag[i] - ai[i]; 413 while (nz--) { 414 tmp[*vi-- + shift] -= (*v--)*tmp[i]; 415 } 416 } 417 418 /* copy tmp into x according to permutation */ 419 for ( i=0; i<n; i++ ) x[r[i]] = tmp[i]; 420 421 ierr = ISRestoreIndices(invisrow,&r); CHKERRQ(ierr); 422 ierr = ISRestoreIndices(inviscol,&c); CHKERRQ(ierr); 423 ierr = ISDestroy(invisrow); CHKERRQ(ierr); 424 ierr = ISDestroy(inviscol); CHKERRQ(ierr); 425 426 PLogFlops(2*a->nz-a->n); 427 return 0; 428 } 429 430 int MatSolveTransAdd_SeqAIJ(Mat A,Vec bb, Vec zz,Vec xx) 431 { 432 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 433 IS iscol = a->col, isrow = a->row, invisrow,inviscol; 434 int *r,*c, ierr, i, n = a->m, *vi, *ai = a->i, *aj = a->j; 435 int nz,shift = a->indexshift; 436 Scalar *x,*b,*tmp, *aa = a->a, *v; 437 438 if (A->factor != FACTOR_LU)SETERRQ(1,"MatSolveTransAdd_SeqAIJ:Not unfactored matrix"); 439 if (zz != xx) VecCopy(zz,xx); 440 441 ierr = VecGetArray(bb,&b); CHKERRQ(ierr); 442 ierr = VecGetArray(xx,&x); CHKERRQ(ierr); 443 tmp = a->solve_work; 444 445 /* invert the permutations */ 446 ierr = ISInvertPermutation(isrow,&invisrow); CHKERRQ(ierr); 447 ierr = ISInvertPermutation(iscol,&inviscol); CHKERRQ(ierr); 448 ierr = ISGetIndices(invisrow,&r); CHKERRQ(ierr); 449 ierr = ISGetIndices(inviscol,&c); CHKERRQ(ierr); 450 451 /* copy the b into temp work space according to permutation */ 452 for ( i=0; i<n; i++ ) tmp[c[i]] = b[i]; 453 454 /* forward solve the U^T */ 455 for ( i=0; i<n; i++ ) { 456 v = aa + a->diag[i] + shift; 457 vi = aj + a->diag[i] + (!shift); 458 nz = ai[i+1] - a->diag[i] - 1; 459 tmp[i] *= *v++; 460 while (nz--) { 461 tmp[*vi++ + shift] -= (*v++)*tmp[i]; 462 } 463 } 464 465 /* backward solve the L^T */ 466 for ( i=n-1; i>=0; i-- ){ 467 v = aa + a->diag[i] - 1 + shift; 468 vi = aj + a->diag[i] - 1 + shift; 469 nz = a->diag[i] - ai[i]; 470 while (nz--) { 471 tmp[*vi-- + shift] -= (*v--)*tmp[i]; 472 } 473 } 474 475 /* copy tmp into x according to permutation */ 476 for ( i=0; i<n; i++ ) x[r[i]] += tmp[i]; 477 478 ierr = ISRestoreIndices(invisrow,&r); CHKERRQ(ierr); 479 ierr = ISRestoreIndices(inviscol,&c); CHKERRQ(ierr); 480 ierr = ISDestroy(invisrow); CHKERRQ(ierr); 481 ierr = ISDestroy(inviscol); CHKERRQ(ierr); 482 483 PLogFlops(2*a->nz); 484 return 0; 485 } 486 /* ----------------------------------------------------------------*/ 487 488 int MatILUFactorSymbolic_SeqAIJ(Mat A,IS isrow,IS iscol,double f,int levels,Mat *fact) 489 { 490 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data, *b; 491 IS isicol; 492 int *r,*ic, ierr, prow, n = a->m, *ai = a->i, *aj = a->j; 493 int *ainew,*ajnew, jmax,*fill, *xi, nz, *im,*ajfill,*flev; 494 int *dloc, idx, row,m,fm, nzf, nzi,len, realloc = 0; 495 int incrlev,nnz,i,shift = a->indexshift; 496 PetscTruth col_identity, row_identity; 497 498 /* special case that simply copies fill pattern */ 499 ISIdentity(isrow,&row_identity); ISIdentity(iscol,&col_identity); 500 if (levels == 0 && row_identity && col_identity) { 501 ierr = MatConvertSameType_SeqAIJ(A,fact,DO_NOT_COPY_VALUES); CHKERRQ(ierr); 502 (*fact)->factor = FACTOR_LU; 503 b = (Mat_SeqAIJ *) (*fact)->data; 504 if (!b->diag) { 505 ierr = MatMarkDiag_SeqAIJ(*fact); CHKERRQ(ierr); 506 } 507 b->row = isrow; 508 b->col = iscol; 509 b->solve_work = (Scalar *) PetscMalloc((b->m+1)*sizeof(Scalar));CHKPTRQ(b->solve_work); 510 return 0; 511 } 512 513 ierr = ISInvertPermutation(iscol,&isicol); CHKERRQ(ierr); 514 ierr = ISGetIndices(isrow,&r); CHKERRQ(ierr); 515 ierr = ISGetIndices(isicol,&ic); CHKERRQ(ierr); 516 517 /* get new row pointers */ 518 ainew = (int *) PetscMalloc( (n+1)*sizeof(int) ); CHKPTRQ(ainew); 519 ainew[0] = -shift; 520 /* don't know how many column pointers are needed so estimate */ 521 jmax = (int) (f*(ai[n]+!shift)); 522 ajnew = (int *) PetscMalloc( (jmax)*sizeof(int) ); CHKPTRQ(ajnew); 523 /* ajfill is level of fill for each fill entry */ 524 ajfill = (int *) PetscMalloc( (jmax)*sizeof(int) ); CHKPTRQ(ajfill); 525 /* fill is a linked list of nonzeros in active row */ 526 fill = (int *) PetscMalloc( (n+1)*sizeof(int)); CHKPTRQ(fill); 527 /* im is level for each filled value */ 528 im = (int *) PetscMalloc( (n+1)*sizeof(int)); CHKPTRQ(im); 529 /* dloc is location of diagonal in factor */ 530 dloc = (int *) PetscMalloc( (n+1)*sizeof(int)); CHKPTRQ(dloc); 531 dloc[0] = 0; 532 for ( prow=0; prow<n; prow++ ) { 533 /* first copy previous fill into linked list */ 534 nzf = nz = ai[r[prow]+1] - ai[r[prow]]; 535 xi = aj + ai[r[prow]] + shift; 536 fill[n] = n; 537 while (nz--) { 538 fm = n; 539 idx = ic[*xi++ + shift]; 540 do { 541 m = fm; 542 fm = fill[m]; 543 } while (fm < idx); 544 fill[m] = idx; 545 fill[idx] = fm; 546 im[idx] = 0; 547 } 548 nzi = 0; 549 row = fill[n]; 550 while ( row < prow ) { 551 incrlev = im[row] + 1; 552 nz = dloc[row]; 553 xi = ajnew + ainew[row] + shift + nz; 554 flev = ajfill + ainew[row] + shift + nz + 1; 555 nnz = ainew[row+1] - ainew[row] - nz - 1; 556 if (*xi++ + shift != row) { 557 SETERRQ(1,"MatILUFactorSymbolic_SeqAIJ:zero pivot"); 558 } 559 fm = row; 560 while (nnz-- > 0) { 561 idx = *xi++ + shift; 562 if (*flev + incrlev > levels) { 563 flev++; 564 continue; 565 } 566 do { 567 m = fm; 568 fm = fill[m]; 569 } while (fm < idx); 570 if (fm != idx) { 571 im[idx] = *flev + incrlev; 572 fill[m] = idx; 573 fill[idx] = fm; 574 fm = idx; 575 nzf++; 576 } 577 else { 578 if (im[idx] > *flev + incrlev) im[idx] = *flev+incrlev; 579 } 580 flev++; 581 } 582 row = fill[row]; 583 nzi++; 584 } 585 /* copy new filled row into permanent storage */ 586 ainew[prow+1] = ainew[prow] + nzf; 587 if (ainew[prow+1] > jmax-shift) { 588 /* allocate a longer ajnew */ 589 int maxadd; 590 maxadd = (int) ((f*(ai[n]+!shift)*(n-prow+5))/n); 591 if (maxadd < nzf) maxadd = (n-prow)*(nzf+1); 592 jmax += maxadd; 593 xi = (int *) PetscMalloc( jmax*sizeof(int) );CHKPTRQ(xi); 594 PetscMemcpy(xi,ajnew,(ainew[prow]+shift)*sizeof(int)); 595 PetscFree(ajnew); 596 ajnew = xi; 597 /* allocate a longer ajfill */ 598 xi = (int *) PetscMalloc( jmax*sizeof(int) );CHKPTRQ(xi); 599 PetscMemcpy(xi,ajfill,(ainew[prow]+shift)*sizeof(int)); 600 PetscFree(ajfill); 601 ajfill = xi; 602 realloc++; 603 } 604 xi = ajnew + ainew[prow] + shift; 605 flev = ajfill + ainew[prow] + shift; 606 dloc[prow] = nzi; 607 fm = fill[n]; 608 while (nzf--) { 609 *xi++ = fm - shift; 610 *flev++ = im[fm]; 611 fm = fill[fm]; 612 } 613 } 614 PetscFree(ajfill); 615 ierr = ISRestoreIndices(isrow,&r); CHKERRQ(ierr); 616 ierr = ISRestoreIndices(isicol,&ic); CHKERRQ(ierr); 617 ierr = ISDestroy(isicol); CHKERRQ(ierr); 618 PetscFree(fill); PetscFree(im); 619 620 PLogInfo(A, 621 "Info:MatILUFactorSymbolic_SeqAIJ:Realloc %d Fill ratio:given %g needed %g\n", 622 realloc,f,((double)ainew[n])/((double)ai[prow])); 623 624 /* put together the new matrix */ 625 ierr = MatCreateSeqAIJ(A->comm,n,n,0,PETSC_NULL,fact); CHKERRQ(ierr); 626 b = (Mat_SeqAIJ *) (*fact)->data; 627 PetscFree(b->imax); 628 b->singlemalloc = 0; 629 len = (ainew[n] + shift)*sizeof(Scalar); 630 /* the next line frees the default space generated by the Create() */ 631 PetscFree(b->a); PetscFree(b->ilen); 632 b->a = (Scalar *) PetscMalloc( len ); CHKPTRQ(b->a); 633 b->j = ajnew; 634 b->i = ainew; 635 for ( i=0; i<n; i++ ) dloc[i] += ainew[i]; 636 b->diag = dloc; 637 b->ilen = 0; 638 b->imax = 0; 639 b->row = isrow; 640 b->col = iscol; 641 b->solve_work = (Scalar *) PetscMalloc( (n+1)*sizeof(Scalar)); 642 CHKPTRQ(b->solve_work); 643 /* In b structure: Free imax, ilen, old a, old j. 644 Allocate dloc, solve_work, new a, new j */ 645 PLogObjectMemory(*fact,(ainew[n]+shift-n) * (sizeof(int)+sizeof(Scalar))); 646 b->maxnz = b->nz = ainew[n] + shift; 647 (*fact)->factor = FACTOR_LU; 648 return 0; 649 } 650 651 652 653 654