Example #1
0
/*
   -----------------------------------------------------------
   purpose -- for dense subrows, fill
     *pnrow      with # of rows
     *pnent      with # of matrix entries
     *pfirstlocs with firstlocs[nrow], column of first nonzero
     *psizes     with sizes[nrow], number of nonzero columns
     *pentries   with entries[nent], matrix entries

   created -- 98may01, cca
   -----------------------------------------------------------
*/
void
SubMtx_denseSubrowsInfo (
   SubMtx     *mtx,
   int        *pnrow,
   int        *pnent,
   int        **pfirstlocs,
   int        **psizes,
   double     **pentries
) {
double   *dbuffer ;
int      nint ;
int      *ibuffer ;
/*
   ---------------
   check the input
   ---------------
*/
if ( mtx == NULL || pnrow == NULL || pnent == NULL
   || pfirstlocs == NULL || psizes == NULL || pentries == NULL ) {
   fprintf(stderr, 
           "\n fatal error in SubMtx_denseSubrowsInfo(%p,%p,%p,%p,%p,%p)"
           "\n bad input\n",
           mtx, pnrow, pnent, pfirstlocs, psizes, pentries) ;
   if ( mtx != NULL ) {
      SubMtx_writeForHumanEye(mtx, stderr) ;
   }
   exit(-1) ;
}
if ( ! (SUBMTX_IS_REAL(mtx) || SUBMTX_IS_COMPLEX(mtx)) ) {
   fprintf(stderr, 
         "\n fatal error in SubMtx_denseSubrowsInfo(%p,%p,%p,%p,%p,%p)"
         "\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
         mtx, pnrow, pnent, pfirstlocs, psizes, pentries, mtx->type) ;
   exit(-1) ;
}
if ( ! SUBMTX_IS_DENSE_SUBROWS(mtx) ) {
   fprintf(stderr, 
         "\n fatal error in SubMtx_denseSubrowsInfo(%p,%p,%p,%p,%p,%p)"
         "\n bad mode %d"
         "\n must be SUBMTX_DENSE_SUBROWS\n",
         mtx, pnrow, pnent, pfirstlocs, psizes, pentries, mtx->mode) ;
   exit(-1) ;
}
*pnrow  = mtx->nrow ;
*pnent  = mtx->nent ;
dbuffer = mtx->wrkDV.vec ;
ibuffer = (int *) dbuffer ;
nint    = 7 + mtx->nrow + mtx->ncol ;
*pfirstlocs = ibuffer + nint ;
nint    += mtx->nrow ;
*psizes = ibuffer + nint ;
nint    += mtx->nrow ;
if ( sizeof(int) == sizeof(double) ) {
   *pentries = dbuffer + nint ;
} else if ( 2*sizeof(int) == sizeof(double) ) {
   *pentries = dbuffer + (nint+1)/2 ;
}

return ; }
Example #2
0
/*
   --------------------------------------------------
   purpose -- visit front J during the diagonal solve
 
   created -- 98feb20, cca
   --------------------------------------------------
*/
void
FrontMtx_diagonalVisit (
   FrontMtx   *frontmtx,
   int        J,
   int        owners[],
   int        myid,
   SubMtx     *p_mtx[],
   char       frontIsDone[],
   SubMtx     *p_agg[],
   int        msglvl,
   FILE       *msgFile
) {
if ( owners == NULL || owners[J] == myid ) {
   SubMtx   *BJ, *DJJ ;
 
   if ( (BJ = p_mtx[J]) != NULL ) {
      if ( msglvl > 3 ) {
         fprintf(msgFile, "\n\n BJ = %p", BJ) ;
         SubMtx_writeForHumanEye(BJ, msgFile) ;
         fflush(msgFile) ;
      }
      DJJ = FrontMtx_diagMtx(frontmtx, J) ;
      if ( msglvl > 3 ) {
         fprintf(msgFile, "\n\n DJJ = %p", DJJ) ;
         SubMtx_writeForHumanEye(DJJ, msgFile) ;
         fflush(msgFile) ;
      }
      SubMtx_solve(DJJ, BJ) ;
      if ( msglvl > 1 ) {
         fprintf(msgFile, "\n\n b_{%d,*} after diagonal solve", J) ;
         SubMtx_writeForHumanEye(BJ, msgFile) ;
         fflush(msgFile) ;
      }
      p_mtx[J] = NULL ;
      p_agg[J] = BJ   ;
   }
   frontIsDone[J] = 'Y' ;
}
return ; }
Example #3
0
/*
   ------------------------------------
   purpose -- compute any updates to ZJ

   created -- 98mar26, cca
   ------------------------------------
*/
static void
computeBackwardUpdates (
   FrontMtx   *frontmtx,
   SubMtx     *ZJ,
   int        J,
   IP         *heads[],
   char       frontIsDone[],
   SubMtx     *p_mtx[],
   int        msglvl,
   FILE       *msgFile
) {
SubMtx   *UJK, *XK ;
int    K ;
IP     *ip, *nextip ;
/*
   -------------------------------
   loop over the remaining updates
   -------------------------------
*/
for ( ip = heads[J], heads[J] = NULL ;
      ip != NULL ;
      ip = nextip ) {
   K = ip->val ; nextip = ip->next ;
   if ( msglvl > 3 ) {
      fprintf(msgFile,
              "\n\n frontIsDone[%d] = %c", K, frontIsDone[K]) ;
      fflush(msgFile) ;
   }
   if ( frontIsDone[K] == 'Y' ) {
      if ( (XK = p_mtx[K]) != NULL ) {
/*
         --------------------------------
         X_K exists and has been computed
         --------------------------------
*/
         if ( msglvl > 3 ) {
            fprintf(msgFile, "\n\n before solve: XK = %p", XK) ;
            SubMtx_writeForHumanEye(XK, msgFile) ;
            fflush(msgFile) ;
         }
         if ( (UJK = FrontMtx_upperMtx(frontmtx, J, K)) != NULL ) {
            if ( msglvl > 3 ) {
               fprintf(msgFile, "\n\n UJK = %p", UJK) ;
               SubMtx_writeForHumanEye(UJK, msgFile) ;
               fflush(msgFile) ;
            }
            SubMtx_solveupd(ZJ, UJK, XK) ;
         }
         if ( msglvl > 3 ) {
            fprintf(msgFile, "\n\n after update: ZJ = %p", ZJ) ;
            SubMtx_writeForHumanEye(ZJ, msgFile) ;
            fflush(msgFile) ;
         }
      }
   } else {
/*
      ------------------------
      X_K is not yet available
      ------------------------
*/
      ip->next = heads[J] ;
      heads[J] = ip ;
   }
}
return ; }
Example #4
0
/*
   --------------------------------------------------------
   purpose -- assemble any aggregates in the aggregate list

   created -- 98mar26, cca
   --------------------------------------------------------
*/
static void
assembleAggregates (
   int             J,
   SubMtx          *BJ,
   SubMtxList      *aggList,
   SubMtxManager   *mtxmanager,
   int             msglvl, 
   FILE            *msgFile
) {
SubMtx     *BJhat, *BJhead ;
double   *entBJ, *entBJhat ;
int      inc1, inc1hat, inc2, inc2hat, ncol, ncolhat, nrow, nrowhat ;
 
if ( BJ == NULL || aggList == NULL ) {
   fprintf(stderr,
          "\n fatal error in assembleAggregates()"
          "\n BJ = %p, aggList = %p", BJ, aggList) ;
   exit(-1) ;
}
if ( SubMtxList_isListNonempty(aggList, BJ->rowid) ) {
   if ( msglvl > 3 ) {
      fprintf(msgFile, "\n\n aggregate list is not-empty") ;
      fflush(msgFile) ;
   }
   SubMtx_denseInfo(BJ, &nrow, &ncol, &inc1, &inc2, &entBJ) ;
   if ( msglvl > 2 ) {
      fprintf(msgFile,
          "\n\n BJ(%d,%d) : nrow %d, ncol %d, inc1 %d, inc2 %d, ent %p",
          BJ->rowid, BJ->colid, nrow, ncol, inc1, inc2, entBJ) ;
      fflush(msgFile) ;
   }
   BJhead = SubMtxList_getList(aggList, J) ;
   for ( BJhat = BJhead ; BJhat != NULL ; BJhat = BJhat->next ) {
      if ( BJhat == NULL ) {
         fprintf(stderr,
                 "\n 3. fatal error in forwardVisit(%d)"
                 "\n BJhat = NULL", J) ;
         exit(-1) ;
      }
      SubMtx_denseInfo(BJhat, &nrowhat, &ncolhat, &inc1hat, &inc2hat,
                       &entBJhat) ;
      if ( msglvl > 2 ) {
         fprintf(msgFile,
         "\n BJhat(%d,%d) : nrow %d, ncol %d, inc1 %d, inc2 %d, ent %p",
           BJhat->rowid, BJhat->colid,
           nrowhat, ncolhat, inc1hat, inc2hat, entBJhat) ;
         fflush(msgFile) ;
      }
      if ( nrow != nrowhat || ncol != ncolhat
         || inc1 != inc1hat || inc2 != inc2hat || entBJhat == NULL ) {
         fprintf(stderr, "\n fatal error") ;
         exit(-1) ;
      }
      if ( msglvl > 3 ) {
         fprintf(msgFile, "\n\n BJ") ;
         SubMtx_writeForHumanEye(BJ, msgFile) ;
         fprintf(msgFile, "\n\n BJhat") ;
         SubMtx_writeForHumanEye(BJhat, msgFile) ;
         fflush(msgFile) ;
      }
      if ( SUBMTX_IS_REAL(BJhat) ) {
         DVadd(nrow*ncol, entBJ, entBJhat) ;
      } else if ( SUBMTX_IS_COMPLEX(BJhat) ) {
         DVadd(2*nrow*ncol, entBJ, entBJhat) ;
      }
   }
   SubMtxManager_releaseListOfObjects(mtxmanager, BJhead) ;
   if ( msglvl > 3 ) {
      fprintf(msgFile, "\n\n BJ after assembly") ;
      SubMtx_writeForHumanEye(BJ, msgFile) ;
      fflush(msgFile) ;
   }
}
return ; }
Example #5
0
/*
   ------------------------------------
   purpose -- compute any updates to BJ

   created -- 98mar26, cca
   ------------------------------------
*/
static void
computeForwardUpdates (
   FrontMtx   *frontmtx,
   SubMtx     *BJ,
   int        J,
   IP         *heads[],
   char       frontIsDone[],
   SubMtx     *p_mtx[],
   int        msglvl,
   FILE       *msgFile
) {
SubMtx   *LJI, *UIJ, *YI ;
int    I ;
IP     *ip, *nextip ;
/*
   -------------------------------
   loop over the remaining updates
   -------------------------------
*/
for ( ip = heads[J], heads[J] = NULL ;
      ip != NULL ;
      ip = nextip ) {
   I = ip->val ; nextip = ip->next ;
   if ( msglvl > 3 ) {
      fprintf(msgFile,
              "\n\n frontIsDone[%d] = %c, p_mtx[%d] = %p", 
              I, frontIsDone[I], I, p_mtx[I]) ;
      fflush(msgFile) ;
   }
   if ( frontIsDone[I] == 'Y' ) {
      if ( (YI = p_mtx[I]) != NULL ) {
/*
         --------------------------------
         Y_I exists and has been computed
         --------------------------------
*/
         if ( msglvl > 3 ) {
            fprintf(msgFile, "\n\n before solve: YI = %p", YI) ;
            SubMtx_writeForHumanEye(YI, msgFile) ;
            fflush(msgFile) ;
         }
         if ( FRONTMTX_IS_NONSYMMETRIC(frontmtx) ) {
            if ( (LJI = FrontMtx_lowerMtx(frontmtx, J, I)) != NULL ) {
               if ( msglvl > 3 ) {
                  fprintf(msgFile, "\n\n LJI = %p", LJI) ;
                  SubMtx_writeForHumanEye(LJI, msgFile) ;
                  fflush(msgFile) ;
               }
               SubMtx_solveupd(BJ, LJI, YI) ;
            }
         } else {
            if ( (UIJ = FrontMtx_upperMtx(frontmtx, I, J)) != NULL ) {
               if ( msglvl > 3 ) {
                  fprintf(msgFile, "\n\n UIJ = %p", UIJ) ;
                  SubMtx_writeForHumanEye(UIJ, msgFile) ;
                  fflush(msgFile) ;
               }
               if ( FRONTMTX_IS_SYMMETRIC(frontmtx) ) {
                  SubMtx_solveupdT(BJ, UIJ, YI) ;
               } else if ( FRONTMTX_IS_HERMITIAN(frontmtx) ) {
                  SubMtx_solveupdH(BJ, UIJ, YI) ;
               }
            }
         }
         if ( msglvl > 3 ) {
            fprintf(msgFile, "\n\n after update: BJ = %p", BJ) ;
            SubMtx_writeForHumanEye(BJ, msgFile) ;
            fflush(msgFile) ;
         }
      }
   } else {
/*
      ------------------------
      Y_I is not yet available
      ------------------------
*/
      ip->next = heads[J] ;
      heads[J] = ip ;
   }
}
return ; }
Example #6
0
/*
   ---------------------------------------------------
   purpose -- move the solution from the individual
     SubMtx objects into the global solution SubMtx object
 
   created -- 98feb20
   ---------------------------------------------------
*/
void
FrontMtx_storeSolution (
   FrontMtx        *frontmtx,
   int             owners[],
   int             myid,
   SubMtxManager   *manager,
   SubMtx          *p_mtx[],
   DenseMtx        *solmtx,
   int             msglvl,
   FILE            *msgFile
) {
char     localsol ;
SubMtx   *xmtxJ ;
double   *sol, *xJ ;
int      inc1, inc2, irow, jrhs, J, kk,
         ncolJ, neqns, nfront, nJ, nrhs, nrowInSol, nrowJ ;
int      *colindJ, *colmap, *rowind ;

if ( (nrowInSol = solmtx->nrow) != (neqns = frontmtx->neqns) ) {
/*
   --------------------------------------------------------------
   the solution matrix is only part of the total solution matrix.
   (this happens in an MPI environment where the rhs
   is partitioned among the processors.)
   create a map from the global row indices to the
   indices local to this solution matrix.
   --------------------------------------------------------------
*/
   colmap = IVinit(neqns, -1) ;
   rowind = solmtx->rowind ;
   if ( msglvl > 1 ) {
      fprintf(msgFile, "\n solmtx->rowind") ;
      IVfprintf(msgFile, solmtx->nrow, rowind) ;
      fflush(msgFile) ;
   }
   for ( irow = 0 ; irow < nrowInSol ; irow++ ) {
      colmap[rowind[irow]] = irow ;
   }
   localsol = 'T' ;
   if ( msglvl > 1 ) {
      fprintf(msgFile, "\n colmap") ;
      IVfprintf(msgFile, neqns, colmap) ;
      fflush(msgFile) ;
   }
} else {
   localsol = 'F' ;
}
DenseMtx_dimensions(solmtx, &neqns, &nrhs) ;
nfront = FrontMtx_nfront(frontmtx) ;
for ( J = 0 ; J < nfront ; J++ ) {
   if (  (owners == NULL || owners[J] == myid)
      && (nJ = FrontMtx_frontSize(frontmtx, J)) > 0 ) {
      FrontMtx_columnIndices(frontmtx, J, &ncolJ, &colindJ) ;
      xmtxJ = p_mtx[J] ;
      if ( xmtxJ == NULL ) {
         fprintf(stderr,
            "\n fatal error in storeSolution(%d)"
            "\n thread %d, xmtxJ = NULL", J, myid) ;
         exit(-1) ;
      }
      if ( msglvl > 1 ) {
         fprintf(msgFile, "\n storing solution for front %d", J) ;
         SubMtx_writeForHumanEye(xmtxJ, msgFile) ;
         fflush(msgFile) ;
      }
      if ( localsol == 'T' ) {
/*
        ------------------------------------------------------
         map the global row indices into the local row indices
        ------------------------------------------------------
*/
         if ( msglvl > 1 ) {
            fprintf(msgFile, "\n global row indices") ;
            IVfprintf(msgFile, nJ, colindJ) ;
            fflush(msgFile) ;
         }
         for ( irow = 0 ; irow < nJ ; irow++ ) {
            colindJ[irow] = colmap[colindJ[irow]] ;
         }
         if ( msglvl > 1 ) {
            fprintf(msgFile, "\n local row indices") ;
            IVfprintf(msgFile, nJ, colindJ) ;
            fflush(msgFile) ;
         }
      }
/*
      ----------------------------------
      store x_{J,*} into solution matrix
      ----------------------------------
*/
      sol = DenseMtx_entries(solmtx) ;
      SubMtx_denseInfo(xmtxJ, &nrowJ, &ncolJ, &inc1, &inc2, &xJ) ;
      if ( FRONTMTX_IS_REAL(frontmtx) ) {
         for ( jrhs = 0 ; jrhs < nrhs ; jrhs++ ) {
            for ( irow = 0 ; irow < nJ ; irow++ ) {
               kk = colindJ[irow] ;
               sol[kk] = xJ[irow] ;
            }
            sol += neqns ;
            xJ  += nJ ;
         }
      } else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
         for ( jrhs = 0 ; jrhs < nrhs ; jrhs++ ) {
            for ( irow = 0 ; irow < nJ ; irow++ ) {
               kk = colindJ[irow] ;
               sol[2*kk]   = xJ[2*irow]   ;
               sol[2*kk+1] = xJ[2*irow+1] ;
            }
            sol += 2*neqns ;
            xJ  += 2*nJ ;
         }
      }
/*
fprintf(msgFile, "\n solution for front %d stored", J) ;
*/
      SubMtxManager_releaseObject(manager, xmtxJ) ;
      if ( localsol == 'T' ) {
/*
        -----------------------------------------------------------
         map the local row indices back into the global row indices
        -----------------------------------------------------------
*/
         for ( irow = 0 ; irow < nJ ; irow++ ) {
            colindJ[irow] = rowind[colindJ[irow]] ;
         }
      }
   }
}
if ( localsol == 'T' ) {
   IVfree(colmap) ;
}
/*
fprintf(msgFile, "\n\n SOLUTION") ;
DenseMtx_writeForHumanEye(solmtx, msgFile) ;
*/

