Actual source code: spooles.c

  1: /*$Id: spooles.c,v 1.10 2001/08/15 15:56:50 bsmith Exp $*/
  2: /* 
  3:    Provides an interface to the Spooles serial sparse solver
  4: */

 6:  #include src/mat/impls/aij/seq/aij.h
 7:  #include src/mat/impls/sbaij/seq/sbaij.h

  9: #if defined(PETSC_HAVE_SPOOLES) && !defined(PETSC_USE_SINGLE) && !defined(PETSC_USE_COMPLEX)
 10:  #include src/mat/impls/aij/seq/spooles.h

 12: extern int MatDestroy_SeqAIJ(Mat);
 13: int MatDestroy_SeqAIJ_Spooles(Mat A)
 14: {
 15:   Mat_Spooles *lu = (Mat_Spooles*)A->spptr;
 16:   int         ierr;
 17: 
 19: 
 20:   FrontMtx_free(lu->frontmtx) ;
 21:   IV_free(lu->newToOldIV) ;
 22:   IV_free(lu->oldToNewIV) ;
 23:   InpMtx_free(lu->mtxA) ;
 24:   ETree_free(lu->frontETree) ;
 25:   IVL_free(lu->symbfacIVL) ;
 26:   SubMtxManager_free(lu->mtxmanager) ;
 27: 
 28:   PetscFree(lu);
 29:   MatDestroy_SeqAIJ(A);

 31:   return(0);
 32: }

 34: int MatSolve_SeqAIJ_Spooles(Mat A,Vec b,Vec x)
 35: {
 36:   Mat_Spooles      *lu = (Mat_Spooles*)A->spptr;
 37:   PetscScalar      *array;
 38:   DenseMtx         *mtxY, *mtxX ;
 39:   double           *entX;
 40:   int              ierr,irow,neqns=A->m,*iv;


 44:   /* copy permuted b to mtxY */
 45:   mtxY = DenseMtx_new() ;
 46:   DenseMtx_init(mtxY, SPOOLES_REAL, 0, 0, neqns, 1, 1, neqns) ; /* column major */
 47:   iv = IV_entries(lu->oldToNewIV);
 48:   VecGetArray(b,&array);
 49:   for ( irow = 0 ; irow < neqns ; irow++ ) DenseMtx_setRealEntry(mtxY, *iv++, 0, *array++) ;
 50:   VecRestoreArray(b,&array);

 52:   mtxX = DenseMtx_new() ;
 53:   DenseMtx_init(mtxX, SPOOLES_REAL, 0, 0, neqns, 1, 1, neqns) ;
 54:   DenseMtx_zero(mtxX) ;
 55:   FrontMtx_solve(lu->frontmtx, mtxX, mtxY, lu->mtxmanager,
 56:                  lu->cpus, lu->options.msglvl, lu->options.msgFile) ;
 57:   if ( lu->options.msglvl > 2 ) {
 58:     fprintf(lu->options.msgFile, "nn right hand side matrix after permutation") ;
 59:     DenseMtx_writeForHumanEye(mtxY, lu->options.msgFile) ;
 60:     fprintf(lu->options.msgFile, "nn solution matrix in new ordering") ;
 61:     DenseMtx_writeForHumanEye(mtxX, lu->options.msgFile) ;
 62:     fflush(lu->options.msgFile) ;
 63:   }

 65:   /* permute solution into original ordering, then copy to x */
 66:   DenseMtx_permuteRows(mtxX, lu->newToOldIV);
 67:   VecGetArray(x,&array);
 68:   entX = DenseMtx_entries(mtxX);
 69:   DVcopy(neqns, array, entX);
 70:   VecRestoreArray(x,&array);
 71: 
 72:   /* free memory */
 73:   DenseMtx_free(mtxX) ;
 74:   DenseMtx_free(mtxY) ;
 75: 
 76:   return(0);
 77: }

 79: int MatFactorNumeric_SeqAIJ_Spooles(Mat A,Mat *F)
 80: {
 81:   Mat_Spooles        *lu = (Mat_Spooles*)(*F)->spptr;
 82:   ChvManager         *chvmanager ;
 83:   Chv                *rootchv ;
 84:   Graph              *graph ;
 85:   IVL                *adjIVL;
 86:   int                ierr,nz,m=A->m,irow,nedges,
 87:                      *ai,*aj,*ivec1, *ivec2, i;
 88:   PetscScalar        *av;
 89:   double             *dvec;
 90: 
 92:   /* copy A to Spooles' InpMtx object */
 93:   if ( lu->options.symflag == SPOOLES_NONSYMMETRIC ) {
 94:     Mat_SeqAIJ   *mat = (Mat_SeqAIJ*)A->data;
 95:     ai=mat->i; aj=mat->j; av=mat->a;
 96:     nz=mat->nz;
 97:   } else {
 98:     Mat_SeqSBAIJ *mat = (Mat_SeqSBAIJ*)A->data;
 99:     ai=mat->i; aj=mat->j; av=mat->a;
100:     nz=mat->s_nz;
101:   }
102:   if (lu->flg == DIFFERENT_NONZERO_PATTERN) lu->mtxA = InpMtx_new() ;
103:   InpMtx_init(lu->mtxA, INPMTX_BY_ROWS, SPOOLES_REAL, nz, m) ;
104:   ivec1 = InpMtx_ivec1(lu->mtxA);
105:   ivec2 = InpMtx_ivec2(lu->mtxA);
106:   dvec  = InpMtx_dvec(lu->mtxA);
107:   for (irow = 0; irow < m; irow++){
108:     for (i = ai[irow]; i<ai[irow+1]; i++) ivec1[i] = irow;
109:   }
110:   IVcopy(nz, ivec2, aj);
111:   DVcopy(nz, dvec, av);
112:   InpMtx_inputRealTriples(lu->mtxA, nz, ivec1, ivec2, dvec);
113:   InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS) ;

