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