return ; }
Example #7
0
/*
   ---------------------------------------
   visit front J during the backward solve
 
   created -- 98mar27, cca
   ---------------------------------------
*/
void
FrontMtx_backwardVisit (
   FrontMtx        *frontmtx,
   int             J,
   int             nrhs,
   int             *owners,
   int             myid,
   SubMtxManager   *mtxmanager,
   SubMtxList      *aggList,
   SubMtx          *p_mtx[],
   char            frontIsDone[],
   IP              *heads[],
   SubMtx          *p_agg[],
   char            status[],
   int             msglvl,
   FILE            *msgFile
) {
char     aggDone, updDone ;
SubMtx     *UJJ, *ZJ ;
int      nJ ;
 
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n inside FrontMtx_backwardVisit(%d), nJ = %d",
           J, FrontMtx_frontSize(frontmtx, J)) ;
   fflush(msgFile) ;
}
if ( (nJ = FrontMtx_frontSize(frontmtx, J)) == 0 ) {
/*
   -----------------------------------------------------
   front has no eliminated rows or columns, quick return
   -----------------------------------------------------
*/
   if ( owners == NULL || owners[J] == myid ) {
      frontIsDone[J] = 'Y'  ;
   }
   status[J] = 'F' ;
   return ;
}
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n heads[%d] = %p", J, heads[J]) ;
   fflush(msgFile) ;
}
if ( heads[J] != NULL ) {
/*
   -------------------------------------
   there are internal updates to perform
   -------------------------------------
*/
   if ( (ZJ = p_agg[J]) == NULL ) {
/*
      ---------------------------
      create the aggregate object
      ---------------------------
*/
      ZJ = p_agg[J] = initBJ(frontmtx->type, J, nJ, nrhs, 
                             mtxmanager, msglvl, msgFile) ;
   }
   if ( msglvl > 3 ) {
      fprintf(msgFile, "\n\n ZJ = %p", ZJ) ;
      SubMtx_writeForHumanEye(ZJ, msgFile) ;
      fflush(msgFile) ;
   }
/*
   ---------------------------
   compute any waiting updates
   ---------------------------
*/
   computeBackwardUpdates(frontmtx, ZJ, J, heads, frontIsDone, p_mtx,
                          msglvl, msgFile) ;
}
if ( heads[J] == NULL ) {
   updDone = 'Y' ;
} else {
   updDone = 'N' ;
}
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n updDone = %c", updDone) ;
   fflush(msgFile) ;
}
if ( aggList != NULL && owners[J] == myid ) {
/*
   -----------------------
   assemble any aggregates
   -----------------------
*/
   aggDone = 'N' ;
   if ( (ZJ = p_agg[J]) == NULL ) {
      fprintf(stderr,
             "\n 2. fatal error in backwardVisit(%d), ZJ = NULL", J) ;
      exit(-1) ;
   }
   assembleAggregates(J, ZJ, aggList, mtxmanager, 
                             msglvl, msgFile) ;
   if ( SubMtxList_isCountZero(aggList, J) == 1 ) {
      if ( msglvl > 3 ) {
         fprintf(msgFile, "\n\n aggregate count is zero") ;
         fflush(msgFile) ;
      }
      assembleAggregates(J, ZJ, aggList, mtxmanager, 
                                msglvl, msgFile) ;
      aggDone = 'Y' ;
   }
} else {
   aggDone = 'Y' ;
}
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n aggDone = %c", aggDone) ;
   fflush(msgFile) ;
}
if ( updDone == 'Y' && aggDone == 'Y' ) {
   ZJ = p_agg[J] ;
   if ( owners == NULL || owners[J] == myid ) {
/*
      -------------------------------------
      owned front, ready for interior solve
      -------------------------------------
*/
      UJJ = FrontMtx_upperMtx(frontmtx, J, J) ;
      if ( UJJ != NULL ) {
         SubMtx_solve(UJJ, ZJ) ;
      }
      if ( msglvl > 1 ) {
         fprintf(msgFile, "\n\n after backward solve") ;
         SubMtx_writeForHumanEye(ZJ, msgFile) ;
         fflush(msgFile) ;
      }
/*
      ------------------------------------------------
      move YJ (stored in BJ) into p_mtx[],
      signal front as done, and set status to finished
      ------------------------------------------------
*/
      p_agg[J]       = NULL ;
      p_mtx[J]       = ZJ   ;
      frontIsDone[J] = 'Y'  ;
   } else if ( ZJ != NULL ) {
/*
      --------------------------------------
      unowned front, put into aggregate list
      --------------------------------------
*/
      SubMtxList_addObjectToList(aggList, ZJ, J) ;
      p_agg[J]  = NULL ;
   }
   status[J] = 'F'  ;
}
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n status[%d] = %c", J, status[J]) ;
   fflush(msgFile) ;
}
return ; }
Example #8
0
/*
   ----------------------------------------------------------------
   purpose -- for each L_{bnd{J},J} matrix, remove from hash table,
              split into their L_{K,J} submatrices and insert 
              into the hash table.

   created -- 98may04, cca
   ----------------------------------------------------------------
*/
void
FrontMtx_splitLowerMatrices (
   FrontMtx   *frontmtx,
   int         msglvl,
   FILE        *msgFile
) {
SubMtx          *mtxLJ, *mtxLJJ, *mtxLKJ ;
SubMtxManager   *manager ;
double        *entLJ, *entLKJ ;
int           count, first, ii, inc1, inc2, irow, jj, J, K, nbytes,
              ncolLJ, ncolLKJ, nentLJ, nentLKJ, neqns, nfront, nJ, 
              nrowJ, nrowLJ, nrowLKJ, offset, v ;
int           *colindLJ, *colindLKJ, *rowmap, *indicesLJ, *indicesLKJ, 
              *locmap, *rowindJ, *rowindLJ, *rowindLKJ, *sizesLJ, 
              *sizesLKJ ;
I2Ohash       *lowerhash ;
/*
   ---------------
   check the input
   ---------------
*/
if ( frontmtx == NULL || (msglvl > 0 && msgFile == NULL) ) {
   fprintf(stderr, 
           "\n fatal error in FrontMtx_splitLowerMatrices(%p,%d,%p)"
           "\n bad input\n", frontmtx, msglvl, msgFile) ;
   spoolesFatal();
}
nfront    = FrontMtx_nfront(frontmtx) ;
neqns     = FrontMtx_neqns(frontmtx) ;
lowerhash = frontmtx->lowerhash ;
manager   = frontmtx->manager   ;
/*
   --------------------------------
   construct the row and local maps
   --------------------------------
*/
rowmap = IVinit(neqns, -1) ;
locmap = IVinit(neqns, -1) ;
for ( J = 0 ; J < nfront ; J++ ) {
   if ( (nJ = FrontMtx_frontSize(frontmtx, J)) > 0 ) {
      FrontMtx_rowIndices(frontmtx, J, &nrowJ, &rowindJ) ;
      if ( nrowJ > 0 && rowindJ != NULL ) {
         for ( ii = 0 ; ii < nJ ; ii++ ) {
            v = rowindJ[ii] ;
            rowmap[v] = J ;
            locmap[v] = ii ;
         } 
      }
   }
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n rowmap[]") ;
   IVfprintf(msgFile, neqns, rowmap) ;
   fprintf(msgFile, "\n\n locmap[]") ;
   IVfprintf(msgFile, neqns, locmap) ;
   fflush(msgFile) ;
}
/*
   ---------------------------------------------
   move the L_{J,J} matrices into the hash table
   ---------------------------------------------
*/
for ( J = 0 ; J < nfront ; J++ ) {
   if ( (mtxLJJ = FrontMtx_lowerMtx(frontmtx, J, J)) != NULL ) {
      I2Ohash_insert(frontmtx->lowerhash, J, J, mtxLJJ) ;
   }
}
/*
   ------------------------------------------------------------
   now split the L_{bnd{J},J} matrices into L_{K,J} matrices.
   note: columns of L_{bnd{J},J} are assumed to be in ascending
   order with respect to the column ordering of the matrix.
   ------------------------------------------------------------
*/
for ( J = 0 ; J < nfront ; J++ ) {
   mtxLJ = FrontMtx_lowerMtx(frontmtx, nfront, J) ;
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n\n ### J = %d, mtxLJ = %p", J, mtxLJ) ;
      fflush(msgFile) ;
   }
   if ( mtxLJ != NULL ) {
      if ( msglvl > 2 ) {
         SubMtx_writeForHumanEye(mtxLJ, msgFile) ;
         fflush(msgFile) ;
      }
      SubMtx_columnIndices(mtxLJ, &ncolLJ, &colindLJ) ;
      SubMtx_rowIndices(mtxLJ, &nrowLJ, &rowindLJ) ;
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n  column indices for J") ;
         IVfprintf(msgFile, ncolLJ, colindLJ) ;
         fprintf(msgFile, "\n  row indices for LJ") ;
         IVfprintf(msgFile, nrowLJ, rowindLJ) ;
         fflush(msgFile) ;
      }
      if ( (K = rowmap[rowindLJ[0]]) == rowmap[rowindLJ[nrowLJ-1]] ) {
         if ( msglvl > 2 ) {
            fprintf(msgFile, "\n  front %d supports only %d", J, K) ;
            fflush(msgFile) ;
         }
/*
         -------------------------------------------------
         L_{bnd{J},J} is one submatrix, bnd{J} \subseteq K
         set row and column indices and change column id
         -------------------------------------------------
*/
         IVramp(ncolLJ, colindLJ, 0, 1) ;
         for ( ii = 0 ; ii < nrowLJ ; ii++ ) {
            rowindLJ[ii] = locmap[rowindLJ[ii]] ;
         }
/*
         mtxLJ->rowid = K ;
*/
         SubMtx_setFields(mtxLJ, mtxLJ->type, mtxLJ->mode, K, J,
                          mtxLJ->nrow, mtxLJ->ncol, mtxLJ->nent) ;
         if ( msglvl > 2 ) {
            fprintf(msgFile, "\n\n ##  inserting L(%d,%d) ", K, J) ;
            SubMtx_writeForHumanEye(mtxLJ, msgFile) ;
            fflush(msgFile) ;
         }
         I2Ohash_insert(lowerhash, K, J, (void *) mtxLJ) ;
      } else {
/*
         -----------------------------------
         split L_{bnd{J},J} into submatrices
         -----------------------------------
*/
         nJ = FrontMtx_frontSize(frontmtx, J) ;
         if ( SUBMTX_IS_DENSE_ROWS(mtxLJ) ) {
            SubMtx_denseInfo(mtxLJ, 
                           &nrowLJ, &ncolLJ, &inc1, &inc2, &entLJ) ;
         } else if ( SUBMTX_IS_SPARSE_ROWS(mtxLJ) ) {
            SubMtx_sparseRowsInfo(mtxLJ, &nrowLJ, &nentLJ, 
                                &sizesLJ, &indicesLJ, &entLJ) ;
            offset = 0 ;
            count  = sizesLJ[0] ;
         }
         first = 0 ;
         K = rowmap[rowindLJ[0]] ;
         for ( irow = 1 ; irow <= nrowLJ ; irow++ ) {
            if ( msglvl > 2 ) {
               fprintf(msgFile, "\n irow = %d", irow) ;
               if ( irow < nrowLJ ) {
                  fprintf(msgFile, ", rowmap[%d] = %d", 
                          rowindLJ[irow], rowmap[rowindLJ[irow]]);
               }
               fflush(msgFile) ;
            }
            if ( irow == nrowLJ || K != rowmap[rowindLJ[irow]] ) {
               nrowLKJ = irow - first ;
               if ( SUBMTX_IS_DENSE_ROWS(mtxLJ) ) {
                  nentLKJ = nJ*nrowLKJ ;
               } else if ( SUBMTX_IS_SPARSE_ROWS(mtxLJ) ) {
                  if ( count == 0 ) {
                     goto no_entries ;
                  }
                  nentLKJ = count ;
               }
               nbytes = SubMtx_nbytesNeeded(mtxLJ->type, mtxLJ->mode,
                                            nrowLKJ, nJ, nentLKJ) ;
               mtxLKJ = SubMtxManager_newObjectOfSizeNbytes(manager, 
                                                          nbytes) ;
               SubMtx_init(mtxLKJ, mtxLJ->type, mtxLJ->mode, K, J,
                         nrowLKJ, nJ, nentLKJ) ;
               if ( SUBMTX_IS_DENSE_ROWS(mtxLJ) ) {
                  SubMtx_denseInfo(mtxLKJ, 
                         &nrowLKJ, &ncolLKJ, &inc1, &inc2, &entLKJ) ;
                  if ( FRONTMTX_IS_REAL(frontmtx) ) {
                     DVcopy(nentLKJ, entLKJ, entLJ + first*nJ) ;
                  } else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
                     DVcopy(2*nentLKJ, entLKJ, entLJ + 2*first*nJ) ;
                  }
               } else if ( SUBMTX_IS_SPARSE_ROWS(mtxLJ) ) {
                  SubMtx_sparseRowsInfo(mtxLKJ, &nrowLKJ, &nentLKJ, 
                                      &sizesLKJ, &indicesLKJ, &entLKJ) ;
                  IVcopy(nrowLKJ, sizesLKJ, sizesLJ + first) ;
                  IVcopy(nentLKJ, indicesLKJ, indicesLJ + offset) ;
                  if ( FRONTMTX_IS_REAL(frontmtx) ) {
                     DVcopy(nentLKJ, entLKJ, entLJ + offset) ;
                  } else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
                     DVcopy(2*nentLKJ, entLKJ, entLJ + 2*offset) ;
                  }
                  count  =  0 ;
                  offset += nentLKJ ;
               }
/*
               -------------------------------------
               initialize the row and column indices
               -------------------------------------
*/
               SubMtx_rowIndices(mtxLKJ, &nrowLKJ, &rowindLKJ) ;
               for ( ii = 0, jj = first ; ii < nrowLKJ ; ii++, jj++ ) {
                  rowindLKJ[ii] = locmap[rowindLJ[jj]] ;
               }
               SubMtx_columnIndices(mtxLKJ, &ncolLKJ, &colindLKJ) ;
               IVramp(ncolLKJ, colindLKJ, 0, 1) ;
/*
               ----------------------------------
               insert L_{K,J} into the hash table
               ----------------------------------
*/
               if ( msglvl > 2 ) {
                   fprintf(msgFile, 
                           "\n\n ##  inserting L(%d,%d) ", K, J) ;
                   SubMtx_writeForHumanEye(mtxLKJ, msgFile) ;
                   fflush(msgFile) ;
               }
               I2Ohash_insert(lowerhash, K, J, (void *) mtxLKJ) ;
/*
               -----------------------------------
               we jump to here if there were no
               entries to be stored in the matrix.
               -----------------------------------
*/
   no_entries :
/*
               ----------------------------------------------------
               reset first and K to new first location and front id
               ----------------------------------------------------
*/
               first = irow ;
               if ( irow < nrowLJ ) {
                  K = rowmap[rowindLJ[irow]] ;
               }
            } 
            if ( irow < nrowLJ && SUBMTX_IS_SPARSE_ROWS(mtxLJ) ) {
               count += sizesLJ[irow] ;
            }
         }