115:   if ( lu->flg == DIFFERENT_NONZERO_PATTERN){ /* first numeric factorization */
116: 
117:     (*F)->ops->solve   = MatSolve_SeqAIJ_Spooles;
118:     (*F)->ops->destroy = MatDestroy_SeqAIJ_Spooles;
119:     (*F)->assembled    = PETSC_TRUE;
120: 
121:     SetSpoolesOptions(A, &lu->options);

123:     /*---------------------------------------------------
124:     find a low-fill ordering
125:          (1) create the Graph object
126:          (2) order the graph using multiple minimum degree
127:     -------------------------------------------------------*/
128:     graph = Graph_new() ;
129:     adjIVL = InpMtx_fullAdjacency(lu->mtxA) ;
130:     nedges = IVL_tsize(adjIVL) ;
131:     Graph_init2(graph, 0, m, 0, nedges, m, nedges, adjIVL,NULL, NULL) ;
132:     if ( lu->options.msglvl > 2 ) {
133:       fprintf(lu->options.msgFile, "nn graph of the input matrix") ;
134:       Graph_writeForHumanEye(graph, lu->options.msgFile) ;
135:       fflush(lu->options.msgFile) ;
136:     }

138:     switch (lu->options.ordering) {
139:     case 0:
140:       lu->frontETree = orderViaBestOfNDandMS(graph,
141:                      lu->options.maxdomainsize, lu->options.maxzeros, lu->options.maxsize,
142:                      lu->options.seed, lu->options.msglvl, lu->options.msgFile); break;
143:     case 1:
144:       lu->frontETree = orderViaMMD(graph,lu->options.seed,lu->options.msglvl,lu->options.msgFile); break;
145:     case 2:
146:       lu->frontETree = orderViaMS(graph, lu->options.maxdomainsize,
147:                      lu->options.seed,lu->options.msglvl,lu->options.msgFile); break;
148:     case 3:
149:       lu->frontETree = orderViaND(graph, lu->options.maxdomainsize,
150:                      lu->options.seed,lu->options.msglvl,lu->options.msgFile); break;
151:     default:
152:       SETERRQ(1,"Unknown Spooles's ordering");
153:     }
154:     Graph_free(graph) ;

156:     if ( lu->options.msglvl > 0 ) {
157:       fprintf(lu->options.msgFile, "nn front tree from ordering") ;
158:       ETree_writeForHumanEye(lu->frontETree, lu->options.msgFile) ;
159:       fflush(lu->options.msgFile) ;
160:     }
161: 
162:     /* get the permutation, permute the front tree, permute the matrix */
163:     lu->oldToNewIV = ETree_oldToNewVtxPerm(lu->frontETree) ;
164:     lu->oldToNew   = IV_entries(lu->oldToNewIV) ;
165:     lu->newToOldIV = ETree_newToOldVtxPerm(lu->frontETree) ;
166:     ETree_permuteVertices(lu->frontETree, lu->oldToNewIV) ;

168:     InpMtx_permute(lu->mtxA, lu->oldToNew, lu->oldToNew) ;
169:     if ( lu->options.symflag == SPOOLES_SYMMETRIC ) {
170:       InpMtx_mapToUpperTriangle(lu->mtxA) ;
171:     }
172:     InpMtx_changeCoordType(lu->mtxA, INPMTX_BY_CHEVRONS) ;
173:     InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS) ;

