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