/*
         --------------------------------------------
         give L_{bnd{J},J} back to the matrix manager
         --------------------------------------------
*/
         SubMtxManager_releaseObject(manager, mtxLJ) ;
      }
   }
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
IVfree(rowmap) ;
IVfree(locmap) ;

return ; }
Example #9
0
/*
   ----------------------------------------------------------------
   purpose -- for each U_{J,bnd{J}} matrix, remove from hash table,
              split into their U_{J,K} submatrices and insert 
              into the hash table.

   created -- 98may04, cca
   ----------------------------------------------------------------
*/
void
FrontMtx_splitUpperMatrices (
   FrontMtx   *frontmtx,
   int        msglvl,
   FILE       *msgFile
) {
SubMtx          *mtxUJ, *mtxUJJ, *mtxUJK ;
SubMtxManager   *manager ;
double          *entUJ, *entUJK ;
int             count, first, ii, inc1, inc2, jcol, jj, J, K, nbytes,
                ncolJ, ncolUJ, ncolUJK, nentUJ, nentUJK, neqns, nfront, 
                nJ, nrowUJ, nrowUJK, offset, v ;
int             *colindJ, *colindUJ, *colindUJK, *colmap, *indicesUJ,
                *indicesUJK, *locmap, *rowindUJ, *rowindUJK, *sizesUJ, 
                *sizesUJK ;
I2Ohash         *upperhash ;
/*
   ---------------
   check the input
   ---------------
*/
if ( frontmtx == NULL || (msglvl > 0 && msgFile == NULL) ) {
   fprintf(stderr, 
           "\n fatal error in FrontMtx_splitUpperMatrices(%p,%d,%p)"
           "\n bad input\n", frontmtx, msglvl, msgFile) ;
   spoolesFatal();
}
nfront    = FrontMtx_nfront(frontmtx) ;
neqns     = FrontMtx_neqns(frontmtx) ;
upperhash = frontmtx->upperhash ;
manager   = frontmtx->manager   ;
/*
   -----------------------------------
   construct the column and local maps
   -----------------------------------
*/
colmap = IVinit(neqns, -1) ;
locmap = IVinit(neqns, -1) ;
for ( J = 0 ; J < nfront ; J++ ) {
   if ( (nJ = FrontMtx_frontSize(frontmtx, J)) > 0 ) {
      FrontMtx_columnIndices(frontmtx, J, &ncolJ, &colindJ) ;
      if ( ncolJ > 0 && colindJ != NULL ) {
         for ( ii = 0 ; ii < nJ ; ii++ ) {
            v = colindJ[ii] ;
            colmap[v] = J ;
            locmap[v] = ii ;
         } 
      }
   }
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n colmap[]") ;
   IVfprintf(msgFile, neqns, colmap) ;
   fprintf(msgFile, "\n\n locmap[]") ;
   IVfprintf(msgFile, neqns, locmap) ;
   fflush(msgFile) ;
}
/*
   ---------------------------------------------
   move the U_{J,J} matrices into the hash table
   ---------------------------------------------
*/
for ( J = 0 ; J < nfront ; J++ ) {
   if ( (mtxUJJ = FrontMtx_upperMtx(frontmtx, J, J)) != NULL ) {
      I2Ohash_insert(frontmtx->upperhash, J, J, mtxUJJ) ;
   }
}
/*
   ------------------------------------------------------------
   now split the U_{J,bnd{J}} matrices into U_{J,K} matrices.
   note: columns of U_{J,bnd{J}} are assumed to be in ascending
   order with respect to the column ordering of the matrix.
   ------------------------------------------------------------
*/
for ( J = 0 ; J < nfront ; J++ ) {
   mtxUJ = FrontMtx_upperMtx(frontmtx, J, nfront) ;
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n\n ### J = %d, mtxUJ = %p", J, mtxUJ) ;
      fflush(msgFile) ;
   }
   if ( mtxUJ != NULL ) {
      if ( msglvl > 2 ) {
         SubMtx_writeForHumanEye(mtxUJ, msgFile) ;
         fflush(msgFile) ;
      }
      SubMtx_columnIndices(mtxUJ, &ncolUJ, &colindUJ) ;
      SubMtx_rowIndices(mtxUJ, &nrowUJ, &rowindUJ) ;
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n  column indices for J") ;
         IVfprintf(msgFile, ncolUJ, colindUJ) ;
         fprintf(msgFile, "\n  row indices for UJ") ;
         IVfprintf(msgFile, nrowUJ, rowindUJ) ;
         fflush(msgFile) ;
      }
      if ( (K = colmap[colindUJ[0]]) == colmap[colindUJ[ncolUJ-1]] ) {
         if ( msglvl > 2 ) {
            fprintf(msgFile, "\n  front %d supports only %d", J, K) ;
            fflush(msgFile) ;
         }
/*
         -------------------------------------------------
         U_{J,bnd{J}} is one submatrix, bnd{J} \subseteq K
         set row and column indices and change column id
         -------------------------------------------------
*/
         IVramp(nrowUJ, rowindUJ, 0, 1) ;
         for ( ii = 0 ; ii < ncolUJ ; ii++ ) {
            colindUJ[ii] = locmap[colindUJ[ii]] ;
         }
         SubMtx_setFields(mtxUJ, mtxUJ->type, mtxUJ->mode, J, K,
                          mtxUJ->nrow, mtxUJ->ncol, mtxUJ->nent) ;
/*
         mtxUJ->colid = K ;
*/
         if ( msglvl > 2 ) {
            fprintf(msgFile, "\n\n ##  inserting U(%d,%d) ", J, K) ;
            SubMtx_writeForHumanEye(mtxUJ, msgFile) ;
            fflush(msgFile) ;
         }
         I2Ohash_insert(upperhash, J, K, (void *) mtxUJ) ;
      } else {
/*
         -----------------------------------
         split U_{J,bnd{J}} into submatrices
         -----------------------------------
*/
         nJ = FrontMtx_frontSize(frontmtx, J) ;
         if ( SUBMTX_IS_DENSE_COLUMNS(mtxUJ) ) {
            SubMtx_denseInfo(mtxUJ, 
                           &nrowUJ, &ncolUJ, &inc1, &inc2, &entUJ) ;
         } else if ( SUBMTX_IS_SPARSE_COLUMNS(mtxUJ) ) {
            SubMtx_sparseColumnsInfo(mtxUJ, &ncolUJ, &nentUJ, 
                                   &sizesUJ, &indicesUJ, &entUJ) ;
            offset = 0 ;
            count  = sizesUJ[0] ;
         }
         first = 0 ;
         K = colmap[colindUJ[0]] ;
         for ( jcol = 1 ; jcol <= ncolUJ ; jcol++ ) {
            if ( msglvl > 2 ) {
               fprintf(msgFile, "\n jcol = %d", jcol) ;
               if ( jcol < ncolUJ ) {
                  fprintf(msgFile, ", colmap[%d] = %d", 
                          colindUJ[jcol], colmap[colindUJ[jcol]]);
               }
               fflush(msgFile) ;
            }
            if ( jcol == ncolUJ || K != colmap[colindUJ[jcol]] ) {
               ncolUJK = jcol - first ;
               if ( SUBMTX_IS_DENSE_COLUMNS(mtxUJ) ) {
                  nentUJK = nJ*ncolUJK ;
               } else if ( SUBMTX_IS_SPARSE_COLUMNS(mtxUJ) ) {
                  if ( count == 0 ) {
                     goto no_entries ;
                  }
                  nentUJK = count ;
               }
               nbytes = SubMtx_nbytesNeeded(mtxUJ->type, mtxUJ->mode,
                                            nJ, ncolUJK, nentUJK) ;
               if ( msglvl > 2 ) {
                  fprintf(msgFile, 
                          "\n ncolUJK %d, nentUJK %d, nbytes %d",
                          ncolUJK, nentUJK, nbytes) ;
                  fflush(msgFile) ;
               }
               mtxUJK = SubMtxManager_newObjectOfSizeNbytes(manager, 
                                                          nbytes) ;
               SubMtx_init(mtxUJK, mtxUJ->type, mtxUJ->mode, J, K,
                         nJ, ncolUJK, nentUJK) ;
               if ( SUBMTX_IS_DENSE_COLUMNS(mtxUJ) ) {
                  SubMtx_denseInfo(mtxUJK, 
                         &nrowUJK, &ncolUJK, &inc1, &inc2, &entUJK) ;
                  if ( FRONTMTX_IS_REAL(frontmtx) ) {
                     DVcopy(nentUJK, entUJK, entUJ + first*nJ) ;
                  } else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
                     DVcopy(2*nentUJK, entUJK, entUJ + 2*first*nJ) ;
                  }
               } else if ( SUBMTX_IS_SPARSE_COLUMNS(mtxUJ) ) {
                  SubMtx_sparseColumnsInfo(mtxUJK, &ncolUJK, &nentUJK, 
                                   &sizesUJK, &indicesUJK, &entUJK) ;
                  IVcopy(ncolUJK, sizesUJK, sizesUJ + first) ;
                  IVcopy(nentUJK, indicesUJK, indicesUJ + offset) ;
                  if ( FRONTMTX_IS_REAL(frontmtx) ) {
                     DVcopy(nentUJK, entUJK, entUJ + offset) ;
                  } else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
                     DVcopy(2*nentUJK, entUJK, entUJ + 2*offset) ;
                  }
                  count  =  0 ;
                  offset += nentUJK ;
               }
/*
               -------------------------------------
               initialize the row and column indices
               -------------------------------------
*/
               if ( msglvl > 2 ) {
                  fprintf(msgFile, "\n setting row and column indices");
                  fflush(msgFile) ;
               }
               SubMtx_rowIndices(mtxUJK, &nrowUJK, &rowindUJK) ;
               IVramp(nJ, rowindUJK, 0, 1) ;
               SubMtx_columnIndices(mtxUJK, &ncolUJK, &colindUJK) ;
               for ( ii = 0, jj = first ; ii < ncolUJK ; ii++, jj++ ) {
                  colindUJK[ii] = locmap[colindUJ[jj]] ;
               }
/*
               ----------------------------------
               insert U_{J,K} into the hash table
               ----------------------------------
*/
               if ( msglvl > 2 ) {
                   fprintf(msgFile, 
                           "\n\n ##  inserting U(%d,%d) ", J, K) ;
                   SubMtx_writeForHumanEye(mtxUJK, msgFile) ;
                   fflush(msgFile) ;
               }
               I2Ohash_insert(upperhash, J, K, (void *) mtxUJK) ;
/*
               -----------------------------------
               we jump to here if there were no
               entries to be stored in the matrix.
               -----------------------------------
*/
   no_entries :
/*
               ----------------------------------------------------
               reset first and K to new first location and front id
               ----------------------------------------------------
*/
               first = jcol ;
               if ( jcol < ncolUJ ) {
                  K = colmap[colindUJ[jcol]] ;
               }
            } 
            if ( jcol < ncolUJ && SUBMTX_IS_SPARSE_COLUMNS(mtxUJ) ) {
               count += sizesUJ[jcol] ;
            }
         }