175:     /* get symbolic factorization */
176:     lu->symbfacIVL = SymbFac_initFromInpMtx(lu->frontETree, lu->mtxA) ;

178:     if ( lu->options.msglvl > 2 ) {
179:       fprintf(lu->options.msgFile, "nn old-to-new permutation vector") ;
180:       IV_writeForHumanEye(lu->oldToNewIV, lu->options.msgFile) ;
181:       fprintf(lu->options.msgFile, "nn new-to-old permutation vector") ;
182:       IV_writeForHumanEye(lu->newToOldIV, lu->options.msgFile) ;
183:       fprintf(lu->options.msgFile, "nn front tree after permutation") ;
184:       ETree_writeForHumanEye(lu->frontETree, lu->options.msgFile) ;
185:       fprintf(lu->options.msgFile, "nn input matrix after permutation") ;
186:       InpMtx_writeForHumanEye(lu->mtxA, lu->options.msgFile) ;
187:       fprintf(lu->options.msgFile, "nn symbolic factorization") ;
188:       IVL_writeForHumanEye(lu->symbfacIVL, lu->options.msgFile) ;
189:       fflush(lu->options.msgFile) ;
190:     }

192:     lu->frontmtx   = FrontMtx_new() ;
193:     lu->mtxmanager = SubMtxManager_new() ;
194:     SubMtxManager_init(lu->mtxmanager, NO_LOCK, 0) ;

196:   } else { /* new num factorization using previously computed symbolic factor */
197:     if (lu->options.pivotingflag) {              /* different FrontMtx is required */
198:       FrontMtx_free(lu->frontmtx) ;
199:       lu->frontmtx   = FrontMtx_new() ;
200:     }

202:     SubMtxManager_free(lu->mtxmanager) ;
203:     lu->mtxmanager = SubMtxManager_new() ;
204:     SubMtxManager_init(lu->mtxmanager, NO_LOCK, 0) ;

206:     /* permute mtxA */
207:     InpMtx_permute(lu->mtxA, lu->oldToNew, lu->oldToNew) ;
208:     if ( lu->options.symflag == SPOOLES_SYMMETRIC ) InpMtx_mapToUpperTriangle(lu->mtxA) ;
209:     InpMtx_changeCoordType(lu->mtxA, INPMTX_BY_CHEVRONS) ;
210:     InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS) ;
211:     if ( lu->options.msglvl > 2 ) {
212:       fprintf(lu->options.msgFile, "nn input matrix after permutation") ;
213:       InpMtx_writeForHumanEye(lu->mtxA, lu->options.msgFile) ;
214:     }
215:   } /* end of if( lu->flg == DIFFERENT_NONZERO_PATTERN) */

