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