/* ------------------------------------------ destructor, free's the object and its data created -- 98may04, cca ------------------------------------------ */ void FrontMtx_free ( FrontMtx *frontmtx ) { if ( frontmtx == NULL ) { fprintf(stderr, "\n fatal error in FrontMtx_free(%p)" "\n bad input\n", frontmtx) ; exit(-1) ; } FrontMtx_clearData(frontmtx) ; FREE(frontmtx) ; return ; }
PetscErrorCode MatFactorNumeric_SeqSpooles(Mat F,Mat A,const MatFactorInfo *info) { Mat_Spooles *lu = (Mat_Spooles*)(F)->spptr; ChvManager *chvmanager ; Chv *rootchv ; IVL *adjIVL; PetscErrorCode ierr; PetscInt nz,nrow=A->rmap->n,irow,nedges,neqns=A->cmap->n,*ai,*aj,i,*diag=0,fierr; PetscScalar *av; double cputotal,facops; #if defined(PETSC_USE_COMPLEX) PetscInt nz_row,*aj_tmp; PetscScalar *av_tmp; #else PetscInt *ivec1,*ivec2,j; double *dvec; #endif PetscBool isSeqAIJ,isMPIAIJ; PetscFunctionBegin; if (lu->flg == DIFFERENT_NONZERO_PATTERN) { /* first numeric factorization */ (F)->ops->solve = MatSolve_SeqSpooles; (F)->assembled = PETSC_TRUE; /* set Spooles options */ ierr = SetSpoolesOptions(A, &lu->options);CHKERRQ(ierr); lu->mtxA = InpMtx_new(); } /* copy A to Spooles' InpMtx object */ ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isSeqAIJ);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isMPIAIJ);CHKERRQ(ierr); if (isSeqAIJ){ Mat_SeqAIJ *mat = (Mat_SeqAIJ*)A->data; ai=mat->i; aj=mat->j; av=mat->a; if (lu->options.symflag == SPOOLES_NONSYMMETRIC) { nz=mat->nz; } else { /* SPOOLES_SYMMETRIC || SPOOLES_HERMITIAN */ nz=(mat->nz + A->rmap->n)/2; diag=mat->diag; } } else { /* A is SBAIJ */ Mat_SeqSBAIJ *mat = (Mat_SeqSBAIJ*)A->data; ai=mat->i; aj=mat->j; av=mat->a; nz=mat->nz; } InpMtx_init(lu->mtxA, INPMTX_BY_ROWS, lu->options.typeflag, nz, 0); #if defined(PETSC_USE_COMPLEX) for (irow=0; irow<nrow; irow++) { if ( lu->options.symflag == SPOOLES_NONSYMMETRIC || !(isSeqAIJ || isMPIAIJ)){ nz_row = ai[irow+1] - ai[irow]; aj_tmp = aj + ai[irow]; av_tmp = av + ai[irow]; } else { nz_row = ai[irow+1] - diag[irow]; aj_tmp = aj + diag[irow]; av_tmp = av + diag[irow]; } for (i=0; i<nz_row; i++){ InpMtx_inputComplexEntry(lu->mtxA, irow, *aj_tmp++,PetscRealPart(*av_tmp),PetscImaginaryPart(*av_tmp)); av_tmp++; } } #else ivec1 = InpMtx_ivec1(lu->mtxA); ivec2 = InpMtx_ivec2(lu->mtxA); dvec = InpMtx_dvec(lu->mtxA); if ( lu->options.symflag == SPOOLES_NONSYMMETRIC || !isSeqAIJ){ for (irow = 0; irow < nrow; irow++){ for (i = ai[irow]; i<ai[irow+1]; i++) ivec1[i] = irow; } IVcopy(nz, ivec2, aj); DVcopy(nz, dvec, av); } else { nz = 0; for (irow = 0; irow < nrow; irow++){ for (j = diag[irow]; j<ai[irow+1]; j++) { ivec1[nz] = irow; ivec2[nz] = aj[j]; dvec[nz] = av[j]; nz++; } } } InpMtx_inputRealTriples(lu->mtxA, nz, ivec1, ivec2, dvec); #endif InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS); if ( lu->options.msglvl > 0 ) { int err; printf("\n\n input matrix"); ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n input matrix");CHKERRQ(ierr); InpMtx_writeForHumanEye(lu->mtxA, lu->options.msgFile); err = fflush(lu->options.msgFile); if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file"); } if ( lu->flg == DIFFERENT_NONZERO_PATTERN){ /* first numeric factorization */ /*--------------------------------------------------- find a low-fill ordering (1) create the Graph object (2) order the graph -------------------------------------------------------*/ if (lu->options.useQR){ adjIVL = InpMtx_adjForATA(lu->mtxA); } else { adjIVL = InpMtx_fullAdjacency(lu->mtxA); } nedges = IVL_tsize(adjIVL); lu->graph = Graph_new(); Graph_init2(lu->graph, 0, neqns, 0, nedges, neqns, nedges, adjIVL, NULL, NULL); if ( lu->options.msglvl > 2 ) { int err; if (lu->options.useQR){ ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n graph of A^T A");CHKERRQ(ierr); } else { ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n graph of the input matrix");CHKERRQ(ierr); } Graph_writeForHumanEye(lu->graph, lu->options.msgFile); err = fflush(lu->options.msgFile); if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file"); } switch (lu->options.ordering) { case 0: lu->frontETree = orderViaBestOfNDandMS(lu->graph, lu->options.maxdomainsize, lu->options.maxzeros, lu->options.maxsize, lu->options.seed, lu->options.msglvl, lu->options.msgFile); break; case 1: lu->frontETree = orderViaMMD(lu->graph,lu->options.seed,lu->options.msglvl,lu->options.msgFile); break; case 2: lu->frontETree = orderViaMS(lu->graph, lu->options.maxdomainsize, lu->options.seed,lu->options.msglvl,lu->options.msgFile); break; case 3: lu->frontETree = orderViaND(lu->graph, lu->options.maxdomainsize, lu->options.seed,lu->options.msglvl,lu->options.msgFile); break; default: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Unknown Spooles's ordering"); } if ( lu->options.msglvl > 0 ) { int err; ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n front tree from ordering");CHKERRQ(ierr); ETree_writeForHumanEye(lu->frontETree, lu->options.msgFile); err = fflush(lu->options.msgFile); if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file"); } /* get the permutation, permute the front tree */ lu->oldToNewIV = ETree_oldToNewVtxPerm(lu->frontETree); lu->oldToNew = IV_entries(lu->oldToNewIV); lu->newToOldIV = ETree_newToOldVtxPerm(lu->frontETree); if (!lu->options.useQR) ETree_permuteVertices(lu->frontETree, lu->oldToNewIV); /* permute the matrix */ if (lu->options.useQR){ InpMtx_permute(lu->mtxA, NULL, lu->oldToNew); } else { InpMtx_permute(lu->mtxA, lu->oldToNew, lu->oldToNew); if ( lu->options.symflag == SPOOLES_SYMMETRIC) { InpMtx_mapToUpperTriangle(lu->mtxA); } #if defined(PETSC_USE_COMPLEX) if ( lu->options.symflag == SPOOLES_HERMITIAN ) { InpMtx_mapToUpperTriangleH(lu->mtxA); } #endif InpMtx_changeCoordType(lu->mtxA, INPMTX_BY_CHEVRONS); } InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS); /* get symbolic factorization */ if (lu->options.useQR){ lu->symbfacIVL = SymbFac_initFromGraph(lu->frontETree, lu->graph); IVL_overwrite(lu->symbfacIVL, lu->oldToNewIV); IVL_sortUp(lu->symbfacIVL); ETree_permuteVertices(lu->frontETree, lu->oldToNewIV); } else { lu->symbfacIVL = SymbFac_initFromInpMtx(lu->frontETree, lu->mtxA); } if ( lu->options.msglvl > 2 ) { int err; ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n old-to-new permutation vector");CHKERRQ(ierr); IV_writeForHumanEye(lu->oldToNewIV, lu->options.msgFile); ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n new-to-old permutation vector");CHKERRQ(ierr); IV_writeForHumanEye(lu->newToOldIV, lu->options.msgFile); ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n front tree after permutation");CHKERRQ(ierr); ETree_writeForHumanEye(lu->frontETree, lu->options.msgFile); ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n input matrix after permutation");CHKERRQ(ierr); InpMtx_writeForHumanEye(lu->mtxA, lu->options.msgFile); ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n symbolic factorization");CHKERRQ(ierr); IVL_writeForHumanEye(lu->symbfacIVL, lu->options.msgFile); err = fflush(lu->options.msgFile); if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file"); } lu->frontmtx = FrontMtx_new(); lu->mtxmanager = SubMtxManager_new(); SubMtxManager_init(lu->mtxmanager, NO_LOCK, 0); } else { /* new num factorization using previously computed symbolic factor */ if (lu->options.pivotingflag) { /* different FrontMtx is required */ FrontMtx_free(lu->frontmtx); lu->frontmtx = FrontMtx_new(); } else { FrontMtx_clearData (lu->frontmtx); } SubMtxManager_free(lu->mtxmanager); lu->mtxmanager = SubMtxManager_new(); SubMtxManager_init(lu->mtxmanager, NO_LOCK, 0); /* permute mtxA */ if (lu->options.useQR){ InpMtx_permute(lu->mtxA, NULL, lu->oldToNew); } else { InpMtx_permute(lu->mtxA, lu->oldToNew, lu->oldToNew); if ( lu->options.symflag == SPOOLES_SYMMETRIC ) { InpMtx_mapToUpperTriangle(lu->mtxA); } InpMtx_changeCoordType(lu->mtxA, INPMTX_BY_CHEVRONS); } InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS); if ( lu->options.msglvl > 2 ) { ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n input matrix after permutation");CHKERRQ(ierr); InpMtx_writeForHumanEye(lu->mtxA, lu->options.msgFile); } } /* end of if( lu->flg == DIFFERENT_NONZERO_PATTERN) */ if (lu->options.useQR){ FrontMtx_init(lu->frontmtx, lu->frontETree, lu->symbfacIVL, lu->options.typeflag, SPOOLES_SYMMETRIC, FRONTMTX_DENSE_FRONTS, SPOOLES_NO_PIVOTING, NO_LOCK, 0, NULL, lu->mtxmanager, lu->options.msglvl, lu->options.msgFile); } else { FrontMtx_init(lu->frontmtx, lu->frontETree, lu->symbfacIVL, lu->options.typeflag, lu->options.symflag, FRONTMTX_DENSE_FRONTS, lu->options.pivotingflag, NO_LOCK, 0, NULL, lu->mtxmanager, lu->options.msglvl, lu->options.msgFile); } if ( lu->options.symflag == SPOOLES_SYMMETRIC ) { /* || SPOOLES_HERMITIAN ? */ if ( lu->options.patchAndGoFlag == 1 ) { lu->frontmtx->patchinfo = PatchAndGoInfo_new(); PatchAndGoInfo_init(lu->frontmtx->patchinfo, 1, lu->options.toosmall, lu->options.fudge, lu->options.storeids, lu->options.storevalues); } else if ( lu->options.patchAndGoFlag == 2 ) { lu->frontmtx->patchinfo = PatchAndGoInfo_new(); PatchAndGoInfo_init(lu->frontmtx->patchinfo, 2, lu->options.toosmall, lu->options.fudge, lu->options.storeids, lu->options.storevalues); } } /* numerical factorization */ chvmanager = ChvManager_new(); ChvManager_init(chvmanager, NO_LOCK, 1); DVfill(10, lu->cpus, 0.0); if (lu->options.useQR){ facops = 0.0 ; FrontMtx_QR_factor(lu->frontmtx, lu->mtxA, chvmanager, lu->cpus, &facops, lu->options.msglvl, lu->options.msgFile); if ( lu->options.msglvl > 1 ) { ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n factor matrix");CHKERRQ(ierr); ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n facops = %9.2f", facops);CHKERRQ(ierr); } } else { IVfill(20, lu->stats, 0); rootchv = FrontMtx_factorInpMtx(lu->frontmtx, lu->mtxA, lu->options.tau, 0.0, chvmanager, &fierr, lu->cpus,lu->stats,lu->options.msglvl,lu->options.msgFile); if (rootchv) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"\n matrix found to be singular"); if (fierr >= 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"\n error encountered at front %D", fierr); if(lu->options.FrontMtxInfo){ ierr = PetscPrintf(PETSC_COMM_SELF,"\n %8d pivots, %8d pivot tests, %8d delayed rows and columns\n",lu->stats[0], lu->stats[1], lu->stats[2]);CHKERRQ(ierr); cputotal = lu->cpus[8] ; if ( cputotal > 0.0 ) { ierr = PetscPrintf(PETSC_COMM_SELF, "\n cpus cpus/totaltime" "\n initialize fronts %8.3f %6.2f" "\n load original entries %8.3f %6.2f" "\n update fronts %8.3f %6.2f" "\n assemble postponed data %8.3f %6.2f" "\n factor fronts %8.3f %6.2f" "\n extract postponed data %8.3f %6.2f" "\n store factor entries %8.3f %6.2f" "\n miscellaneous %8.3f %6.2f" "\n total time %8.3f \n", lu->cpus[0], 100.*lu->cpus[0]/cputotal, lu->cpus[1], 100.*lu->cpus[1]/cputotal, lu->cpus[2], 100.*lu->cpus[2]/cputotal, lu->cpus[3], 100.*lu->cpus[3]/cputotal, lu->cpus[4], 100.*lu->cpus[4]/cputotal, lu->cpus[5], 100.*lu->cpus[5]/cputotal, lu->cpus[6], 100.*lu->cpus[6]/cputotal, lu->cpus[7], 100.*lu->cpus[7]/cputotal, cputotal);CHKERRQ(ierr); } } } ChvManager_free(chvmanager); if ( lu->options.msglvl > 0 ) { int err; ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n factor matrix");CHKERRQ(ierr); FrontMtx_writeForHumanEye(lu->frontmtx, lu->options.msgFile); err = fflush(lu->options.msgFile); if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file"); } if ( lu->options.symflag == SPOOLES_SYMMETRIC ) { /* || SPOOLES_HERMITIAN ? */ if ( lu->options.patchAndGoFlag == 1 ) { if ( lu->frontmtx->patchinfo->fudgeIV != NULL ) { if (lu->options.msglvl > 0 ){ ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n small pivots found at these locations");CHKERRQ(ierr); IV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeIV, lu->options.msgFile); } } PatchAndGoInfo_free(lu->frontmtx->patchinfo); } else if ( lu->options.patchAndGoFlag == 2 ) { if (lu->options.msglvl > 0 ){ if ( lu->frontmtx->patchinfo->fudgeIV != NULL ) { ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n small pivots found at these locations");CHKERRQ(ierr); IV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeIV, lu->options.msgFile); } if ( lu->frontmtx->patchinfo->fudgeDV != NULL ) { ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n perturbations");CHKERRQ(ierr); DV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeDV, lu->options.msgFile); } } PatchAndGoInfo_free(lu->frontmtx->patchinfo); } } /* post-process the factorization */ FrontMtx_postProcess(lu->frontmtx, lu->options.msglvl, lu->options.msgFile); if ( lu->options.msglvl > 2 ) { int err; ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n factor matrix after post-processing");CHKERRQ(ierr); FrontMtx_writeForHumanEye(lu->frontmtx, lu->options.msgFile); err = fflush(lu->options.msgFile); if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file"); } lu->flg = SAME_NONZERO_PATTERN; lu->CleanUpSpooles = PETSC_TRUE; PetscFunctionReturn(0); }
/* --------------------------------------------------------------------- purpose -- to compute the factorization of A - sigma * B note: all variables in the calling sequence are references to allow call from fortran. input parameters data -- pointer to bridge data object psigma -- shift for the matrix pencil ppvttol -- pivot tolerance *ppvttol = 0.0 --> no pivoting used *ppvttol != 0.0 --> pivoting used, entries in factor are bounded above by 1/pvttol in magnitude output parameters *pinertia -- on return contains the number of negative eigenvalues *perror -- on return contains an error code 1 -- error found during factorization 0 -- normal return -1 -- psigma is NULL -2 -- ppvttol is NULL -3 -- data is NULL -4 -- pinertia is NULL created -- 98aug10, cca & jcp --------------------------------------------------------------------- */ void FactorMPI ( double *psigma, double *ppvttol, void *data, int *pinertia, int *perror ) { BridgeMPI *bridge = (BridgeMPI *) data ; Chv *rootchv ; ChvManager *chvmanager ; double droptol=0.0, tau ; double cpus[20] ; FILE *msgFile ; int recvtemp[3], sendtemp[3], stats[20] ; int msglvl, nnegative, nzero, npositive, pivotingflag, tag ; MPI_Comm comm ; int nproc ; #if MYDEBUG > 0 double t1, t2 ; count_Factor++ ; MARKTIME(t1) ; if ( bridge->myid == 0 ) { fprintf(stdout, "\n (%d) FactorMPI()", count_Factor) ; fflush(stdout) ; } #endif #if MYDEBUG > 1 fprintf(bridge->msgFile, "\n (%d) FactorMPI()", count_Factor) ; fflush(bridge->msgFile) ; #endif nproc = bridge->nproc ; /* --------------- check the input --------------- */ if ( psigma == NULL ) { fprintf(stderr, "\n error in FactorMPI()" "\n psigma is NULL\n") ; *perror = -1 ; return ; } if ( ppvttol == NULL ) { fprintf(stderr, "\n error in FactorMPI()" "\n ppvttol is NULL\n") ; *perror = -2 ; return ; } if ( data == NULL ) { fprintf(stderr, "\n error in FactorMPI()" "\n data is NULL\n") ; *perror = -3 ; return ; } if ( pinertia == NULL ) { fprintf(stderr, "\n error in FactorMPI()" "\n pinertia is NULL\n") ; *perror = -4 ; return ; } if ( perror == NULL ) { fprintf(stderr, "\n error in FactorMPI()" "\n perror is NULL\n") ; return ; } comm = bridge->comm ; msglvl = bridge->msglvl ; msgFile = bridge->msgFile ; /* ---------------------------------- set the shift in the pencil object ---------------------------------- */ bridge->pencil->sigma[0] = -(*psigma) ; bridge->pencil->sigma[1] = 0.0 ; /* ----------------------------------------- if the matrices are in local coordinates (i.e., this is the first factorization following a matrix-vector multiply) then map the matrix into global coordinates ----------------------------------------- */ if ( bridge->coordFlag == LOCAL ) { if ( bridge->prbtype == 1 ) { MatMul_setGlobalIndices(bridge->info, bridge->B) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n matrix B in local coordinates") ; InpMtx_writeForHumanEye(bridge->B, msgFile) ; fflush(msgFile) ; } } if ( bridge->prbtype == 2 ) { MatMul_setGlobalIndices(bridge->info, bridge->A) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n matrix A in local coordinates") ; InpMtx_writeForHumanEye(bridge->A, msgFile) ; fflush(msgFile) ; } } bridge->coordFlag = GLOBAL ; } /* ----------------------------------------------------- clear the front matrix and submatrix mananger objects ----------------------------------------------------- */ FrontMtx_clearData(bridge->frontmtx); SubMtxManager_clearData(bridge->mtxmanager); SolveMap_clearData(bridge->solvemap) ; if ( bridge->rowmapIV != NULL ) { IV_free(bridge->rowmapIV) ; bridge->rowmapIV = NULL ; } /* ----------------------------------------------------------- set the pivot tolerance. NOTE: spooles's "tau" parameter is a bound on the magnitude of the factor entries, and is the recipricol of that of the pivot tolerance of the lanczos code ----------------------------------------------------------- */ if ( *ppvttol == 0.0 ) { tau = 10.0 ; pivotingflag = SPOOLES_NO_PIVOTING ; } else { tau = (1.0)/(*ppvttol) ; pivotingflag = SPOOLES_PIVOTING ; } /* ---------------------------------- initialize the front matrix object ---------------------------------- */ FrontMtx_init(bridge->frontmtx, bridge->frontETree, bridge->symbfacIVL, SPOOLES_REAL, SPOOLES_SYMMETRIC, FRONTMTX_DENSE_FRONTS, pivotingflag, NO_LOCK, bridge->myid, bridge->ownersIV, bridge->mtxmanager, bridge->msglvl, bridge->msgFile) ; /* ------------------------- compute the factorization ------------------------- */ tag = 0 ; chvmanager = ChvManager_new() ; ChvManager_init(chvmanager, NO_LOCK, 0); IVfill(20, stats, 0) ; DVfill(20, cpus, 0.0) ; rootchv = FrontMtx_MPI_factorPencil(bridge->frontmtx, bridge->pencil, tau, droptol, chvmanager, bridge->ownersIV, 0, perror, cpus, stats, bridge->msglvl, bridge->msgFile, tag, comm) ; ChvManager_free(chvmanager); tag += 3*FrontMtx_nfront(bridge->frontmtx) + 2 ; if ( msglvl > 3 ) { fprintf(msgFile, "\n\n numeric factorization") ; FrontMtx_writeForHumanEye(bridge->frontmtx, bridge->msgFile) ; fflush(bridge->msgFile) ; } /* ---------------------------- if matrix is singular then set error flag and return ---------------------------- */ if ( rootchv != NULL ) { fprintf(msgFile, "\n WHOA NELLY!, matrix is singular") ; fflush(msgFile) ; *perror = 1 ; return ; } /* ------------------------------------------------------------------ post-process the factor matrix, convert from fronts to submatrices ------------------------------------------------------------------ */ FrontMtx_MPI_postProcess(bridge->frontmtx, bridge->ownersIV, stats, bridge->msglvl, bridge->msgFile, tag, comm); tag += 5*bridge->nproc ; /* ------------------- compute the inertia ------------------- */ FrontMtx_inertia(bridge->frontmtx, &nnegative, &nzero, &npositive) ; sendtemp[0] = nnegative ; sendtemp[1] = nzero ; sendtemp[2] = npositive ; if ( bridge->msglvl > 2 && bridge->msgFile != NULL ) { fprintf(bridge->msgFile, "\n local inertia = < %d, %d, %d >", nnegative, nzero, npositive) ; fflush(bridge->msgFile) ; } MPI_Allreduce((void *) sendtemp, (void *) recvtemp, 3, MPI_INT, MPI_SUM, comm) ; nnegative = recvtemp[0] ; nzero = recvtemp[1] ; npositive = recvtemp[2] ; if ( bridge->msglvl > 2 && bridge->msgFile != NULL ) { fprintf(bridge->msgFile, "\n global inertia = < %d, %d, %d >", nnegative, nzero, npositive) ; fflush(bridge->msgFile) ; } *pinertia = nnegative; /* --------------------------- create the solve map object --------------------------- */ SolveMap_ddMap(bridge->solvemap, SPOOLES_REAL, FrontMtx_upperBlockIVL(bridge->frontmtx), FrontMtx_lowerBlockIVL(bridge->frontmtx), nproc, bridge->ownersIV, FrontMtx_frontTree(bridge->frontmtx), bridge->seed, bridge->msglvl, bridge->msgFile) ; /* ------------------------------- redistribute the front matrices ------------------------------- */ FrontMtx_MPI_split(bridge->frontmtx, bridge->solvemap, stats, bridge->msglvl, bridge->msgFile, tag, comm) ; if ( *ppvttol != 0.0 ) { /* ------------------------------------------------------------- pivoting for stability may have taken place. create rowmapIV, the map from rows in the factorization to processes. ------------------------------------------------------------- */ bridge->rowmapIV = FrontMtx_MPI_rowmapIV(bridge->frontmtx, bridge->ownersIV, bridge->msglvl, bridge->msgFile, bridge->comm) ; if ( bridge->msglvl > 2 && bridge->msgFile != NULL ) { fprintf(bridge->msgFile, "\n\n bridge->rowmapIV") ; IV_writeForHumanEye(bridge->rowmapIV, bridge->msgFile) ; fflush(bridge->msgFile) ; } } else { bridge->rowmapIV = NULL ; } /* ------------------------------------------------------------------ set the error. (this is simple since when the spooles codes detect a fatal error, they print out a message to stderr and exit.) ------------------------------------------------------------------ */ *perror = 0 ; #if MYDEBUG > 0 MARKTIME(t2) ; time_Factor += t2 - t1 ; if ( bridge->myid == 0 ) { fprintf(stdout, ", %8.3f seconds, %8.3f total time", t2 - t1, time_Factor) ; fflush(stdout) ; } #endif #if MYDEBUG > 1 fprintf(bridge->msgFile, ", %8.3f seconds, %8.3f total time", t2 - t1, time_Factor) ; fflush(bridge->msgFile) ; #endif return; }
/* -------------------------------------------------------------------- purpose -- to fill submtx with a submatrix of the front matrix. the fronts that form the submatrix are found in frontidsIV. all information in submtx is local, front #'s are from 0 to one less than the number of fronts in the submatrix, equation #'s are from 0 to one less than the number of rows and columns in the submatrix. the global row and column ids for the submatrix are stored in rowsIV and colsIV on return. return values --- 1 -- normal return -1 -- submtx is NULL -2 -- frontmtx is NULL -3 -- frontmtx is not in 2-D mode -4 -- frontidsIV is NULL -5 -- frontidsIV is invalid -6 -- rowsIV is NULL -7 -- colsIV is NULL -8 -- unable to create front tree -9 -- unable to create symbfacIVL -10 -- unable to create coladjIVL -11 -- unable to create rowadjIVL -12 -- unable to create upperblockIVL -13 -- unable to create lowerblockIVL created -- 98oct17, cca -------------------------------------------------------------------- */ int FrontMtx_initFromSubmatrix ( FrontMtx *submtx, FrontMtx *frontmtx, IV *frontidsIV, IV *rowsIV, IV *colsIV, int msglvl, FILE *msgFile ) { ETree *etreeSub ; int ii, J, Jsub, K, Ksub, ncol, nfront, nfrontSub, neqnSub, nJ, nrow, offset, rc, size, vSub ; int *bndwghts, *colind, *colmap, *cols, *frontSubIds, *list, *nodwghts, *rowind, *rowmap, *rows ; IV *frontsizesIVsub, *vtxIV ; IVL *coladjIVLsub, *lowerblockIVLsub, *rowadjIVLsub, *symbfacIVLsub, *upperblockIVLsub ; SubMtx *mtx ; /* --------------- check the input --------------- */ if ( submtx == NULL ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n submtx is NULL\n") ; return(-1) ; } if ( frontmtx == NULL ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n frontmtx is NULL\n") ; return(-2) ; } if ( ! FRONTMTX_IS_2D_MODE(frontmtx) ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n frontmtx mode is not 2D\n") ; return(-3) ; } if ( frontidsIV == NULL ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n frontidsIV is NULL\n") ; return(-4) ; } nfront = FrontMtx_nfront(frontmtx) ; IV_sizeAndEntries(frontidsIV, &nfrontSub, &frontSubIds) ; if ( nfrontSub < 0 || nfrontSub > nfront ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n invalid frontidsIV" "\n nfrontSub = %d, nfront %d\n", nfrontSub, nfront) ; return(-5) ; } for ( ii = 0 ; ii < nfrontSub ; ii++ ) { if ( (J = frontSubIds[ii]) < 0 || J >= nfront ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n invalid frontidsIV" "\n frontSubIds[%d] = %d, nfront = %d\n", ii, J, nfront) ; return(-5) ; } } if ( rowsIV == NULL ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n rowsIV is NULL\n") ; return(-6) ; } if ( colsIV == NULL ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n colsIV is NULL\n") ; return(-7) ; } /*--------------------------------------------------------------------*/ /* ----------------------------------------------------- clear the data for the submatrix and set the scalar values (some inherited from the global matrix) ----------------------------------------------------- */ FrontMtx_clearData(submtx) ; submtx->nfront = nfrontSub ; submtx->type = frontmtx->type ; submtx->symmetryflag = frontmtx->symmetryflag ; submtx->sparsityflag = frontmtx->sparsityflag ; submtx->pivotingflag = frontmtx->pivotingflag ; submtx->dataMode = FRONTMTX_2D_MODE ; /* --------------------------------------------------------------- initialize the front tree for the submatrix. note: on return, vtxIV is filled with the vertices originally in the submatrix, (pivoting may change this), needed to find symbolic factorization IVL object note: at return, the boundary weights are likely to be invalid, since we have no way of knowing what boundary indices for a front are really in the domain. this will be changed after we have the symbolic factorization. --------------------------------------------------------------- */ etreeSub = submtx->frontETree = ETree_new() ; vtxIV = IV_new() ; rc = ETree_initFromSubtree(etreeSub, frontidsIV, frontmtx->frontETree, vtxIV) ; if ( rc != 1 ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n unable to create submatrix's front ETree, rc = %d\n", rc) ; return(-8) ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n submatrix ETree") ; ETree_writeForHumanEye(etreeSub, msgFile) ; fprintf(msgFile, "\n\n submatrix original equations") ; IV_writeForHumanEye(vtxIV, msgFile) ; fflush(msgFile) ; } /* ------------------------------------------------------ set the # of equations (perhap temporarily if pivoting has delayed some rows and columns), and the tree. ------------------------------------------------------ */ submtx->neqns = neqnSub = IV_size(vtxIV) ; submtx->tree = etreeSub->tree ; /* ----------------------------------------------------- initialize the symbolic factorization for the subtree ----------------------------------------------------- */ symbfacIVLsub = submtx->symbfacIVL = IVL_new() ; rc = IVL_initFromSubIVL(symbfacIVLsub, frontmtx->symbfacIVL, frontidsIV, vtxIV) ; if ( rc != 1 ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n unable to create submatrix's symbfac, rc = %d\n", rc) ; return(-9) ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n submatrix symbolic factorizatio") ; IVL_writeForHumanEye(symbfacIVLsub, msgFile) ; fflush(msgFile) ; } /* --------------------------------------------- adjust the boundary weights of the front tree --------------------------------------------- */ nodwghts = ETree_nodwghts(etreeSub) ; bndwghts = ETree_bndwghts(etreeSub) ; for ( J = 0 ; J < nfrontSub ; J++ ) { IVL_listAndSize(symbfacIVLsub, J, &size, &list) ; bndwghts[J] = size - nodwghts[J] ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n submatrix ETree after bndweight adjustment") ; ETree_writeForHumanEye(etreeSub, msgFile) ; fflush(msgFile) ; } /* ------------------------------------- set the front sizes for the submatrix ------------------------------------- */ frontsizesIVsub = submtx->frontsizesIV = IV_new() ; IV_init(frontsizesIVsub, nfrontSub, NULL) ; IVgather(nfrontSub, IV_entries(frontsizesIVsub), IV_entries(frontmtx->frontsizesIV), IV_entries(frontidsIV)) ; neqnSub = submtx->neqns = IV_sum(frontsizesIVsub) ; if ( msglvl > 4 ) { fprintf(msgFile, "\n\n %d equations in submatrix", neqnSub) ; fprintf(msgFile, "\n\n front sizes for submatrix") ; IV_writeForHumanEye(frontsizesIVsub, msgFile) ; fflush(msgFile) ; } /* ------------------------------------------------------------------- fill rowsIV and colsIV with the row and column ids of the submatrix ------------------------------------------------------------------- */ IV_setSize(rowsIV, neqnSub) ; IV_setSize(colsIV, neqnSub) ; rows = IV_entries(rowsIV) ; cols = IV_entries(colsIV) ; for ( Jsub = offset = 0 ; Jsub < nfrontSub ; Jsub++ ) { if ( (nJ = FrontMtx_frontSize(submtx, Jsub)) > 0 ) { J = frontSubIds[Jsub] ; FrontMtx_columnIndices(frontmtx, J, &size, &list) ; IVcopy(nJ, cols + offset, list) ; FrontMtx_rowIndices(frontmtx, J, &size, &list) ; IVcopy(nJ, rows + offset, list) ; offset += nJ ; } } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n row ids for submatrix") ; IV_writeForHumanEye(rowsIV, msgFile) ; fprintf(msgFile, "\n\n column ids for submatrix") ; IV_writeForHumanEye(colsIV, msgFile) ; fflush(msgFile) ; } /* ---------------------------------- get the row and column adjacencies ---------------------------------- */ if ( FRONTMTX_IS_PIVOTING(frontmtx) ) { submtx->neqns = neqnSub ; coladjIVLsub = submtx->coladjIVL = IVL_new() ; rc = IVL_initFromSubIVL(coladjIVLsub, frontmtx->coladjIVL, frontidsIV, colsIV) ; if ( rc != 1 ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n unable to create submatrix's coladjIVL, rc = %d\n", rc) ; return(-10) ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n submatrix col adjacency") ; IVL_writeForHumanEye(coladjIVLsub, msgFile) ; fflush(msgFile) ; } if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) { rowadjIVLsub = submtx->rowadjIVL = IVL_new() ; rc = IVL_initFromSubIVL(rowadjIVLsub, frontmtx->rowadjIVL, frontidsIV, rowsIV) ; if ( rc != 1 ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n unable to create submatrix's rowadjIVL, rc = %d\n", rc) ; return(-11) ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n submatrix row adjacency") ; IVL_writeForHumanEye(rowadjIVLsub, msgFile) ; fflush(msgFile) ; } } } IV_free(vtxIV) ; /* ---------------------------------------------- get the rowmap[] and colmap[] vectors, needed to translate indices in the submatrices ---------------------------------------------- */ colmap = IVinit(frontmtx->neqns, -1) ; for ( ii = 0 ; ii < neqnSub ; ii++ ) { colmap[cols[ii]] = ii ; } if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) { rowmap = IVinit(frontmtx->neqns, -1) ; for ( ii = 0 ; ii < neqnSub ; ii++ ) { rowmap[rows[ii]] = ii ; } } else { rowmap = colmap ; } /* ----------------------------------------------------------- get the upper and lower block IVL objects for the submatrix ----------------------------------------------------------- */ upperblockIVLsub = submtx->upperblockIVL = IVL_new() ; rc = IVL_initFromSubIVL(upperblockIVLsub, frontmtx->upperblockIVL, frontidsIV, frontidsIV) ; if ( rc != 1 ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n unable to create upperblockIVL, rc = %d\n", rc) ; return(-12) ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n upper block adjacency IVL object") ; IVL_writeForHumanEye(upperblockIVLsub, msgFile) ; fflush(msgFile) ; } if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) { lowerblockIVLsub = submtx->lowerblockIVL = IVL_new() ; rc = IVL_initFromSubIVL(lowerblockIVLsub, frontmtx->lowerblockIVL, frontidsIV, frontidsIV) ; if ( rc != 1 ) { fprintf(stderr, "\n error in FrontMtx_initFromSubmatrix()" "\n unable to create lowerblockIVL, rc = %d\n", rc) ; return(-13) ; } if ( msglvl > 4 ) { fprintf(msgFile, "\n\n lower block adjacency IVL object") ; IVL_writeForHumanEye(lowerblockIVLsub, msgFile) ; fflush(msgFile) ; } } /* ---------------------------------------------------------------- allocate the vector and hash table(s) for the factor submatrices ---------------------------------------------------------------- */ ALLOCATE(submtx->p_mtxDJJ, struct _SubMtx *, nfrontSub) ; for ( J = 0 ; J < nfrontSub ; J++ ) { submtx->p_mtxDJJ[J] = NULL ; } submtx->upperhash = I2Ohash_new() ; I2Ohash_init(submtx->upperhash, nfrontSub, nfrontSub, nfrontSub) ; if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) { submtx->lowerhash = I2Ohash_new() ; I2Ohash_init(submtx->lowerhash, nfrontSub, nfrontSub, nfrontSub) ; } /* ----------------------------------------------------------------- remove the diagonal submatrices from the factor matrix and insert into the submatrix object. note: front row and column ids must be changed to their local values, and the row and column indices must be mapped to local indices. ----------------------------------------------------------------- */ for ( Jsub = 0 ; Jsub < nfrontSub ; Jsub++ ) { J = frontSubIds[Jsub] ; if ( (mtx = frontmtx->p_mtxDJJ[J]) != NULL ) { SubMtx_setIds(mtx, Jsub, Jsub) ; SubMtx_columnIndices(mtx, &ncol, &colind) ; IVgather(ncol, colind, colmap, colind) ; SubMtx_rowIndices(mtx, &nrow, &rowind) ; IVgather(nrow, rowind, rowmap, rowind) ; submtx->p_mtxDJJ[Jsub] = mtx ; frontmtx->p_mtxDJJ[J] = NULL ; submtx->nentD += mtx->nent ; } } /* ---------------------------------------------------------------- remove the upper triangular submatrices from the factor matrix and insert into the submatrix object. note: front row and column ids must be changed to their local values. if the matrix is on the diagonal, i.e., U(J,J), its row and column indices must be mapped to local indices. ---------------------------------------------------------------- */ for ( Jsub = 0 ; Jsub < nfrontSub ; Jsub++ ) { J = frontSubIds[Jsub] ; FrontMtx_upperAdjFronts(submtx, Jsub, &size, &list) ; for ( ii = 0 ; ii < size ; ii++ ) { Ksub = list[ii] ; K = frontSubIds[Ksub] ; if ( 1 == I2Ohash_remove(frontmtx->upperhash, J, K, (void *) &mtx) ) { SubMtx_setIds(mtx, Jsub, Ksub) ; if ( K == J ) { SubMtx_columnIndices(mtx, &ncol, &colind) ; IVgather(ncol, colind, colmap, colind) ; SubMtx_rowIndices(mtx, &nrow, &rowind) ; IVgather(nrow, rowind, rowmap, rowind) ; } I2Ohash_insert(submtx->upperhash, Jsub, Ksub, (void *) mtx) ; submtx->nentU += mtx->nent ; } } } if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) { /* ---------------------------------------------------------------- remove the lower triangular submatrices from the factor matrix and insert into the submatrix object. note: front row and column ids must be changed to their local values. if the matrix is on the diagonal, i.e., L(J,J), its row and column indices must be mapped to local indices. ---------------------------------------------------------------- */ for ( Jsub = 0 ; Jsub < nfrontSub ; Jsub++ ) { J = frontSubIds[Jsub] ; FrontMtx_lowerAdjFronts(submtx, Jsub, &size, &list) ; for ( ii = 0 ; ii < size ; ii++ ) { Ksub = list[ii] ; K = frontSubIds[Ksub] ; if ( 1 == I2Ohash_remove(frontmtx->lowerhash, K, J, (void *) &mtx) ) { SubMtx_setIds(mtx, Ksub, Jsub) ; if ( K == J ) { SubMtx_columnIndices(mtx, &ncol, &colind) ; IVgather(ncol, colind, colmap, colind) ; SubMtx_rowIndices(mtx, &nrow, &rowind) ; IVgather(nrow, rowind, rowmap, rowind) ; } I2Ohash_insert(submtx->lowerhash, Ksub, Jsub, (void *) mtx); submtx->nentL += mtx->nent ; } } } } /* ------------------------ free the working storage ------------------------ */ IVfree(colmap) ; if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) { IVfree(rowmap) ; } return(1) ; }
/* -------------------------------------------------------------- purpose -- to permute (if necessary) the original matrix, and to initialize, factor and postprocess the factor matrix return value --- 1 -- normal return, factorization complete 0 -- factorization did not complete, see error flag -1 -- bridge is NULL -2 -- mtxA is NULL -3 -- perror is NULL created -- 98sep18, cca -------------------------------------------------------------- */ int BridgeMT_factor ( BridgeMT *bridge, InpMtx *mtxA, int permuteflag, int *perror ) { Chv *rootchv ; ChvManager *chvmanager ; double cputotal, nfops, t0, t1, t2 ; double cpus[11] ; int msglvl, nzf ; int stats[16] ; FILE *msgFile ; FrontMtx *frontmtx ; SubMtxManager *mtxmanager ; /*--------------------------------------------------------------------*/ MARKTIME(t0) ; /* --------------- check the input --------------- */ if ( bridge == NULL ) { fprintf(stderr, "\n error in BridgeMT_factor()" "\n bridge is NULL\n") ; return(-1) ; } if ( mtxA == NULL ) { fprintf(stderr, "\n error in BridgeMT_factor()" "\n mtxA is NULL\n") ; return(-2) ; } if ( perror == NULL ) { fprintf(stderr, "\n error in BridgeMT_factor()" "\n perror is NULL\n") ; return(-3) ; } msglvl = bridge->msglvl ; msgFile = bridge->msgFile ; /*--------------------------------------------------------------------*/ MARKTIME(t1) ; if ( permuteflag == 1 ) { int *oldToNew = IV_entries(bridge->oldToNewIV) ; /* ------------------------------------------------ permute the input matrix and convert to chevrons ------------------------------------------------ */ InpMtx_permute(mtxA, oldToNew, oldToNew) ; if ( bridge->symmetryflag == SPOOLES_SYMMETRIC || bridge->symmetryflag == SPOOLES_HERMITIAN ) { InpMtx_mapToUpperTriangle(mtxA) ; } } if ( ! INPMTX_IS_BY_CHEVRONS(mtxA) ) { InpMtx_changeCoordType(mtxA, INPMTX_BY_CHEVRONS) ; } if ( ! INPMTX_IS_BY_VECTORS(mtxA) ) { InpMtx_changeStorageMode(mtxA, INPMTX_BY_VECTORS) ; } MARKTIME(t2) ; bridge->cpus[6] += t2 - t1 ; if ( msglvl > 1 ) { fprintf(msgFile, "\n CPU %8.3f : permute and format A", t2 - t1) ; fflush(msgFile) ; } /* --------------------------- initialize the front matrix --------------------------- */ MARKTIME(t1) ; if ( (mtxmanager = bridge->mtxmanager) == NULL ) { mtxmanager = bridge->mtxmanager = SubMtxManager_new() ; SubMtxManager_init(mtxmanager, LOCK_IN_PROCESS, 0) ; } if ( (frontmtx = bridge->frontmtx) == NULL ) { frontmtx = bridge->frontmtx = FrontMtx_new() ; } else { FrontMtx_clearData(frontmtx) ; } FrontMtx_init(frontmtx, bridge->frontETree, bridge->symbfacIVL, bridge->type, bridge->symmetryflag, bridge->sparsityflag, bridge->pivotingflag, LOCK_IN_PROCESS, 0, NULL, mtxmanager, msglvl, msgFile) ; frontmtx->patchinfo = bridge->patchinfo ; MARKTIME(t2) ; bridge->cpus[7] += t2 - t1 ; if ( msglvl > 1 ) { fprintf(msgFile, "\n CPU %8.3f : initialize front matrix", t2 - t1) ; fflush(msgFile) ; } /* ----------------- factor the matrix ----------------- */ nzf = ETree_nFactorEntries(bridge->frontETree, bridge->symmetryflag) ; nfops = ETree_nFactorOps(bridge->frontETree, bridge->type, bridge->symmetryflag) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n %d factor entries, %.0f factor ops, %8.3f ratio", nzf, nfops, nfops/nzf) ; fflush(msgFile) ; } IVzero(16, stats) ; DVzero(11, cpus) ; chvmanager = ChvManager_new() ; ChvManager_init(chvmanager, LOCK_IN_PROCESS, 1) ; MARKTIME(t1) ; rootchv = FrontMtx_MT_factorInpMtx(frontmtx, mtxA, bridge->tau, bridge->droptol, chvmanager, bridge->ownersIV, bridge->lookahead, perror, cpus, stats, msglvl, msgFile) ; MARKTIME(t2) ; IVcopy(6, bridge->stats, stats) ; bridge->cpus[8] += t2 - t1 ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n CPU %8.3f : factor matrix, %8.3f mflops", t2 - t1, 1.e-6*nfops/(t2-t1)) ; fprintf(msgFile, "\n %8d pivots, %8d pivot tests, %8d delayed vertices" "\n %d entries in D, %d entries in L, %d entries in U", stats[0], stats[1], stats[2], stats[3], stats[4], stats[5]) ; cputotal = cpus[8] ; if ( cputotal > 0.0 ) { fprintf(msgFile, "\n initialize fronts %8.3f %6.2f" "\n load original entries %8.3f %6.2f" "\n update fronts %8.3f %6.2f" "\n assemble postponed data %8.3f %6.2f" "\n factor fronts %8.3f %6.2f" "\n extract postponed data %8.3f %6.2f" "\n store factor entries %8.3f %6.2f" "\n miscellaneous %8.3f %6.2f" "\n total time %8.3f", cpus[0], 100.*cpus[0]/cputotal, cpus[1], 100.*cpus[1]/cputotal, cpus[2], 100.*cpus[2]/cputotal, cpus[3], 100.*cpus[3]/cputotal, cpus[4], 100.*cpus[4]/cputotal, cpus[5], 100.*cpus[5]/cputotal, cpus[6], 100.*cpus[6]/cputotal, cpus[7], 100.*cpus[7]/cputotal, cputotal) ; } } if ( msglvl > 2 ) { fprintf(msgFile, "\n\n submatrix mananger after factorization") ; SubMtxManager_writeForHumanEye(mtxmanager, msgFile) ; fprintf(msgFile, "\n\n chevron mananger after factorization") ; ChvManager_writeForHumanEye(chvmanager, msgFile) ; fflush(msgFile) ; } if ( msglvl > 3 ) { fprintf(msgFile, "\n\n front factor matrix") ; FrontMtx_writeForHumanEye(frontmtx, msgFile) ; fflush(msgFile) ; } ChvManager_free(chvmanager) ; if ( *perror >= 0 ) { return(0) ; } /* ----------------------------- post-process the front matrix ----------------------------- */ MARKTIME(t1) ; FrontMtx_postProcess(frontmtx, msglvl, msgFile) ; MARKTIME(t2) ; bridge->cpus[9] += t2 - t1 ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n CPU %8.3f : post-process the matrix", t2 - t1) ; fflush(msgFile) ; } if ( msglvl > 2 ) { fprintf(msgFile, "\n\n submatrix mananger after post-processing") ; SubMtxManager_writeForHumanEye(frontmtx->manager, msgFile) ; fflush(msgFile) ; } if ( msglvl > 3 ) { fprintf(msgFile, "\n\n front factor matrix after post-processing") ; FrontMtx_writeForHumanEye(frontmtx, msgFile) ; fflush(msgFile) ; } /*--------------------------------------------------------------------*/ MARKTIME(t2) ; bridge->cpus[10] += t2 - t0 ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n CPU %8.3f : total factor time", t2 - t0) ; fflush(msgFile) ; } return(1) ; }
/* --------------------------------------------------------------------- purpose -- to compute the factorization of A - sigma * B note: all variables in the calling sequence are references to allow call from fortran. input parameters data -- pointer to bridge data object psigma -- shift for the matrix pencil ppvttol -- pivot tolerance *ppvttol = 0.0 --> no pivoting used *ppvttol != 0.0 --> pivoting used, entries in factor are bounded above by 1/pvttol in magnitude output parameters *pinertia -- on return contains the number of negative eigenvalues *perror -- on return contains an error code 1 -- error found during factorization 0 -- normal return -1 -- psigma is NULL -2 -- ppvttol is NULL -3 -- data is NULL -4 -- pinertia is NULL created -- 98aug10, cca & jcp --------------------------------------------------------------------- */ void Factor ( double *psigma, double *ppvttol, void *data, int *pinertia, int *perror ) { Bridge *bridge = (Bridge *) data ; Chv *rootchv ; ChvManager *chvmanager ; double droptol=0.0, tau ; double cpus[10] ; int stats[20] ; int nnegative, nzero, npositive, pivotingflag ; #if MYDEBUG > 0 double t1, t2 ; MARKTIME(t1) ; count_Factor++ ; fprintf(stdout, "\n (%d) Factor()", count_Factor) ; fflush(stdout) ; #endif /* --------------- check the input --------------- */ if ( psigma == NULL ) { fprintf(stderr, "\n error in Factor()" "\n psigma is NULL\n") ; *perror = -1 ; return ; } if ( ppvttol == NULL ) { fprintf(stderr, "\n error in Factor()" "\n ppvttol is NULL\n") ; *perror = -2 ; return ; } if ( data == NULL ) { fprintf(stderr, "\n error in Factor()" "\n data is NULL\n") ; *perror = -3 ; return ; } if ( pinertia == NULL ) { fprintf(stderr, "\n error in Factor()" "\n pinertia is NULL\n") ; *perror = -4 ; return ; } if ( perror == NULL ) { fprintf(stderr, "\n error in Factor()" "\n perror is NULL\n") ; return ; } /* ---------------------------------- set the shift in the pencil object ---------------------------------- */ bridge->pencil->sigma[0] = -(*psigma) ; bridge->pencil->sigma[1] = 0.0 ; /* ----------------------------------------------------- clear the front matrix and submatrix mananger objects ----------------------------------------------------- */ FrontMtx_clearData(bridge->frontmtx); SubMtxManager_clearData(bridge->mtxmanager); /* ----------------------------------------------------------- set the pivot tolerance. NOTE: spooles's "tau" parameter is a bound on the magnitude of the factor entries, and is the recipricol of that of the pivot tolerance of the lanczos code ----------------------------------------------------------- */ if ( *ppvttol == 0.0 ) { tau = 10.0 ; pivotingflag = SPOOLES_NO_PIVOTING ; } else { tau = (1.0)/(*ppvttol) ; pivotingflag = SPOOLES_PIVOTING ; } /* ---------------------------------- initialize the front matrix object ---------------------------------- */ FrontMtx_init(bridge->frontmtx, bridge->frontETree, bridge->symbfacIVL, SPOOLES_REAL, SPOOLES_SYMMETRIC, FRONTMTX_DENSE_FRONTS, pivotingflag, NO_LOCK, 0, NULL, bridge->mtxmanager, bridge->msglvl, bridge->msgFile) ; /* ------------------------- compute the factorization ------------------------- */ chvmanager = ChvManager_new() ; ChvManager_init(chvmanager, NO_LOCK, 1); IVfill(20, stats, 0) ; DVfill(10, cpus, 0.0) ; rootchv = FrontMtx_factorPencil(bridge->frontmtx, bridge->pencil, tau, droptol, chvmanager, perror, cpus, stats, bridge->msglvl, bridge->msgFile); ChvManager_free(chvmanager); /* ---------------------------- if matrix is singular then set error flag and return ---------------------------- */ if ( rootchv != NULL ) { *perror = 1 ; return ; } /* ------------------------------------------------------------------ post-process the factor matrix, convert from fronts to submatrices ------------------------------------------------------------------ */ FrontMtx_postProcess(bridge->frontmtx, bridge->msglvl, bridge->msgFile); /* ------------------- compute the inertia ------------------- */ FrontMtx_inertia(bridge->frontmtx, &nnegative, &nzero, &npositive) ; *pinertia = nnegative; /* ------------------------------------------------------------------ set the error. (this is simple since when the spooles codes detect a fatal error, they print out a message to stderr and exit.) ------------------------------------------------------------------ */ *perror = 0 ; #if MYDEBUG > 0 MARKTIME(t2) ; time_Factor += t2 - t1 ; fprintf(stdout, ", %8.3f seconds, %8.3f total time", t2 - t1, time_Factor) ; fflush(stdout) ; #endif return ; }