/*
         --------------------------------------------
         give U_{J,bnd{J}} back to the matrix manager
         --------------------------------------------
*/
         SubMtxManager_releaseObject(manager, mtxUJ) ;
      }
   }
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
IVfree(colmap) ;
IVfree(locmap) ;

return ; }
Example #10
0
/*
   ----------------------------------------------------
   store the factor entries of the reduced front matrix

   created -- 98may25, cca
   ----------------------------------------------------
*/
void
FrontMtx_QR_storeFront (
   FrontMtx   *frontmtx,
   int        J,
   A2         *frontJ,
   int        msglvl,
   FILE       *msgFile
) {
A2       tempA2 ;
double   fac, ifac, imag, real, rfac ;
double   *entDJJ, *entUJJ, *entUJN, *row ;
int      inc1, inc2, irow, jcol, ncol, ncolJ, nD, nentD, nentUJJ, 
         nfront, nrow, nU ;
int      *colind, *colindJ, *firstlocs, *sizes ;
SubMtx   *mtx ;
/*
   ---------------
   check the input
   ---------------
*/
if (  frontmtx == NULL || frontJ == NULL
   || (msglvl > 0 && msgFile == NULL) ) {
   fprintf(stderr, "\n fatal error in FrontMtx_QR_storeFront()"
           "\n bad input\n") ;
   exit(-1) ;
}
nfront = FrontMtx_nfront(frontmtx) ;
FrontMtx_columnIndices(frontmtx, J, &ncolJ, &colindJ) ;
nrow   = A2_nrow(frontJ) ;
ncol   = A2_ncol(frontJ) ;
A2_setDefaultFields(&tempA2) ;
nD = FrontMtx_frontSize(frontmtx, J) ;
nU = ncol - nD ;
/*
   --------------------------------------
   scale the rows and square the diagonal
   --------------------------------------
*/
row = A2_entries(frontJ) ;
if ( A2_IS_REAL(frontJ) ) {
   for ( irow = 0 ; irow < nD ; irow++ ) {
      if ( row[irow] != 0.0 ) {
         fac = 1./row[irow] ;
         for ( jcol = irow + 1 ; jcol < ncol ; jcol++ ) {
            row[jcol] *= fac ;
         }
         row[irow] = row[irow] * row[irow] ;
      }
      row += ncol ;
   }
} else if ( A2_IS_COMPLEX(frontJ) ) {
   for ( irow = 0 ; irow < nD ; irow++ ) {
      real = row[2*irow] ; imag = row[2*irow+1] ;
      if (  real != 0.0 || imag != 0.0 ) {
         Zrecip(real, imag, &rfac, &ifac) ;
         ZVscale(ncol - irow - 1, & row[2*irow+2], rfac, ifac) ;
         row[2*irow]   = real*real + imag*imag ;
         row[2*irow+1] = 0.0 ;
      }
      row += 2*ncol ;
   }
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n after scaling rows of A") ;
   A2_writeForHumanEye(frontJ, msgFile) ;
   fflush(msgFile) ;
}
/*
   -------------------------
   copy the diagonal entries
   -------------------------
*/
mtx = FrontMtx_diagMtx(frontmtx, J) ;
SubMtx_diagonalInfo(mtx, &nentD, &entDJJ) ;
A2_subA2(&tempA2, frontJ, 0, nD-1, 0, nD-1) ;
A2_copyEntriesToVector(&tempA2, nentD, entDJJ, 
                       A2_DIAGONAL, A2_BY_ROWS) ;
SubMtx_columnIndices(mtx, &ncol, &colind) ;
IVcopy(nD, colind, colindJ) ;
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n diagonal factor matrix") ;
   SubMtx_writeForHumanEye(mtx, msgFile) ;
   fflush(msgFile) ;
}
if ( (mtx = FrontMtx_upperMtx(frontmtx, J, J)) != NULL ) {
/*
   ------------------------
   copy the U_{J,J} entries
   ------------------------
*/
   SubMtx_denseSubcolumnsInfo(mtx, &nD, &nentUJJ, 
                           &firstlocs, &sizes, &entUJJ) ;
   A2_copyEntriesToVector(&tempA2, nentUJJ, entUJJ, 
                          A2_STRICT_UPPER, A2_BY_COLUMNS) ;
   SubMtx_columnIndices(mtx, &ncol, &colind) ;
   IVcopy(nD, colind, colindJ) ;
   if ( msglvl > 3 ) {
      fprintf(msgFile, "\n UJJ factor matrix") ;
      SubMtx_writeForHumanEye(mtx, msgFile) ;
      fflush(msgFile) ;
   }
}
if ( ncolJ > nD ) {
/*
   -----------------------------
   copy the U_{J,bnd{J}} entries
   -----------------------------
*/
   mtx = FrontMtx_upperMtx(frontmtx, J, nfront) ;
   SubMtx_denseInfo(mtx, &nD, &nU, &inc1, &inc2, &entUJN) ;
   A2_subA2(&tempA2, frontJ, 0, nD-1, nD, ncolJ-1) ;
   A2_copyEntriesToVector(&tempA2, nD*nU, entUJN, 
                          A2_ALL_ENTRIES, A2_BY_COLUMNS) ;
   SubMtx_columnIndices(mtx, &ncol, &colind) ;
   IVcopy(nU, colind, colindJ + nD) ;
   if ( msglvl > 3 ) {
      fprintf(msgFile, "\n UJN factor matrix") ;
      SubMtx_writeForHumanEye(mtx, msgFile) ;
      fflush(msgFile) ;
   }
}
return ; }
Example #11
0
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ------------------------------------------------------
   test SubMtx_readFromFile and SubMtx_writeToFile,
   useful for translating between formatted *.submtxf
   and binary *.submtxb files.

   created -- 98may04, cca
   ------------------------------------------------------
