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