1 /*$Id: superlu.c,v 1.10 2001/08/15 15:56:50 bsmith Exp $*/ 2 3 /* 4 Provides an interface to the SuperLU 3.0 sparse solver 5 */ 6 7 #include "src/mat/impls/aij/seq/aij.h" 8 9 EXTERN_C_BEGIN 10 #if defined(PETSC_USE_COMPLEX) 11 #include "zsp_defs.h" 12 #else 13 #include "dsp_defs.h" 14 #endif 15 #include "util.h" 16 EXTERN_C_END 17 18 typedef struct { 19 SuperMatrix A,L,U,B,X; 20 superlu_options_t options; 21 int *perm_c; /* column permutation vector */ 22 int *perm_r; /* row permutations from partial pivoting */ 23 int *etree; 24 double *R, *C; 25 char equed[1]; 26 int lwork; 27 void *work; 28 double rpg, rcond; 29 mem_usage_t mem_usage; 30 MatStructure flg; 31 /* 32 SuperMatrix A,B,AC,L,U; 33 int *perm_r,*perm_c,ispec,relax,panel_size; 34 double pivot_threshold; 35 NCformat *store; 36 MatStructure flg; 37 PetscTruth SuperluMatOdering; 38 */ 39 40 /* A few function pointers for inheritance */ 41 int (*MatDuplicate)(Mat,MatDuplicateOption,Mat*); 42 int (*MatView)(Mat,PetscViewer); 43 int (*MatAssemblyEnd)(Mat,MatAssemblyType); 44 int (*MatLUFactorSymbolic)(Mat,IS,IS,MatFactorInfo*,Mat*); 45 int (*MatDestroy)(Mat); 46 47 /* Flag to clean up (non-global) SuperLU objects during Destroy */ 48 PetscTruth CleanUpSuperLU; 49 } Mat_SuperLU; 50 51 52 EXTERN int MatFactorInfo_SuperLU(Mat,PetscViewer); 53 EXTERN int MatLUFactorSymbolic_SuperLU(Mat,IS,IS,MatFactorInfo*,Mat*); 54 55 EXTERN_C_BEGIN 56 EXTERN int MatConvert_SuperLU_SeqAIJ(Mat,MatType,Mat*); 57 EXTERN int MatConvert_SeqAIJ_SuperLU(Mat,MatType,Mat*); 58 EXTERN_C_END 59 60 #undef __FUNCT__ 61 #define __FUNCT__ "MatDestroy_SuperLU" 62 int MatDestroy_SuperLU(Mat A) 63 { 64 int ierr; 65 Mat_SuperLU *lu = (Mat_SuperLU*)A->spptr; 66 67 PetscFunctionBegin; 68 if (lu->CleanUpSuperLU) { /* Free the SuperLU datastructures */ 69 /* Destroy_CompCol_Matrix(&lu->A); */ /* hangs inside memory.c! */ 70 Destroy_SuperMatrix_Store(&lu->A); 71 Destroy_SuperMatrix_Store(&lu->B); 72 Destroy_SuperMatrix_Store(&lu->X); 73 SUPERLU_FREE (lu->etree); 74 SUPERLU_FREE (lu->perm_r); 75 SUPERLU_FREE (lu->perm_c); 76 SUPERLU_FREE (lu->R); 77 SUPERLU_FREE (lu->C); 78 if ( lu->lwork >= 0 ) { 79 Destroy_SuperNode_Matrix(&lu->L); 80 Destroy_CompCol_Matrix(&lu->U); 81 } 82 } 83 ierr = MatConvert_SuperLU_SeqAIJ(A,MATSEQAIJ,&A);CHKERRQ(ierr); 84 ierr = (*A->ops->destroy)(A);CHKERRQ(ierr); 85 PetscFunctionReturn(0); 86 } 87 88 #undef __FUNCT__ 89 #define __FUNCT__ "MatView_SuperLU" 90 int MatView_SuperLU(Mat A,PetscViewer viewer) 91 { 92 int ierr; 93 PetscTruth isascii; 94 PetscViewerFormat format; 95 Mat_SuperLU *lu=(Mat_SuperLU*)(A->spptr); 96 97 PetscFunctionBegin; 98 ierr = (*lu->MatView)(A,viewer);CHKERRQ(ierr); 99 100 ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr); 101 if (isascii) { 102 ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr); 103 if (format == PETSC_VIEWER_ASCII_FACTOR_INFO) { 104 ierr = MatFactorInfo_SuperLU(A,viewer);CHKERRQ(ierr); 105 } 106 } 107 PetscFunctionReturn(0); 108 } 109 110 #undef __FUNCT__ 111 #define __FUNCT__ "MatAssemblyEnd_SuperLU" 112 int MatAssemblyEnd_SuperLU(Mat A,MatAssemblyType mode) { 113 int ierr; 114 Mat_SuperLU *lu=(Mat_SuperLU*)(A->spptr); 115 116 PetscFunctionBegin; 117 ierr = (*lu->MatAssemblyEnd)(A,mode);CHKERRQ(ierr); 118 119 lu->MatLUFactorSymbolic = A->ops->lufactorsymbolic; 120 A->ops->lufactorsymbolic = MatLUFactorSymbolic_SuperLU; 121 PetscFunctionReturn(0); 122 } 123 124 /* This function was written for SuperLU 2.0 by Matthew Knepley. Not tested for SuperLU 3.0! */ 125 #ifdef SuperLU2 126 #include "src/mat/impls/dense/seq/dense.h" 127 #undef __FUNCT__ 128 #define __FUNCT__ "MatCreateNull_SuperLU" 129 int MatCreateNull_SuperLU(Mat A,Mat *nullMat) 130 { 131 Mat_SuperLU *lu = (Mat_SuperLU*)A->spptr; 132 int numRows = A->m,numCols = A->n; 133 SCformat *Lstore; 134 int numNullCols,size; 135 SuperLUStat_t stat; 136 #if defined(PETSC_USE_COMPLEX) 137 doublecomplex *nullVals,*workVals; 138 #else 139 PetscScalar *nullVals,*workVals; 140 #endif 141 int row,newRow,col,newCol,block,b,ierr; 142 143 PetscFunctionBegin; 144 PetscValidHeaderSpecific(A,MAT_COOKIE); 145 PetscValidPointer(nullMat); 146 if (!A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Unfactored matrix"); 147 numNullCols = numCols - numRows; 148 if (numNullCols < 0) SETERRQ(PETSC_ERR_ARG_WRONG,"Function only applies to underdetermined problems"); 149 /* Create the null matrix */ 150 ierr = MatCreateSeqDense(A->comm,numRows,numNullCols,PETSC_NULL,nullMat);CHKERRQ(ierr); 151 if (numNullCols == 0) { 152 ierr = MatAssemblyBegin(*nullMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 153 ierr = MatAssemblyEnd(*nullMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 154 PetscFunctionReturn(0); 155 } 156 #if defined(PETSC_USE_COMPLEX) 157 nullVals = (doublecomplex*)((Mat_SeqDense*)(*nullMat)->data)->v; 158 #else 159 nullVals = ((Mat_SeqDense*)(*nullMat)->data)->v; 160 #endif 161 /* Copy in the columns */ 162 Lstore = (SCformat*)lu->L.Store; 163 for(block = 0; block <= Lstore->nsuper; block++) { 164 newRow = Lstore->sup_to_col[block]; 165 size = Lstore->sup_to_col[block+1] - Lstore->sup_to_col[block]; 166 for(col = Lstore->rowind_colptr[newRow]; col < Lstore->rowind_colptr[newRow+1]; col++) { 167 newCol = Lstore->rowind[col]; 168 if (newCol >= numRows) { 169 for(b = 0; b < size; b++) 170 #if defined(PETSC_USE_COMPLEX) 171 nullVals[(newCol-numRows)*numRows+newRow+b] = ((doublecomplex*)Lstore->nzval)[Lstore->nzval_colptr[newRow+b]+col]; 172 #else 173 nullVals[(newCol-numRows)*numRows+newRow+b] = ((double*)Lstore->nzval)[Lstore->nzval_colptr[newRow+b]+col]; 174 #endif 175 } 176 } 177 } 178 /* Permute rhs to form P^T_c B */ 179 ierr = PetscMalloc(numRows*sizeof(double),&workVals);CHKERRQ(ierr); 180 for(b = 0; b < numNullCols; b++) { 181 for(row = 0; row < numRows; row++) workVals[lu->perm_c[row]] = nullVals[b*numRows+row]; 182 for(row = 0; row < numRows; row++) nullVals[b*numRows+row] = workVals[row]; 183 } 184 /* Backward solve the upper triangle A x = b */ 185 for(b = 0; b < numNullCols; b++) { 186 #if defined(PETSC_USE_COMPLEX) 187 sp_ztrsv("L","T","U",&lu->L,&lu->U,&nullVals[b*numRows],&stat,&ierr); 188 #else 189 sp_dtrsv("L","T","U",&lu->L,&lu->U,&nullVals[b*numRows],&stat,&ierr); 190 #endif 191 if (ierr < 0) 192 SETERRQ1(PETSC_ERR_ARG_WRONG,"The argument %d was invalid",-ierr); 193 } 194 ierr = PetscFree(workVals);CHKERRQ(ierr); 195 196 ierr = MatAssemblyBegin(*nullMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 197 ierr = MatAssemblyEnd(*nullMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 198 PetscFunctionReturn(0); 199 } 200 #endif 201 202 #undef __FUNCT__ 203 #define __FUNCT__ "MatSolve_SuperLU" 204 int MatSolve_SuperLU(Mat A,Vec b,Vec x) 205 { 206 Mat_SuperLU *lu = (Mat_SuperLU*)A->spptr; 207 PetscScalar *barray,*xarray; 208 int m,n,ierr,lwork,info,i; 209 SuperLUStat_t stat; 210 double ferr,berr,*rhsb,*rhsx; 211 212 PetscFunctionBegin; 213 /* rhs vector */ 214 lu->B.ncol = 1; /* Set the number of right-hand side */ 215 ierr = VecGetArray(b,&barray);CHKERRQ(ierr); 216 ((DNformat*)lu->B.Store)->nzval = barray; 217 218 /* solution vector */ 219 ierr = VecGetArray(x,&xarray);CHKERRQ(ierr); 220 ((DNformat*)lu->X.Store)->nzval = xarray; 221 222 /* Initialize the statistics variables. */ 223 StatInit(&stat); 224 225 lu->options.Fact = FACTORED; /* Indicate the factored form of A is supplied. */ 226 lu->options.Trans = TRANS; 227 dgssvx(&lu->options, &lu->A, lu->perm_c, lu->perm_r, lu->etree, lu->equed, lu->R, lu->C, 228 &lu->L, &lu->U, lu->work, lu->lwork, &lu->B, &lu->X, &lu->rpg, &lu->rcond, &ferr, &berr, 229 &lu->mem_usage, &stat, &info); 230 231 ierr = VecRestoreArray(b,&barray);CHKERRQ(ierr); 232 ierr = VecRestoreArray(x,&xarray);CHKERRQ(ierr); 233 234 if ( info == 0 || info == lu->A.ncol+1 ) { 235 if ( lu->options.IterRefine ) { 236 printf("Iterative Refinement:\n"); 237 printf("%8s%8s%16s%16s\n", "rhs", "Steps", "FERR", "BERR"); 238 for (i = 0; i < 1; ++i) 239 printf("%8d%8d%16e%16e\n", i+1, stat.RefineSteps, ferr, berr); 240 } 241 fflush(stdout); 242 } else if ( info > 0 && lu->lwork == -1 ) { 243 printf("** Estimated memory: %d bytes\n", info - n); 244 } 245 246 if ( lu->options.PrintStat ) StatPrint(&stat); 247 StatFree(&stat); 248 PetscFunctionReturn(0); 249 } 250 251 #undef __FUNCT__ 252 #define __FUNCT__ "MatLUFactorNumeric_SuperLU" 253 int MatLUFactorNumeric_SuperLU(Mat A,Mat *F) 254 { 255 Mat_SeqAIJ *aa = (Mat_SeqAIJ*)(A)->data; 256 Mat_SuperLU *lu = (Mat_SuperLU*)(*F)->spptr; 257 int ierr,info; 258 PetscTruth flag; 259 SuperLUStat_t stat; 260 double ferr, berr; 261 262 PetscFunctionBegin; 263 if (lu->flg == DIFFERENT_NONZERO_PATTERN){ /* first numeric factorization */ 264 /* Set SuperLU options */ 265 /* the default values for options argument: 266 options.Fact = DOFACT; 267 options.Equil = YES; 268 options.ColPerm = COLAMD; 269 options.DiagPivotThresh = 1.0; 270 options.Trans = NOTRANS; 271 options.IterRefine = NOREFINE; 272 options.SymmetricMode = NO; 273 options.PivotGrowth = NO; 274 options.ConditionNumber = NO; 275 options.PrintStat = YES; 276 */ 277 set_default_options(&lu->options); 278 lu->options.Equil = NO; /* equilibration causes error in solve */ 279 } else { /* successing numerical factorization */ 280 /* Ref: ~SuperLU_3.0/EXAMPLE/dlinsolx2.c */ 281 Destroy_SuperMatrix_Store(&lu->A); 282 if ( lu->lwork >= 0 ) { /* Deallocate storage associated with L and U. */ 283 Destroy_SuperNode_Matrix(&lu->L); 284 Destroy_CompCol_Matrix(&lu->U); 285 lu->options.Fact = SamePattern; 286 } 287 } 288 289 /* Create the SuperMatrix for lu->A=A^T: 290 Since SuperLU likes column-oriented matrices,we pass it the transpose, 291 and then solve A^T X = B in MatSolve(). */ 292 #if defined(PETSC_USE_COMPLEX) 293 zCreate_CompCol_Matrix(&lu->A,A->n,A->m,aa->nz,aa->a,aa->j,aa->i, 294 SLU_NC,SLU_Z,SLU_GE); 295 #else 296 dCreate_CompCol_Matrix(&lu->A,A->n,A->m,aa->nz,aa->a,aa->j,aa->i, 297 SLU_NC,SLU_D,SLU_GE); 298 #endif 299 300 /* Initialize the statistics variables. */ 301 StatInit(&stat); 302 303 lu->lwork = 0; /* allocate space internally by system malloc */ 304 lu->B.ncol = 0; /* Indicate not to solve the system */ 305 dgssvx(&lu->options, &lu->A, lu->perm_c, lu->perm_r, lu->etree, lu->equed, lu->R, lu->C, 306 &lu->L, &lu->U, lu->work, lu->lwork, &lu->B, &lu->X, &lu->rpg, &lu->rcond, &ferr, &berr, 307 &lu->mem_usage, &stat, &info); 308 309 if ( info == 0 || info == lu->A.ncol+1 ) { 310 if ( lu->options.PivotGrowth ) printf("Recip. pivot growth = %e\n", lu->rpg); 311 if ( lu->options.ConditionNumber ) 312 printf("Recip. condition number = %e\n", lu->rcond); 313 /* 314 NCformat *Ustore; 315 SCformat *Lstore; 316 Lstore = (SCformat *) lu->L.Store; 317 Ustore = (NCformat *) lu->U.Store; 318 printf("No of nonzeros in factor L = %d\n", Lstore->nnz); 319 printf("No of nonzeros in factor U = %d\n", Ustore->nnz); 320 printf("No of nonzeros in L+U = %d\n", Lstore->nnz + Ustore->nnz - n); 321 printf("L\\U MB %.3f\ttotal MB needed %.3f\texpansions %d\n", 322 mem_usage.for_lu/1e6, mem_usage.total_needed/1e6, 323 mem_usage.expansions); 324 */ 325 fflush(stdout); 326 327 } else if ( info > 0 && lu->lwork == -1 ) { 328 printf("** Estimated memory: %d bytes\n", info - lu->A.ncol); 329 } 330 331 if ( lu->options.PrintStat ) StatPrint(&stat); 332 StatFree(&stat); 333 334 lu->flg = SAME_NONZERO_PATTERN; 335 PetscFunctionReturn(0); 336 337 #ifdef OLD 338 /* Set SuperLU options */ 339 lu->relax = sp_ienv(2); 340 lu->panel_size = sp_ienv(1); 341 /* We have to initialize global data or SuperLU crashes (sucky design) */ 342 if (!StatInitCalled) { 343 StatInit(lu->panel_size,lu->relax); 344 } 345 StatInitCalled++; 346 347 ierr = PetscOptionsBegin(A->comm,A->prefix,"SuperLU Options","Mat");CHKERRQ(ierr); 348 /* use SuperLU mat ordeing */ 349 ierr = PetscOptionsInt("-mat_superlu_ordering","SuperLU ordering type (one of 0, 1, 2, 3)\n 0: natural ordering;\n 1: MMD applied to A'*A;\n 2: MMD applied to A'+A;\n 3: COLAMD, approximate minimum degree column ordering","None",lu->ispec,&lu->ispec,&flag);CHKERRQ(ierr); 350 if (flag) { 351 get_perm_c(lu->ispec, &lu->A, lu->perm_c); 352 lu->SuperluMatOdering = PETSC_TRUE; 353 } 354 PetscOptionsEnd(); 355 356 /* Create the elimination tree */ 357 ierr = PetscMalloc(A->n*sizeof(int),&etree);CHKERRQ(ierr); 358 sp_preorder("N",&lu->A,lu->perm_c,etree,&lu->AC); 359 /* Factor the matrix */ 360 #if defined(PETSC_USE_COMPLEX) 361 zgstrf("N",&lu->AC,lu->pivot_threshold,0.0,lu->relax,lu->panel_size,etree,PETSC_NULL,0,lu->perm_r,lu->perm_c,&lu->L,&lu->U,&ierr); 362 #else 363 dgstrf("N",&lu->AC,lu->pivot_threshold,0.0,lu->relax,lu->panel_size,etree,PETSC_NULL,0,lu->perm_r,lu->perm_c,&lu->L,&lu->U,&ierr); 364 #endif 365 if (ierr < 0) { 366 SETERRQ1(PETSC_ERR_ARG_WRONG,"The diagonal element of row %d was invalid",-ierr); 367 } else if (ierr > 0) { 368 if (ierr <= A->m) { 369 SETERRQ1(PETSC_ERR_ARG_WRONG,"The diagonal element %d of U is exactly zero",ierr); 370 } else { 371 SETERRQ1(PETSC_ERR_ARG_WRONG,"Memory allocation failure after %d bytes were allocated",ierr-A->m); 372 } 373 } 374 375 /* Cleanup */ 376 ierr = PetscFree(etree);CHKERRQ(ierr); 377 #endif /* OLD */ 378 379 380 } 381 382 /* 383 Note the r permutation is ignored 384 */ 385 #undef __FUNCT__ 386 #define __FUNCT__ "MatLUFactorSymbolic_SuperLU" 387 int MatLUFactorSymbolic_SuperLU(Mat A,IS r,IS c,MatFactorInfo *info,Mat *F) 388 { 389 Mat B; 390 Mat_SuperLU *lu; 391 int ierr,m=A->m,n=A->n; /* *ca; */ 392 393 PetscFunctionBegin; 394 395 ierr = MatCreate(A->comm,A->m,A->n,PETSC_DETERMINE,PETSC_DETERMINE,&B);CHKERRQ(ierr); 396 ierr = MatSetType(B,MATSUPERLU);CHKERRQ(ierr); 397 ierr = MatSeqAIJSetPreallocation(B,0,PETSC_NULL);CHKERRQ(ierr); 398 399 B->ops->lufactornumeric = MatLUFactorNumeric_SuperLU; 400 B->ops->solve = MatSolve_SuperLU; 401 B->factor = FACTOR_LU; 402 B->assembled = PETSC_TRUE; /* required by -sles_view */ 403 404 lu = (Mat_SuperLU*)(B->spptr); 405 #ifdef SUPERLU2 406 ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatCreateNull","MatCreateNull_SuperLU", 407 (void(*)(void))MatCreateNull_SuperLU);CHKERRQ(ierr); 408 #endif 409 #ifdef OLD 410 /* Allocate the work arrays required by SuperLU (notice sizes are for the transpose) */ 411 ierr = PetscMalloc(A->n*sizeof(int),&lu->perm_r);CHKERRQ(ierr); 412 ierr = PetscMalloc(A->m*sizeof(int),&lu->perm_c);CHKERRQ(ierr); 413 414 /* use PETSc mat ordering */ 415 ierr = ISGetIndices(c,&ca);CHKERRQ(ierr); 416 ierr = PetscMemcpy(lu->perm_c,ca,A->m*sizeof(int));CHKERRQ(ierr); 417 ierr = ISRestoreIndices(c,&ca);CHKERRQ(ierr); 418 lu->SuperluMatOdering = PETSC_FALSE; 419 420 lu->pivot_threshold = info->dtcol; 421 PetscLogObjectMemory(B,(A->m+A->n)*sizeof(int)+sizeof(Mat_SuperLU)); 422 #endif 423 /* Allocate spaces (notice sizes are for the transpose) */ 424 int *perm_c; /* column permutation vector */ 425 int *perm_r; /* row permutations from partial pivoting */ 426 if ( !(lu->etree = intMalloc(m)) ) ABORT("Malloc fails for etree[]."); 427 if ( !(lu->perm_r = intMalloc(n)) ) ABORT("Malloc fails for perm_r[]."); 428 if ( !(lu->perm_c = intMalloc(m)) ) ABORT("Malloc fails for perm_c[]."); 429 if ( !(lu->R = (double *) SUPERLU_MALLOC(n * sizeof(double))) ) 430 ABORT("SUPERLU_MALLOC fails for R[]."); 431 if ( !(lu->C = (double *) SUPERLU_MALLOC(m * sizeof(double))) ) 432 ABORT("SUPERLU_MALLOC fails for C[]."); 433 434 /* create rhs and solution x without allocate space for Store */ 435 dCreate_Dense_Matrix(&lu->B, m, 1, PETSC_NULL, m, SLU_DN, SLU_D, SLU_GE); 436 dCreate_Dense_Matrix(&lu->X, m, 1, PETSC_NULL, m, SLU_DN, SLU_D, SLU_GE); 437 438 lu->flg = DIFFERENT_NONZERO_PATTERN; 439 lu->CleanUpSuperLU = PETSC_TRUE; 440 441 *F = B; 442 PetscFunctionReturn(0); 443 } 444 445 /* used by -sles_view */ 446 #undef __FUNCT__ 447 #define __FUNCT__ "MatFactorInfo_SuperLU" 448 int MatFactorInfo_SuperLU(Mat A,PetscViewer viewer) 449 { 450 Mat_SuperLU *lu= (Mat_SuperLU*)A->spptr; 451 int ierr; 452 453 PetscFunctionBegin; 454 ierr = PetscViewerASCIIPrintf(viewer,"SuperLU run parameters:\n");CHKERRQ(ierr); 455 #ifdef OLD 456 if(lu->SuperluMatOdering) { 457 ierr = PetscViewerASCIIPrintf(viewer," SuperLU mat ordering: %d\n",lu->ispec);CHKERRQ(ierr); 458 } 459 #endif 460 PetscFunctionReturn(0); 461 } 462 463 #undef __FUNCT__ 464 #define __FUNCT__ "MatDuplicate_SuperLU" 465 int MatDuplicate_SuperLU(Mat A, MatDuplicateOption op, Mat *M) { 466 int ierr; 467 Mat_SuperLU *lu=(Mat_SuperLU *)A->spptr; 468 469 PetscFunctionBegin; 470 ierr = (*lu->MatDuplicate)(A,op,M);CHKERRQ(ierr); 471 ierr = MatConvert_SeqAIJ_SuperLU(*M,MATSUPERLU,M);CHKERRQ(ierr); 472 ierr = PetscMemcpy((*M)->spptr,lu,sizeof(Mat_SuperLU));CHKERRQ(ierr); 473 PetscFunctionReturn(0); 474 } 475 476 EXTERN_C_BEGIN 477 #undef __FUNCT__ 478 #define __FUNCT__ "MatConvert_SuperLU_SeqAIJ" 479 int MatConvert_SuperLU_SeqAIJ(Mat A,MatType type,Mat *newmat) { 480 /* This routine is only called to convert an unfactored PETSc-SuperLU matrix */ 481 /* to its base PETSc type, so we will ignore 'MatType type'. */ 482 int ierr; 483 Mat B=*newmat; 484 Mat_SuperLU *lu=(Mat_SuperLU *)A->spptr; 485 486 PetscFunctionBegin; 487 if (B != A) { 488 ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr); 489 } 490 /* Reset the original function pointers */ 491 B->ops->duplicate = lu->MatDuplicate; 492 B->ops->view = lu->MatView; 493 B->ops->assemblyend = lu->MatAssemblyEnd; 494 B->ops->lufactorsymbolic = lu->MatLUFactorSymbolic; 495 B->ops->destroy = lu->MatDestroy; 496 /* lu is only a function pointer stash unless we've factored the matrix, which we haven't! */ 497 ierr = PetscFree(lu);CHKERRQ(ierr); 498 ierr = PetscObjectChangeTypeName((PetscObject)B,MATSEQAIJ);CHKERRQ(ierr); 499 *newmat = B; 500 PetscFunctionReturn(0); 501 } 502 EXTERN_C_END 503 504 EXTERN_C_BEGIN 505 #undef __FUNCT__ 506 #define __FUNCT__ "MatConvert_SeqAIJ_SuperLU" 507 int MatConvert_SeqAIJ_SuperLU(Mat A,MatType type,Mat *newmat) { 508 /* This routine is only called to convert to MATSUPERLU */ 509 /* from MATSEQAIJ, so we will ignore 'MatType type'. */ 510 int ierr; 511 Mat B=*newmat; 512 Mat_SuperLU *lu; 513 514 PetscFunctionBegin; 515 if (B != A) { 516 ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr); 517 } 518 519 ierr = PetscNew(Mat_SuperLU,&lu);CHKERRQ(ierr); 520 lu->MatDuplicate = A->ops->duplicate; 521 lu->MatView = A->ops->view; 522 lu->MatAssemblyEnd = A->ops->assemblyend; 523 lu->MatLUFactorSymbolic = A->ops->lufactorsymbolic; 524 lu->MatDestroy = A->ops->destroy; 525 lu->CleanUpSuperLU = PETSC_FALSE; 526 527 B->spptr = (void*)lu; 528 B->ops->duplicate = MatDuplicate_SuperLU; 529 B->ops->view = MatView_SuperLU; 530 B->ops->assemblyend = MatAssemblyEnd_SuperLU; 531 B->ops->lufactorsymbolic = MatLUFactorSymbolic_SuperLU; 532 B->ops->destroy = MatDestroy_SuperLU; 533 534 ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_seqaij_superlu_C", 535 "MatConvert_SeqAIJ_SuperLU",MatConvert_SeqAIJ_SuperLU);CHKERRQ(ierr); 536 ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_superlu_seqaij_C", 537 "MatConvert_SuperLU_SeqAIJ",MatConvert_SuperLU_SeqAIJ);CHKERRQ(ierr); 538 PetscLogInfo(0,"Using SuperLU for SeqAIJ LU factorization and solves."); 539 ierr = PetscObjectChangeTypeName((PetscObject)B,MATSUPERLU);CHKERRQ(ierr); 540 *newmat = B; 541 PetscFunctionReturn(0); 542 } 543 EXTERN_C_END 544 545 /*MC 546 MATSUPERLU - MATSUPERLU = "superlu" - A matrix type providing direct solvers (LU) for sequential matrices 547 via the external package SuperLU. 548 549 If SuperLU is installed (see the manual for 550 instructions on how to declare the existence of external packages), 551 a matrix type can be constructed which invokes SuperLU solvers. 552 After calling MatCreate(...,A), simply call MatSetType(A,MATSUPERLU). 553 This matrix type is only supported for double precision real. 554 555 This matrix inherits from MATSEQAIJ. As a result, MatSeqAIJSetPreallocation is 556 supported for this matrix type. One can also call MatConvert for an inplace conversion to or from 557 the MATSEQAIJ type without data copy. 558 559 Options Database Keys: 560 + -mat_type superlu - sets the matrix type to "superlu" during a call to MatSetFromOptions() 561 - -mat_superlu_ordering <0,1,2,3> - 0: natural ordering, 562 1: MMD applied to A'*A, 563 2: MMD applied to A'+A, 564 3: COLAMD, approximate minimum degree column ordering 565 566 Level: beginner 567 568 .seealso: PCLU 569 M*/ 570 571 EXTERN_C_BEGIN 572 #undef __FUNCT__ 573 #define __FUNCT__ "MatCreate_SuperLU" 574 int MatCreate_SuperLU(Mat A) { 575 int ierr; 576 577 PetscFunctionBegin; 578 /* Change type name before calling MatSetType to force proper construction of SeqAIJ and SUPERLU types */ 579 ierr = PetscObjectChangeTypeName((PetscObject)A,MATSUPERLU);CHKERRQ(ierr); 580 ierr = MatSetType(A,MATSEQAIJ);CHKERRQ(ierr); 581 ierr = MatConvert_SeqAIJ_SuperLU(A,MATSUPERLU,&A);CHKERRQ(ierr); 582 PetscFunctionReturn(0); 583 } 584 EXTERN_C_END 585