*/
{
char       *inSubMtxFileName, *matlabFileName, *outSubMtxFileName ;
double     t1, t2 ;
int        msglvl, rc ;
SubMtx     *mtx ;
FILE       *fp, *msgFile ;

if ( argc != 6 ) {
   fprintf(stdout, 
     "\n\n usage : %s msglvl msgFile inFile outFile matlabFile"
     "\n    msglvl     -- message level"
     "\n    msgFile    -- message file"
     "\n    inFile     -- input file, must be *.dmtxf or *.dmtxb"
     "\n    outFile    -- output file, must be *.dmtxf or *.dmtxb"
     "\n    matlabFile -- output file, must be *.m"
     "\n", argv[0]) ;
   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) ;
}
inSubMtxFileName  = argv[3] ;
outSubMtxFileName = argv[4] ;
matlabFileName      = argv[5] ;
fprintf(msgFile, 
        "\n %s "
        "\n msglvl     -- %d" 
        "\n msgFile    -- %s" 
        "\n inFile     -- %s" 
        "\n outFile    -- %s" 
        "\n matlabFile -- %s" 
        "\n",
        argv[0], msglvl, argv[2], 
        inSubMtxFileName, outSubMtxFileName, matlabFileName) ;
fflush(msgFile) ;
/*
   ----------------------------
   read in the SubMtx object
   ----------------------------
*/
if ( strcmp(inSubMtxFileName, "none") == 0 ) { fprintf(msgFile, "\n no file to read from") ;
   spoolesFatal();
}
mtx = SubMtx_new() ;
MARKTIME(t1) ;
rc = SubMtx_readFromFile(mtx, inSubMtxFileName) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %9.5f : read in dmtx from file %s",
        t2 - t1, inSubMtxFileName) ;
