/* ----------------------------------------------------------- purpose -- compute the checksums of the indices and entries sums[0] = sum_{ii=0}^{nent} abs(ivec1[ii]) sums[1] = sum_{ii=0}^{nent} abs(ivec2[ii]) if real or complex entries then sums[2] = sum_{ii=0}^{nent} magnitudes of entries endif created -- 98may16, cca ----------------------------------------------------------- */ void InpMtx_checksums ( InpMtx *inpmtx, double sums[] ) { int ient, nent ; int *ivec1, *ivec2 ; /* --------------- check the input --------------- */ if ( inpmtx == NULL ) { fprintf(stderr, "\n fatal error in InpMtx_checksums(%p,%p)" "\n bad input\n", inpmtx, sums) ; exit(-1) ; } switch ( inpmtx->inputMode ) { case INPMTX_INDICES_ONLY : case SPOOLES_REAL : case SPOOLES_COMPLEX : break ; default : fprintf(stderr, "\n fatal error in InpMtx_checksums(%p,%p)" "\n bad inputMode\n", inpmtx, sums) ; exit(-1) ; } sums[0] = sums[1] = sums[2] = 0.0 ; if ( (nent = InpMtx_nent(inpmtx)) <= 0 ) { return ; } ivec1 = InpMtx_ivec1(inpmtx) ; ivec2 = InpMtx_ivec2(inpmtx) ; for ( ient = 0 ; ient < nent ; ient++ ) { sums[0] += abs(ivec1[ient]) ; sums[1] += abs(ivec2[ient]) ; } switch ( inpmtx->inputMode ) { case INPMTX_INDICES_ONLY : break ; case SPOOLES_REAL : { double *dvec = InpMtx_dvec(inpmtx) ; for ( ient = 0 ; ient < nent ; ient++ ) { sums[2] += fabs(dvec[ient]) ; } } break ; case SPOOLES_COMPLEX : { double *dvec = InpMtx_dvec(inpmtx) ; for ( ient = 0 ; ient < nent ; ient++ ) { sums[2] += Zabs(dvec[2*ient], dvec[2*ient+1]) ; } } break ; } return ; }
/* --------------------------------------- given the data is in raw triples, sort and compress the data created -- 98jan28, cca modified -- 98sep04, cca test to see if the sort is necessary --------------------------------------- */ void InpMtx_sortAndCompress ( InpMtx *inpmtx ) { int ient, nent, sortMustBeDone ; int *ivec1, *ivec2 ; /* --------------- check the input --------------- */ if ( inpmtx == NULL ) { fprintf(stderr, "\n fatal error in InpMtx_sortAndCompress(%p)" "\n bad input\n", inpmtx) ; exit(-1) ; } if ( INPMTX_IS_SORTED(inpmtx) || INPMTX_IS_BY_VECTORS(inpmtx) || (nent = inpmtx->nent) == 0 ) { inpmtx->storageMode = INPMTX_SORTED ; return ; } ivec1 = InpMtx_ivec1(inpmtx) ; ivec2 = InpMtx_ivec2(inpmtx) ; sortMustBeDone = 0 ; for ( ient = 1 ; ient < nent ; ient++ ) { if ( ivec1[ient-1] > ivec1[ient] || ( ivec1[ient-1] == ivec1[ient] && ivec2[ient-1] > ivec2[ient] ) ) { sortMustBeDone = 1 ; break ; } } if ( sortMustBeDone == 1 ) { if ( INPMTX_IS_INDICES_ONLY(inpmtx) ) { inpmtx->nent = IV2sortUpAndCompress(nent, ivec1, ivec2) ; } else if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) { double *dvec = InpMtx_dvec(inpmtx) ; inpmtx->nent = IV2DVsortUpAndCompress(nent, ivec1, ivec2, dvec) ; } else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) { double *dvec = InpMtx_dvec(inpmtx) ; inpmtx->nent = IV2ZVsortUpAndCompress(nent, ivec1, ivec2, dvec) ; } } inpmtx->storageMode = INPMTX_SORTED ; 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); }
/* ------------------------------------------- set up the nthread MTmvmObj data structures ------------------------------------------- */ static MTmvmObj * setup ( InpMtx *A, DenseMtx *Y, double alpha[], DenseMtx *X, int nthread ) { double *dvec ; int ithread, nentA, nextra, nlocal, offset ; int *ivec1, *ivec2 ; MTmvmObj *MTmvmObjs, *obj ; /* --------------------------------- allocate nthread MTmvmObj objects --------------------------------- */ ALLOCATE(MTmvmObjs, struct _MTmvmObj, nthread) ; for ( ithread = 0, obj = MTmvmObjs ; ithread < nthread ; ithread++, obj++ ) { obj->A = InpMtx_new() ; if ( ithread == 0 ) { obj->Y = Y ; } else { obj->Y = DenseMtx_new() ; } obj->alpha[0] = alpha[0] ; obj->alpha[1] = alpha[1] ; obj->X = X ; } /* ---------------------------------------- set up and zero the replicated Y objects ---------------------------------------- */ for ( ithread = 0, obj = MTmvmObjs ; ithread < nthread ; ithread++, obj++ ) { if ( ithread > 0 ) { DenseMtx_init(obj->Y, Y->type, Y->rowid, Y->colid, Y->nrow, Y->ncol, Y->inc1, Y->inc2) ; DenseMtx_zero(obj->Y) ; } } /* ------------------------------------- set up the partitioned InpMtx objects ------------------------------------- */ nentA = InpMtx_nent(A) ; nlocal = nentA / nthread ; nextra = nentA % nthread ; ivec1 = InpMtx_ivec1(A) ; ivec2 = InpMtx_ivec2(A) ; if ( INPMTX_IS_REAL_ENTRIES(A) || INPMTX_IS_COMPLEX_ENTRIES(A) ) { dvec = InpMtx_dvec(A) ; } else { dvec = NULL ; } offset = 0 ; for ( ithread = 0, obj = MTmvmObjs ; ithread < nthread ; ithread++, obj++ ) { InpMtx_init(obj->A, A->coordType, A->inputMode, 0, 0) ; obj->A->storageMode = A->storageMode ; if ( ithread < nextra ) { obj->A->nent = nlocal + 1 ; } else { obj->A->nent = nlocal ; } IV_init(&(obj->A->ivec1IV), obj->A->nent, ivec1 + offset) ; IV_init(&(obj->A->ivec2IV), obj->A->nent, ivec2 + offset) ; if ( INPMTX_IS_REAL_ENTRIES(A) ) { DV_init(&(obj->A->dvecDV), obj->A->nent, dvec + offset) ; } else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) { DV_init(&(obj->A->dvecDV), obj->A->nent, dvec + 2*offset) ; } offset += obj->A->nent ; } return(MTmvmObjs) ; }
/*--------------------------------------------------------------------*/ int main ( int argc, char *argv[] ) /* --------------------------------------------------- read in (i, j, a(i,j)) triples, construct a InpMtx object and write it out to a file created -- 97oct17, cca --------------------------------------------------- */ { char *inFileName, *outFileName ; InpMtx *inpmtx ; FILE *inputFile, *msgFile ; int dataType, flag, ient, msglvl, ncol, nent, nrow, rc ; int *ivec1, *ivec2 ; if ( argc != 7 ) { fprintf(stdout, "\n\n usage : readAIJ msglvl msgFile dataType inputFile outFile flag" "\n msglvl -- message level" "\n msgFile -- message file" "\n dataType -- 0 for indices only, 1 for double, 2 for complex" "\n inputFile -- input file for a(i,j) entries" "\n the first line must be \"nrow ncol nentries\"" "\n if dataType == 0 then" "\n next lines are \"irow jcol\"" "\n else if dataType == 1 then" "\n next lines are \"irow jcol entry\"" "\n else if dataType == 2 then" "\n next lines are \"irow jcol realEntry imagEntry\"" "\n endif" "\n outFile -- output file, must be *.inpmtxf or *.inpmtxb" "\n flag -- flag for 0-based or 1-based addressing" "\n") ; return(0) ; } msglvl = atoi(argv[1]) ; if ( strcmp(argv[2], "stdout") == 0 ) { msgFile = stdout ; } else if ( (msgFile = fopen(argv[2], "a")) == NULL ) { fprintf(stderr, "\n fatal error in %s" "\n unable to open file %s\n", argv[0], argv[2]) ; return(-1) ; } dataType = atoi(argv[3]) ; inFileName = argv[4] ; outFileName = argv[5] ; flag = atoi(argv[6]) ; fprintf(msgFile, "\n readAIJ " "\n msglvl -- %d" "\n msgFile -- %s" "\n dataType -- %d" "\n inputFile -- %s" "\n outFile -- %s" "\n flag -- %d" "\n", msglvl, argv[2], dataType, inFileName, outFileName, flag) ; fflush(msgFile) ; /* ---------------------------- open the input file and read #rows #columns #entries ---------------------------- */ if ( (inputFile = fopen(inFileName, "r")) == NULL ) { fprintf(stderr, "\n fatal error in %s" "\n unable to open file %s\n", argv[0], inFileName) ; return(-1) ; } rc = fscanf(inputFile, "%d %d %d", &nrow, &ncol, &nent) ; if ( rc != 3 ) { fprintf(stderr, "\n fatal error in %s" "\n %d of 3 fields read on first line of file %s", argv[0], rc, inFileName) ; return(-1) ; } if ( msglvl > 1 ) { fprintf(msgFile, "\n\n read in nrow = %d, ncol = %d, nent = %d", nrow, ncol, nent) ; fflush(msgFile) ; } /* -------------------------------------------------- initialize the object set coordType = INPMTX_BY_ROWS --> row coordinates set inputMode = dataType -------------------------------------------------- */ inpmtx = InpMtx_new() ; InpMtx_init(inpmtx, INPMTX_BY_ROWS, dataType, nent, 0) ; /* ------------------------------------------------- read in the entries and load them into the object ------------------------------------------------- */ ivec1 = InpMtx_ivec1(inpmtx) ; ivec2 = InpMtx_ivec2(inpmtx) ; if ( INPMTX_IS_INDICES_ONLY(inpmtx) ) { for ( ient = 0 ; ient < nent ; ient++ ) { rc = fscanf(inputFile, "%d %d", ivec1 + ient, ivec2 + ient) ; if ( rc != 2 ) { fprintf(stderr, "\n fatal error in %s" "\n %d of 2 fields read on entry %d of file %s", argv[0], rc, ient, inFileName) ; return(-1) ; } if ( msglvl > 1 ) { fprintf(msgFile, "\n entry %d, row %d, column %d", ient, ivec1[ient], ivec2[ient]) ; fflush(msgFile) ; } } } else if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) { double *dvec = InpMtx_dvec(inpmtx) ; for ( ient = 0 ; ient < nent ; ient++ ) { rc = fscanf(inputFile, "%d %d %le", ivec1 + ient, ivec2 + ient, dvec + ient) ; if ( rc != 3 ) { fprintf(stderr, "\n fatal error in %s" "\n %d of 3 fields read on entry %d of file %s", argv[0], rc, ient, argv[3]) ; return(-1) ; } if ( msglvl > 1 ) { fprintf(msgFile, "\n entry %d, row %d, column %d, value %e", ient, ivec1[ient], ivec2[ient], dvec[ient]) ; fflush(msgFile) ; } } } else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) { double *dvec = InpMtx_dvec(inpmtx) ; for ( ient = 0 ; ient < nent ; ient++ ) { rc = fscanf(inputFile, "%d %d %le %le", ivec1 + ient, ivec2 + ient, dvec + 2*ient, dvec + 2*ient+1) ; if ( rc != 4 ) { fprintf(stderr, "\n fatal error in %s" "\n %d of 4 fields read on entry %d of file %s", argv[0], rc, ient, argv[3]) ; return(-1) ; } if ( msglvl > 1 ) { fprintf(msgFile, "\n entry %d, row %d, column %d, value %12.4e + %12.4e*i", ient, ivec1[ient], ivec2[ient], dvec[2*ient], dvec[2*ient+1]) ; fflush(msgFile) ; } } } inpmtx->nent = nent ; if ( flag == 1 ) { /* -------------------------------------------------- indices were in FORTRAN mode, decrement for C mode -------------------------------------------------- */ for ( ient = 0 ; ient < nent ; ient++ ) { ivec1[ient]-- ; ivec2[ient]-- ; } } /* ----------------------------- sort and compress the entries ----------------------------- */ InpMtx_changeStorageMode(inpmtx, 3) ; if ( msglvl > 1 ) { fprintf(msgFile, "\n\n sorted, compressed and vector form") ; InpMtx_writeForHumanEye(inpmtx, msgFile) ; fflush(msgFile) ; } /* --------------------------- write out the InpMtx object --------------------------- */ if ( strcmp(outFileName, "none") != 0 ) { rc = InpMtx_writeToFile(inpmtx, outFileName) ; fprintf(msgFile, "\n return value %d from InpMtx_writeToFile(%p,%s)", rc, inpmtx, outFileName) ; } /* --------------------- free the working data --------------------- */ InpMtx_free(inpmtx) ; fprintf(msgFile, "\n") ; fclose(msgFile) ; return(1) ; }
/* ----------------------------------- map entries into the upper triangle for a hermitian matrix created -- 98jan28, cca ----------------------------------- */ void InpMtx_mapToUpperTriangleH ( InpMtx *inpmtx ) { double *dvec ; int col, ii, nent, row ; int *ivec1, *ivec2 ; /* --------------- check the input --------------- */ if ( inpmtx == NULL ) { fprintf(stderr, "\n fatal error in InpMtx_mapToUpperTriangle(%p)" "\n bad input\n", inpmtx) ; exit(-1) ; } if ( !( INPMTX_IS_BY_ROWS(inpmtx) || INPMTX_IS_BY_COLUMNS(inpmtx) || INPMTX_IS_BY_CHEVRONS(inpmtx) ) ) { fprintf(stderr, "\n fatal error in InpMtx_mapToUpperTriangle(%p)" "\n bad coordType = %d, must be 1, 2, or 3\n", inpmtx, inpmtx->coordType) ; exit(-1) ; } if ( ! INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) { fprintf(stderr, "\n fatal error in InpMtx_mapToUpperTriangleH(%p)" "\n input mode is not complex\n", inpmtx) ; exit(-1) ; } nent = inpmtx->nent ; ivec1 = InpMtx_ivec1(inpmtx) ; ivec2 = InpMtx_ivec2(inpmtx) ; dvec = InpMtx_dvec(inpmtx) ; if ( INPMTX_IS_BY_ROWS(inpmtx) ) { for ( ii = 0 ; ii < nent ; ii++ ) { if ( (row = ivec1[ii]) > (col = ivec2[ii]) ) { ivec1[ii] = col ; ivec2[ii] = row ; dvec[2*ii+1] = -dvec[2*ii+1] ; } } } else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) { for ( ii = 0 ; ii < nent ; ii++ ) { if ( (row = ivec2[ii]) > (col = ivec1[ii]) ) { ivec1[ii] = row ; ivec2[ii] = col ; dvec[2*ii+1] = -dvec[2*ii+1] ; } } } else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) { for ( ii = 0 ; ii < nent ; ii++ ) { if ( ivec2[ii] < 0 ) { ivec2[ii] = -ivec2[ii] ; dvec[2*ii+1] = -dvec[2*ii+1] ; } } } inpmtx->storageMode = INPMTX_RAW_DATA ; return ; }
/* ---------------------------------- drop entries in the upper triangle created -- 98jan28, cca ---------------------------------- */ void InpMtx_dropUpperTriangle ( InpMtx *inpmtx ) { double *dvec ; int count, ii, nent ; int *ivec1, *ivec2 ; /* --------------- check the input --------------- */ if ( inpmtx == NULL ) { fprintf(stderr, "\n fatal error in InpMtx_dropUpperTriangle(%p)" "\n bad input\n", inpmtx) ; exit(-1) ; } if ( !( INPMTX_IS_BY_ROWS(inpmtx) || INPMTX_IS_BY_COLUMNS(inpmtx) || INPMTX_IS_BY_CHEVRONS(inpmtx) ) ) { fprintf(stderr, "\n fatal error in InpMtx_dropUpperTriangle(%p)" "\n bad coordType \n", inpmtx) ; exit(-1) ; } nent = inpmtx->nent ; ivec1 = InpMtx_ivec1(inpmtx) ; ivec2 = InpMtx_ivec2(inpmtx) ; count = 0 ; if ( INPMTX_IS_REAL_ENTRIES(inpmtx) || INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) { dvec = InpMtx_dvec(inpmtx) ; } if ( INPMTX_IS_BY_ROWS(inpmtx) ) { for ( ii = 0 ; ii < nent ; ii++ ) { if ( ivec1[ii] >= ivec2[ii] ) { ivec1[count] = ivec1[ii] ; ivec2[count] = ivec2[ii] ; if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) { dvec[count] = dvec[ii] ; } else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) { dvec[2*count] = dvec[2*ii] ; dvec[2*count+1] = dvec[2*ii+1] ; } count++ ; } } } else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) { for ( ii = 0 ; ii < nent ; ii++ ) { if ( ivec1[ii] <= ivec2[ii] ) { ivec1[count] = ivec1[ii] ; ivec2[count] = ivec2[ii] ; if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) { dvec[count] = dvec[ii] ; } else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) { dvec[2*count] = dvec[2*ii] ; dvec[2*count+1] = dvec[2*ii+1] ; } count++ ; } } } else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) { for ( ii = 0 ; ii < nent ; ii++ ) { if ( ivec2[ii] <= 0 ) { ivec1[count] = ivec1[ii] ; ivec2[count] = ivec2[ii] ; if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) { dvec[count] = dvec[ii] ; } else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) { dvec[2*count] = dvec[2*ii] ; dvec[2*count+1] = dvec[2*ii+1] ; } count++ ; } } } inpmtx->nent = count ; IV_setSize(&inpmtx->ivec1IV, count) ; IV_setSize(&inpmtx->ivec2IV, count) ; if ( INPMTX_IS_REAL_ENTRIES(inpmtx) || INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) { DV_setSize(&inpmtx->dvecDV, count) ; } return ; }