217:   FrontMtx_init(lu->frontmtx, lu->frontETree, lu->symbfacIVL, SPOOLES_REAL, lu->options.symflag,
218:                 FRONTMTX_DENSE_FRONTS, lu->options.pivotingflag, NO_LOCK, 0, NULL,
219:                 lu->mtxmanager, lu->options.msglvl, lu->options.msgFile) ;
220: 

222:   if ( lu->options.symflag == SPOOLES_SYMMETRIC ) {
223:     if ( lu->options.patchAndGoFlag == 1 ) {
224:       lu->frontmtx->patchinfo = PatchAndGoInfo_new() ;
225:       PatchAndGoInfo_init(lu->frontmtx->patchinfo, 1, lu->options.toosmall, lu->options.fudge,
226:                        lu->options.storeids, lu->options.storevalues) ;
227:     } else if ( lu->options.patchAndGoFlag == 2 ) {
228:       lu->frontmtx->patchinfo = PatchAndGoInfo_new() ;
229:       PatchAndGoInfo_init(lu->frontmtx->patchinfo, 2, lu->options.toosmall, lu->options.fudge,
230:                        lu->options.storeids, lu->options.storevalues) ;
231:     }
232:   }

234:   /* numerical factorization */
235:   chvmanager = ChvManager_new() ;
236:   ChvManager_init(chvmanager, NO_LOCK, 1) ;
237:   DVfill(10, lu->cpus, 0.0) ;
238:   IVfill(20, lu->stats, 0) ;
239:   rootchv = FrontMtx_factorInpMtx(lu->frontmtx, lu->mtxA, lu->options.tau, 0.0,
240:             chvmanager, &ierr, lu->cpus, lu->stats, lu->options.msglvl, lu->options.msgFile) ;
241:   ChvManager_free(chvmanager) ;
242:   if ( lu->options.msglvl > 0 ) {
243:     fprintf(lu->options.msgFile, "nn factor matrix") ;
244:     FrontMtx_writeForHumanEye(lu->frontmtx, lu->options.msgFile) ;
245:     fflush(lu->options.msgFile) ;
246:   }

248:   if ( lu->options.symflag == SPOOLES_SYMMETRIC ) {
249:     if ( lu->options.patchAndGoFlag == 1 ) {
250:       if ( lu->frontmtx->patchinfo->fudgeIV != NULL ) {
251:         if (lu->options.msglvl > 0 ){
252:           fprintf(lu->options.msgFile, "n small pivots found at these locations") ;
253:           IV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeIV, lu->options.msgFile) ;
254:         }
255:       }
256:       PatchAndGoInfo_free(lu->frontmtx->patchinfo) ;
257:     } else if ( lu->options.patchAndGoFlag == 2 ) {
258:       if (lu->options.msglvl > 0 ){
259:         if ( lu->frontmtx->patchinfo->fudgeIV != NULL ) {
260:           fprintf(lu->options.msgFile, "n small pivots found at these locations") ;
261:           IV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeIV, lu->options.msgFile) ;
262:         }
263:         if ( lu->frontmtx->patchinfo->fudgeDV != NULL ) {
264:           fprintf(lu->options.msgFile, "n perturbations") ;
265:           DV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeDV, lu->options.msgFile) ;
266:         }
267:       }
268:       PatchAndGoInfo_free(lu->frontmtx->patchinfo) ;
269:     }
270:   }

272:   if ( rootchv != NULL ) SETERRQ(1,"n matrix found to be singular");
273:   if ( ierr >= 0 ) SETERRQ1(1,"n error encountered at front %d", ierr);

275:   /* post-process the factorization */
276:   FrontMtx_postProcess(lu->frontmtx, lu->options.msglvl, lu->options.msgFile) ;
277:   if ( lu->options.msglvl > 2 ) {
278:     fprintf(lu->options.msgFile, "nn factor matrix after post-processing") ;
279:     FrontMtx_writeForHumanEye(lu->frontmtx, lu->options.msgFile) ;
280:     fflush(lu->options.msgFile) ;
281:   }

283:   lu->flg         = SAME_NONZERO_PATTERN;
284: 
285:   return(0);
286: }

288: #endif