if ( rc != 1 ) {
   fprintf(msgFile, 
           "\n return value %d from SubMtx_readFromFile(%p,%s)",
           rc, mtx, inSubMtxFileName) ;
   spoolesFatal();
}
fprintf(msgFile, "\n\n after reading SubMtx object from file %s",
        inSubMtxFileName) ;
fflush(msgFile) ;
if ( msglvl > 2 ) {
   SubMtx_writeForHumanEye(mtx, msgFile) ;
} else {
   SubMtx_writeStats(mtx, msgFile) ;
}
fflush(msgFile) ;
/*
   ----------------------------------------------
   hack to convert from row major to column major
   ----------------------------------------------
*/
/*
{
SubMtx   *mtx2 ;
double   *ent1, *ent2, *pXij, *pYij ;
int      *colind, *colind2, *rowind, *rowind2 ;
int      inc1, inc2, irow, jcol, ncol, nrow ;

mtx2 = SubMtx_new() ;
SubMtx_init(mtx2, DMTX_DENSE_COLUMNS, 0, 0, 
          mtx->nrow, mtx->ncol, mtx->nent) ;
SubMtx_denseInfo(mtx, &nrow, &ncol, &inc1, &inc2, &ent1) ;
SubMtx_denseInfo(mtx2, &nrow, &ncol, &inc1, &inc2, &ent2) ;
SubMtx_rowIndices(mtx, &nrow, &rowind) ;
SubMtx_rowIndices(mtx2, &nrow, &rowind2) ;
IVcopy(nrow, rowind2, rowind) ;
SubMtx_columnIndices(mtx, &ncol, &colind) ;
SubMtx_columnIndices(mtx2, &ncol, &colind2) ;
IVcopy(ncol, colind2, colind) ;
for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
   for ( irow = 0 ; irow < nrow ; irow++ ) {
      pXij = SubMtx_locationOfEntry(mtx,  irow, jcol) ;
      pYij = SubMtx_locationOfEntry(mtx2, irow, jcol) ;
      *pYij = *pXij ;
   }
}
SubMtx_free(mtx) ;
mtx = mtx2 ;
}
*/
/*
   ----------------------------
   write out the SubMtx object
   ----------------------------
*/
if ( strcmp(outSubMtxFileName, "none") != 0 ) {
   MARKTIME(t1) ;
   rc = SubMtx_writeToFile(mtx, outSubMtxFileName) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n CPU %9.5f : write mtx to file %s",
           t2 - t1, outSubMtxFileName) ;
}
if ( rc != 1 ) {
   fprintf(msgFile, 
           "\n return value %d from SubMtx_writeToFile(%p,%s)",
           rc, mtx, outSubMtxFileName) ;
}
/*
   ----------------------------------------------
   write out the SubMtx object to a matlab file
   ----------------------------------------------
*/
if ( strcmp(matlabFileName, "none") != 0 ) {
   if ( (fp = fopen(matlabFileName, "a")) == NULL ) {
      fprintf(stderr, "\n fatal error in %s"
              "\n unable to open file %s\n",
              argv[0], matlabFileName) ;
      return(-1) ;
   }
   MARKTIME(t1) ;
   SubMtx_writeForMatlab(mtx, "rhs", fp) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n CPU %9.5f : write mtx to file %s",
           t2 - t1, matlabFileName) ;
}
/*
   -------------------------
   free the SubMtx object
   -------------------------
*/
SubMtx_free(mtx) ;

fprintf(msgFile, "\n") ;
fclose(msgFile) ;

return(1) ; }