Beispiel #1
0
/*
   ------------------------------------------------------
   create and return a subtree metric DV object
   input  : vmetricDV -- a metric defined on the vertices
   return : tmetricDV -- a metric defined on the subtrees
  
   created -- 96jun23, cca
   ------------------------------------------------------
*/
DV *
Tree_setSubtreeDmetric (
   Tree   *tree,
   DV     *vmetricDV
) {
int      u, v ;
double   *tmetric, *vmetric ;
DV    *tmetricDV ;
/*
   ---------------
   check the input
   ---------------
*/
if (  tree == NULL || tree->n <= 0 
   || vmetricDV == NULL 
   || tree->n != DV_size(vmetricDV) 
   || (vmetric = DV_entries(vmetricDV)) == NULL ) {
   fprintf(stderr, "\n fatal error in Tree_setSubtreeImetric(%p,%p)"
           "\n bad input\n", tree, vmetricDV) ;
   exit(-1) ;
}
tmetricDV = DV_new() ;
DV_init(tmetricDV, tree->n, NULL) ;
tmetric = DV_entries(tmetricDV) ;
for ( v = Tree_postOTfirst(tree) ; 
      v != -1 ; 
      v = Tree_postOTnext(tree, v) ) {
   tmetric[v] = vmetric[v] ;
   for ( u = tree->fch[v] ; u != -1 ; u = tree->sib[u] ) {
      tmetric[v] += tmetric[u] ;
   }
}
return(tmetricDV) ; }
Beispiel #2
0
/*
   --------------------------------------------------------------------
   inputComplex a number of (row,column, entry) triples into the matrix

   created -- 98jan28, cca
   --------------------------------------------------------------------
*/
static void
inputTriples (
   InpMtx   *inpmtx,
   int       ntriples,
   int       rowids[],
   int       colids[],
   double    entries[]
) {
int      nent ;
int      *ivec1, *ivec2 ;

prepareToAddNewEntries(inpmtx, ntriples) ;
nent  = inpmtx->nent ;
ivec1 = IV_entries(&inpmtx->ivec1IV) ;
ivec2 = IV_entries(&inpmtx->ivec2IV) ;
IVcopy(ntriples, ivec1 + nent, rowids) ;
IVcopy(ntriples, ivec2 + nent, colids) ;
IV_setSize(&inpmtx->ivec1IV, nent + ntriples) ;
IV_setSize(&inpmtx->ivec2IV, nent + ntriples) ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   double   *dvec = DV_entries(&inpmtx->dvecDV) ;
   DVcopy(ntriples, dvec + nent, entries) ;
   DV_setSize(&inpmtx->dvecDV,  nent + ntriples) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   double   *dvec = DV_entries(&inpmtx->dvecDV) ;
   ZVcopy(ntriples, dvec + 2*nent, entries) ;
   DV_setSize(&inpmtx->dvecDV,  2*(nent + ntriples)) ;
}
inpmtx->nent += ntriples ;
inpmtx->storageMode = INPMTX_RAW_DATA ;

return ; }
Beispiel #3
0
/*
   ------------------------------------------------------------
   create and return a depth metric DV object
   input  : vmetricDV -- a metric defined on the vertices
   output : dmetricDV -- a depth metric defined on the vertices
 
   dmetric[u] = vmetric[u] + dmetric[par[u]] if par[u] != -1
              = vmetric[u]                   if par[u] == -1

   created -- 96jun23, cca
   ------------------------------------------------------------
*/
DV *
Tree_setDepthDmetric (
   Tree   *tree,
   DV     *vmetricDV
) {
int      u, v ;
double   *dmetric, *vmetric ;
DV       *dmetricDV ;
/*
   ---------------
   check the input
   ---------------
*/
if (  tree == NULL || tree->n < 1 
   || vmetricDV == NULL 
   || tree->n != DV_size(vmetricDV)
   || (vmetric = DV_entries(vmetricDV)) == NULL ) {
   fprintf(stderr, "\n fatal error in Tree_setDepthDmetric(%p,%p)"
           "\n bad input\n", tree, vmetricDV) ;
   exit(-1) ;
}
dmetricDV = DV_new() ;
DV_init(dmetricDV, tree->n, NULL) ;
dmetric = DV_entries(dmetricDV) ;
for ( u = Tree_preOTfirst(tree) ; 
      u != -1 ; 
      u = Tree_preOTnext(tree, u) ) {
   dmetric[u] = vmetric[u] ;
   if ( (v = tree->par[u]) != -1 ) {
      dmetric[u] += dmetric[v] ;
   }
}
return(dmetricDV) ; }
Beispiel #4
0
/*
   ------------------------------------------------------------------
   create and return a height metric DV object
   input  : vmetricDV -- a metric defined on the vertices
   output : dmetricDV -- a depth metric defined on the vertices
 
   hmetric[v] = vmetric[v] + max{p(u) = v} hmetric[u] if fch[v] != -1
              = vmetric[v]                            if fch[v] == -1

   created -- 96jun23, cca
   ------------------------------------------------------------------
*/
DV *
Tree_setHeightDmetric (
   Tree   *tree,
   DV     *vmetricDV
) {
int      u, v, val ;
double   *hmetric, *vmetric ;
DV       *hmetricDV ;
/*
   ---------------
   check the input
   ---------------
*/
if (  tree == NULL || tree->n < 1 
   || vmetricDV == NULL 
   || tree->n != DV_size(vmetricDV)
   || (vmetric = DV_entries(vmetricDV)) == NULL ) {
   fprintf(stderr, "\n fatal error in Tree_setHeightDmetric(%p,%p)"
           "\n bad input\n", tree, vmetricDV) ;
   exit(-1) ;
}
hmetricDV = DV_new() ; 
DV_init(hmetricDV, tree->n, NULL) ; 
hmetric = DV_entries(hmetricDV) ;
for ( v = Tree_postOTfirst(tree) ; 
      v != -1 ; 
      v = Tree_postOTnext(tree, v) ) {
   for ( u = tree->fch[v], val = 0 ; u != -1 ; u = tree->sib[u] ) {
      if ( val < hmetric[u] ) {
         val = hmetric[u] ;
      }
   }
   hmetric[v] = val + vmetric[v] ;
}
return(hmetricDV) ; }
Beispiel #5
0
/*
   -----------------------------
   input a chevron in the matrix

   created -- 98jan28, cca
   -----------------------------
*/
static void
inputChevron (
   InpMtx   *inpmtx,
   int       chv,
   int       chvsize,
   int       chvind[],
   double    chvent[]
) {
int      col, ii, jj, nent, offset, row ;
int      *ivec1, *ivec2 ;

prepareToAddNewEntries(inpmtx, chvsize) ;
nent  = inpmtx->nent ;
ivec1 = IV_entries(&inpmtx->ivec1IV) ;
ivec2 = IV_entries(&inpmtx->ivec2IV) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   for ( ii = 0, jj = nent ; ii < chvsize ; ii++, jj++ ) {
      if ( (offset = chvind[ii]) >= 0 ) {
         row = chv ;
         col = chv + offset ;
      } else {
         col = chv ;
         row = chv - offset ;
      }
      ivec1[jj] = row ;
      ivec2[jj] = col ;
   }
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   for ( ii = 0, jj = nent ; ii < chvsize ; ii++, jj++ ) {
      if ( (offset = chvind[ii]) >= 0 ) {
         row = chv ;
         col = chv + offset ;
      } else {
         col = chv ;
         row = chv - offset ;
      }
      ivec1[jj] = col ;
      ivec2[jj] = row ;
   }
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   IVfill(chvsize, ivec1 + nent, chv) ;
   IVcopy(chvsize, ivec2 + nent, chvind) ;
}
IV_setSize(&inpmtx->ivec1IV, nent + chvsize) ;
IV_setSize(&inpmtx->ivec2IV, nent + chvsize) ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   double   *dvec = DV_entries(&inpmtx->dvecDV) + nent ;
   DVcopy(chvsize, dvec, chvent) ;
   DV_setSize(&inpmtx->dvecDV,  nent + chvsize) ;
} else if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   double   *dvec = DV_entries(&inpmtx->dvecDV) + 2*nent ;
   ZVcopy(chvsize, dvec, chvent) ;
   DV_setSize(&inpmtx->dvecDV,  2*(nent + chvsize)) ;
}
inpmtx->nent += chvsize ;
inpmtx->storageMode = INPMTX_RAW_DATA ;

return ; }
Beispiel #6
0
/*
   ---------------------------------
   input a row in the matrix

   created -- 98jan28, cca
   ---------------------------------
*/
static void
inputRow (
   InpMtx   *inpmtx,
   int       row,
   int       rowsize,
   int       rowind[],
   double    rowent[]
) {
int      col, ii, jj, nent ;
int      *ivec1, *ivec2 ;

prepareToAddNewEntries(inpmtx, rowsize) ;
nent  = inpmtx->nent ; 
ivec1 = IV_entries(&inpmtx->ivec1IV) ;
ivec2 = IV_entries(&inpmtx->ivec2IV) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) { /* row coordinates */
   IVfill(rowsize, ivec1 + nent, row) ;
   IVcopy(rowsize, ivec2 + nent, rowind) ;
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) { /* column coordinates */
   IVfill(rowsize, ivec2 + nent, row) ;
   IVcopy(rowsize, ivec1 + nent, rowind) ;
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) { /* chevron coordinates */
   for ( ii = 0, jj = nent ; ii < rowsize ; ii++, jj++ ) {
      col = rowind[ii] ;
      ivec1[ii] = (row <= col) ? row : col ;
      ivec2[ii] = col - row ;
   }
}
IV_setSize(&inpmtx->ivec1IV, nent + rowsize) ;
IV_setSize(&inpmtx->ivec2IV, nent + rowsize) ;
/*
   -----------------
   input the entries
   -----------------
*/
if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   double  *dvec = DV_entries(&inpmtx->dvecDV) ;
   DVcopy(rowsize, dvec + nent, rowent) ;
   DV_setSize(&inpmtx->dvecDV, nent + rowsize) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   double  *dvec = DV_entries(&inpmtx->dvecDV) ;
   ZVcopy(rowsize, dvec + 2*nent, rowent) ;
   DV_setSize(&inpmtx->dvecDV,  2*(nent + rowsize)) ;
}
inpmtx->storageMode = INPMTX_RAW_DATA ;
inpmtx->nent += rowsize ;

return ; }
Beispiel #7
0
/*
   -----------------------
   set mtx(irow,*) = y[*]

   created -- 98may01, cca
   -----------------------
*/
void
A2_setRowDV ( 
   A2      *mtx, 
   DV       *rowDV,
   int      irow 
) {
double   *entries, *row ;
int      inc2, j, k, n2 ;
/*
   ---------------
   check the input
   ---------------
*/
if (  mtx == NULL || rowDV == NULL || DV_size(rowDV) != (n2 = mtx->n2)
   || irow < 0 || irow >= mtx->n1 ) {
   fprintf(stderr, "\n fatal error in A2_setRowDV(%p,%p,%d)"
           "\n bad input\n", mtx, rowDV, irow) ;
   exit(-1) ;
}
if ( ! A2_IS_REAL(mtx) ) {
   fprintf(stderr, "\n fatal error in A2_setRowDV(%p,%p,%d)"
           "\n bad type %d, must be SPOOLES_REAL\n", 
           mtx, rowDV, irow, mtx->type) ;
   exit(-1) ;
}
k       = irow * mtx->inc1 ;
inc2    = mtx->inc2 ;
entries = mtx->entries ;
row     = DV_entries(rowDV) ;
for ( j = 0 ; j < n2 ; j++, k += inc2 ) {
   entries[k] = row[j] ;
}
return ; }
Beispiel #8
0
/*
   -----------------------
   set mtx(*,jcol) = y[*]

   created -- 98may01, cca
   -----------------------
*/
void
A2_setColumnDV ( 
   A2      *mtx, 
   DV       *colDV,
   int      jcol 
) {
double   *col, *entries ;
int      inc1, i, k, n1 ;
/*
   ---------------
   check the input
   ---------------
*/
if (  mtx == NULL || colDV == NULL || DV_size(colDV) != (n1 = mtx->n1)
   || jcol < 0 || jcol >= mtx->n2 ) {
   fprintf(stderr, "\n fatal error in A2_setColumnDV(%p,%p,%d)"
           "\n bad input\n", mtx, colDV, jcol) ;
   exit(-1) ;
}
if ( ! A2_IS_REAL(mtx) ) {
   fprintf(stderr, "\n fatal error in A2_setColumnDV(%p,%p,%d)"
           "\n bad type %d, must be SPOOLES_REAL\n", 
           mtx, colDV, jcol, mtx->type) ;
   exit(-1) ;
}
k       = jcol * mtx->inc2 ;
inc1    = mtx->inc1 ;
entries = mtx->entries ;
col     = DV_entries(colDV) ;
for ( i = 0 ; i < n1 ; i++, k += inc1 ) {
   entries[k] = col[i] ;
}
return ; }
Beispiel #9
0
/*
   ----------------------------------
   input a single entry in the matrix

   created -- 98jan28, cca
   ----------------------------------
*/
static void
inputEntry (
   InpMtx   *inpmtx,
   int       row,
   int       col,
   double    real,
   double    imag
) {
int   nent ;
int   *ivec1, *ivec2 ;

prepareToAddNewEntries(inpmtx, 1) ;
nent  = inpmtx->nent ;
ivec1 = IV_entries(&inpmtx->ivec1IV) ;
ivec2 = IV_entries(&inpmtx->ivec2IV) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   ivec1[nent] = row ;
   ivec2[nent] = col ;
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   ivec1[nent] = col ;
   ivec2[nent] = row ;
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   if ( row <= col ) {
      ivec1[nent] = row ;
      ivec2[nent] = col - row ;
   } else {
      ivec1[nent] = col ;
      ivec2[nent] = col - row ;
   }
}
IV_setSize(&inpmtx->ivec1IV, nent + 1) ;
IV_setSize(&inpmtx->ivec2IV, nent + 1) ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   double   *dvec = DV_entries(&inpmtx->dvecDV) ;
   dvec[nent] = real ;
   DV_setSize(&inpmtx->dvecDV,  nent + 1) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   double   *dvec = DV_entries(&inpmtx->dvecDV) ;
   dvec[2*nent]   = real  ;
   dvec[2*nent+1] = imag  ;
   DV_setSize(&inpmtx->dvecDV,  2*(nent + 1)) ;
}
inpmtx->nent++ ;
inpmtx->storageMode = INPMTX_RAW_DATA ;

return ; }
Beispiel #10
0
/*
   -----------------------------------------------------
   purpose -- to write the object's statistics to a file
              in human readable form

   return value -- 
      1 -- normal return
     -1 -- mtx is NULL
     -2 -- fp is NULL

   created -- 98may02, cca
   -----------------------------------------------------
*/
int
DenseMtx_writeStats (
   DenseMtx   *mtx,
   FILE       *fp
) {
/*
   ---------------
   check the input
   ---------------
*/
if ( mtx == NULL ) {
   fprintf(stderr, "\n fatal error in DenseMtx_writeStats()"
           "\n mtx is NULL") ;
   return(-1) ;
}
if ( fp == NULL ) {
   fprintf(stderr, "\n fatal error in DenseMtx_writeStats()"
           "\n fp is NULL") ;
   return(-2) ;
}
fprintf(fp, "\n DenseMtx object at address %p", mtx) ;
switch ( mtx->type ) {
case SPOOLES_REAL :
   fprintf(fp, ", real entries") ;
   break ;
case SPOOLES_COMPLEX :
   fprintf(fp, ", complex entries") ;
   break ;
default :
   fprintf(fp, ", unknown entries type") ;
   break ;
}
fprintf(fp, "\n row id = %d, col id = %d"
        "\n nrow = %d, ncol = %d, inc1 = %d, inc2 = %d",
        mtx->rowid, mtx->colid, 
        mtx->nrow, mtx->ncol, mtx->inc1, mtx->inc2) ;
fprintf(fp, "\n rowind = %p, colind = %p, entries = %p",
        mtx->rowind, mtx->colind, mtx->entries) ;
fprintf(fp, ", base = %p", DV_entries(&mtx->wrkDV)) ;
fprintf(fp, 
       "\n rowind - base = %ld, colind - base = %ld, entries - base = %ld",
       (long unsigned int)(mtx->rowind - (int *) DV_entries(&mtx->wrkDV)),
       (long unsigned int)(mtx->colind - (int *) DV_entries(&mtx->wrkDV)),
       (long unsigned int)(mtx->entries - DV_entries(&mtx->wrkDV))) ;

return(1) ; }
Beispiel #11
0
/*
   ------------------------------------------------------
   return a pointer to the workspace owned by this object
 
   created -- 98may01, cca
   ------------------------------------------------------
*/
void *
SubMtx_workspace (
   SubMtx   *mtx
) {
if ( mtx == NULL ) {
   fprintf(stderr, "\n fatal error in SubMtx_workspace(%p)"
           "\n bad input\n", mtx) ;
   exit(-1) ;
}
return((void *)DV_entries(&mtx->wrkDV)) ; }
Beispiel #12
0
/*
   ------------------------------------
   input a complex column in the matrix

   created -- 98jan28, cca
   ------------------------------------
*/
static void
inputColumn (
   InpMtx   *inpmtx,
   int       col,
   int       colsize,
   int       colind[],
   double    colent[]
) {
int      ii, jj, nent, row ;
int      *ivec1, *ivec2 ;

prepareToAddNewEntries(inpmtx, colsize) ;
nent  = inpmtx->nent ;
ivec1 = IV_entries(&inpmtx->ivec1IV) ;
ivec2 = IV_entries(&inpmtx->ivec2IV) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   IVcopy(colsize, ivec1 + nent, colind) ;
   IVfill(colsize, ivec2 + nent, col) ;
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   IVfill(colsize, ivec1 + nent, col) ;
   IVcopy(colsize, ivec2 + nent, colind) ;
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   for ( ii = 0, jj = nent ; ii < colsize ; ii++, jj++ ) {
      row = colind[jj] ;
      ivec1[jj] = (row <= col) ? row : col ;
      ivec2[jj] = col - row ;
   }
}
IV_setSize(&inpmtx->ivec1IV, nent + colsize) ;
IV_setSize(&inpmtx->ivec2IV, nent + colsize) ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   double *dvec = DV_entries(&inpmtx->dvecDV) + nent ;
   DVcopy(colsize, dvec, colent) ;
   DV_setSize(&inpmtx->dvecDV,  nent + colsize) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   double *dvec = DV_entries(&inpmtx->dvecDV) + 2*nent ;
   ZVcopy(colsize, dvec, colent) ;
   DV_setSize(&inpmtx->dvecDV,  2*(nent + colsize)) ;
}
inpmtx->nent = nent + colsize ;
inpmtx->storageMode = INPMTX_RAW_DATA ;

return ; }
Beispiel #13
0
/*
   --------------------------------
   returns pointer to dvec[] vector

   created -- 98jan28, cca
   --------------------------------
*/
double *   
InpMtx_dvec (
   InpMtx  *inpmtx
) {
/*
   ---------------
   check the input
   ---------------
*/
if ( inpmtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_dvec(%p)"
           "\n bad input\n", inpmtx) ;
   spoolesFatal();
}
return(DV_entries(&inpmtx->dvecDV)) ; }
Beispiel #14
0
/*
   ---------------------------------
   return a pointer to the workspace

   created -- 98may02, cca
   ---------------------------------
*/
void *
DenseMtx_workspace(
   DenseMtx   *mtx
) {
/*
   ---------------
   check the input
   ---------------
*/
if (  mtx == NULL ) {
   fprintf(stderr, "\n fatal error in DenseMtx_workspace(%p)"
           "\n bad input\n", mtx) ;
   exit(-1) ;
}
return(DV_entries(&mtx->wrkDV)) ; }
Beispiel #15
0
/*
   ---------------------------------------------------------
   purpose -- initialize the object from its working storage
              used when the object is a MPI message

   created -- 98may02, cca
   ---------------------------------------------------------
*/
void
DenseMtx_initFromBuffer (
   DenseMtx   *mtx
) {
int   *ibuffer ;
/*
   ---------------
   check the input
   ---------------
*/
if (  mtx == NULL ) {
   fprintf(stderr, "\n fatal error in DenseMtx_initFromBuffer(%p)"
           "\n bad input\n", mtx) ;
   exit(-1) ;
}
ibuffer   = (int *) DV_entries(&mtx->wrkDV) ;
DenseMtx_setFields(mtx, ibuffer[0], ibuffer[1], ibuffer[2], 
                   ibuffer[3], ibuffer[4], ibuffer[5], ibuffer[6]) ;

return ; }
Beispiel #16
0
/*
   -------------------------------------------------------------
   purpose -- to initialize the object from its working storage,
              used when the object is an MPI message

   created -- 98apr30
   -------------------------------------------------------------
*/
void
Chv_initFromBuffer (
   Chv   *chv
) {
int      *ibuffer ;
/*
   ---------------
   check the input
   ---------------
*/
if (  chv == NULL ) {
   fprintf(stderr, "\n fatal error in Chv_initFromBuffer(%p) "
           "\n bad input\n", chv) ;
   exit(-1) ;
}
ibuffer = (int *) DV_entries(&chv->wrkDV) ;
Chv_setFields(chv, ibuffer[0], ibuffer[1], ibuffer[2], 
               ibuffer[3], ibuffer[4], ibuffer[5]) ;

return ; }
Beispiel #17
0
/*
   ------------------------------------------------
   purpose -- to get simple x[] and y[] coordinates 
              for the tree vertices

   return values --
      1 -- normal return
     -1 -- tree is NULL
     -2 -- heightflag is invalid
     -3 -- coordflag is invalid
     -4 -- xDV is NULL
     -5 -- yDV is NULL

   created -- 99jan07, cca
   ------------------------------------------------
*/
int
Tree_getSimpleCoords (
   Tree   *tree,
   char   heightflag,
   char   coordflag,
   DV     *xDV,
   DV     *yDV
) {
double   *x, *y ;
int      count, I, J, n, nleaves ;
int      *fch, *par, *sib ;
/*
   ---------------
   check the input
   ---------------
*/
if ( tree == NULL ) {
   fprintf(stderr, "\n error in Tree_getSimpleCoords()"
           "\n tree is NULL\n") ;
   return(-1) ;
}
if ( heightflag != 'D' && heightflag != 'H' ) {
   fprintf(stderr, "\n error in Tree_getSimpleCoords()"
           "\n invalid heightflag = %c\n", heightflag) ;
   return(-2) ;
}
if ( coordflag != 'C' && coordflag != 'P' ) {
   fprintf(stderr, "\n error in Tree_getSimpleCoords()"
           "\n invalid coordflag = %c\n", coordflag) ;
   return(-3) ;
}
if ( xDV == NULL ) {
   fprintf(stderr, "\n error in Tree_getSimpleCoords()"
           "\n xDV is NULL\n") ;
   return(-4) ;
}
if ( yDV == NULL ) {
   fprintf(stderr, "\n error in Tree_getSimpleCoords()"
           "\n yDV is NULL\n") ;
   return(-5) ;
}
n   = tree->n   ;
par = tree->par ;
fch = tree->fch ;
sib = tree->sib ;
DV_setSize(xDV, n) ;
DV_setSize(yDV, n) ;
x = DV_entries(xDV) ;
y = DV_entries(yDV) ;
switch ( heightflag ) {
case 'D' : {
   int   J, K, maxdepth ;

   for ( J = Tree_preOTfirst(tree), maxdepth = 0 ;
         J != -1 ;
         J = Tree_preOTnext(tree, J) ) {
      if ( (K = par[J]) == -1 ) {
         y[J] = 0.0 ;
      } else {
         y[J] = y[K] + 1.0 ;
      }
      if ( maxdepth < y[J] ) {
         maxdepth = y[J] ;
      }
   }
   if ( coordflag == 'C' ) {
      for ( J = 0 ; J < n ; J++ ) {
         y[J] = maxdepth - y[J] ;
      }
   }
   } break ;
case 'H' : {
   int   height, I, J, maxheight ;

   for ( J = Tree_postOTfirst(tree), maxheight = 0 ;
         J != -1 ;
         J = Tree_postOTnext(tree, J) ) {
      if ( (I = fch[J]) == -1 ) {
         y[J] = 0.0 ;
      } else {
         height = y[I] ;
         for ( I = sib[I] ; I != -1 ; I = sib[I] ) {
            if ( height < y[I] ) {
               height = y[I] ;
            }
         }
         y[J] = height + 1.0 ;
      }
      if ( maxheight < y[J] ) {
         maxheight = y[J] ;
      }
   }
   if ( coordflag == 'P' ) {
      for ( J = 0 ; J < n ; J++ ) {
         y[J] = maxheight - y[J] ;
      }
   }
   } break ;
default :
   break ;
}
#if MYDEBUG > 0
   fprintf(stdout, "\n\n y") ;
   DV_writeForHumanEye(yDV, stdout) ;
#endif
DV_zero(xDV) ;
nleaves = 0 ;
for ( J = Tree_postOTfirst(tree) ;
      J != -1 ;
      J = Tree_postOTnext(tree, J) ) {
   if ( fch[J] == -1 ) {
      x[J] = nleaves++ ;
   } else {
      for ( I = fch[J], count = 0 ; I != -1 ; I = sib[I] ) {
         x[J] += x[I] ;
         count++ ;
      }
      x[J] /= count ;
   }
}
if ( coordflag == 'C' ) {
   for ( J = 0 ; J < n ; J++ ) {
      x[J] = x[J] / nleaves ;
   }
} else {
   double   r, theta ;

   for ( J = 0 ; J < n ; J++ ) {
      theta = 6.283185 * x[J] / nleaves ;
      r     = y[J] ;
      x[J]  = r * cos(theta) ;
      y[J]  = r * sin(theta) ;
   }
}
#if MYDEBUG > 0
   fprintf(stdout, "\n\n x") ;
   DV_writeForHumanEye(xDV, stdout) ;
#endif
return(1) ; }
Beispiel #18
0
/*
   -----------------------------------------------------------
   A contains the following data from the A = QR factorization

   A(1:ncolA,1:ncolA) = R
   A(j+1:nrowA,j) is v_j, the j-th householder vector, 
       where v_j[j] = 1.0

   NOTE: A and Q must be column major

   created -- 98dec10, cca
   -----------------------------------------------------------
*/
void
A2_computeQ (
   A2     *Q,
   A2     *A,
   DV     *workDV,
   int    msglvl,
   FILE   *msgFile
) {
double   *betas ;
int      irowA, jcolA, ncolA, nrowA ;
/*
   ---------------
   check the input
   ---------------
*/
if ( Q == NULL ) {
   fprintf(stderr, "\n fatal error in A2_computeQ()"
           "\n Q is NULL\n") ;
   exit(-1) ;
}
if ( A == NULL ) {
   fprintf(stderr, "\n fatal error in A2_computeQ()"
           "\n A is NULL\n") ;
   exit(-1) ;
}
if ( workDV == NULL ) {
   fprintf(stderr, "\n fatal error in A2_computeQ()"
           "\n workDV is NULL\n") ;
   exit(-1) ;
}
if ( msglvl > 0 && msgFile == NULL ) {
   fprintf(stderr, "\n fatal error in A2_computeQ()"
           "\n msglvl > 0 and msgFile is NULL\n") ;
   exit(-1) ;
}
nrowA = A2_nrow(A) ;
ncolA = A2_ncol(A) ;
if ( nrowA <= 0 ) {
   fprintf(stderr, "\n fatal error in A2_computeQ()"
           "\n nrowA = %d\n", nrowA) ;
   exit(-1) ;
}
if ( ncolA <= 0 ) {
   fprintf(stderr, "\n fatal error in A2_computeQ()"
           "\n ncolA = %d\n", nrowA) ;
   exit(-1) ;
}
if ( nrowA != A2_nrow(Q) ) {
   fprintf(stderr, "\n fatal error in A2_computeQ()"
           "\n nrowA = %d, nrowQ = %d\n", nrowA, A2_nrow(Q)) ;
   exit(-1) ;
}
if ( ncolA != A2_ncol(Q) ) {
   fprintf(stderr, "\n fatal error in A2_computeQ()"
           "\n ncolA = %d, ncolQ = %d\n", ncolA, A2_ncol(Q)) ;
   exit(-1) ;
}
switch ( A->type ) {
case SPOOLES_REAL :
case SPOOLES_COMPLEX :
   break ;
default :
   fprintf(stderr, "\n fatal error in A2_computeQ()"
           "\n invalid type for A\n") ;
   exit(-1) ;
}
if ( A->type != Q->type ) {
   fprintf(stderr, "\n fatal error in A2_computeQ()"
           "\n A->type = %d, Q->type = %d\n", A->type, Q->type) ;
   exit(-1) ;
}
if ( A2_inc1(A) != 1 ) {
   fprintf(stderr, "\n fatal error in A2_computeQ()"
           "\n A->inc1 = %d \n", A2_inc1(A)) ; 
   exit(-1) ;
}
if ( A2_inc1(Q) != 1 ) {
   fprintf(stderr, "\n fatal error in A2_computeQ()"
           "\n Q->inc1 = %d, \n", A2_inc1(Q)) ;
   exit(-1) ;
}
/*
   --------------------------------------------------
   compute the beta values, beta_j = 2./(V_j^H * V_j)
   --------------------------------------------------
*/
DV_setSize(workDV, ncolA) ;
betas = DV_entries(workDV) ;
if ( A2_IS_REAL(A) ) {
   int   irowA, jcolA ;
   double   sum ;
   double   *colA ;

   for ( jcolA = 0 ; jcolA < ncolA ; jcolA++ ) {
      sum = 1.0 ;
      colA = A2_column(A, jcolA) ;
      for ( irowA = jcolA + 1 ; irowA < nrowA ; irowA++ ) {
         sum += colA[irowA] * colA[irowA] ;
      }
      betas[jcolA] = 2./sum ;
   }
} else {
   double   ival, rval, sum ;
   double   *colA ;

   for ( jcolA = 0 ; jcolA < ncolA ; jcolA++ ) {
      sum = 1.0 ;
      colA = A2_column(A, jcolA) ;
      for ( irowA = jcolA + 1 ; irowA < nrowA ; irowA++ ) {
         rval = colA[2*irowA] ; ival = colA[2*irowA+1] ;
         sum += rval*rval + ival*ival ;
      }
      betas[jcolA] = 2./sum ;
   }
}
/*
   -------------------------------------------
   loop over the number of householder vectors
   -------------------------------------------
*/
for ( jcolA = 0 ; jcolA < ncolA ; jcolA++ ) {
   double   *V, *X ;
   int      jcolV ;
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n\n %% jcolA = %d", jcolA) ;
      fflush(msgFile) ;
   }
/*
   ------------------
   set X[] to e_jcolA
   ------------------
*/
   X = A2_column(Q, jcolA) ;
   if ( A2_IS_REAL(Q) ) {
      DVzero(nrowA, X) ;
      X[jcolA] = 1.0 ;
   } else {
      DVzero(2*nrowA, X) ;
      X[2*jcolA] = 1.0 ;
   }
   for ( jcolV = jcolA ; jcolV >= 0 ; jcolV-- ) {
      double   beta ;
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n   %% jcolV = %d", jcolV) ;
         fflush(msgFile) ;
      }
/*
      -----------------------------------------------------
      update X = (I - beta_jcolV * V_jcolV * V_jcolV^T)X
               = X - beta_jcolV * V_jcolV * V_jcolV^T * X
               = X - (beta_jcolV * V_jcolV^T * X) * V_jcolV 
      -----------------------------------------------------
*/
      V = A2_column(A, jcolV) ;
      beta = betas[jcolV] ;
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n   %% beta = %12.4e", beta) ;
         fflush(msgFile) ;
      }
      if ( A2_IS_REAL(Q) ) {
         double   fac, sum = X[jcolV] ;
         int      irow ;
         for ( irow = jcolV + 1 ; irow < nrowA ; irow++ ) {
            if ( msglvl > 2 ) {
               fprintf(msgFile, 
                       "\n      %% V[%d] = %12.4e, X[%d] = %12.4e",
                       irow, V[irow], irow, X[irow]) ;
               fflush(msgFile) ;
            }
            sum += V[irow] * X[irow] ;
         }
         if ( msglvl > 2 ) {
            fprintf(msgFile, "\n   %% sum = %12.4e", sum) ;
            fflush(msgFile) ;
         }
         fac = beta * sum ;
         if ( msglvl > 2 ) {
            fprintf(msgFile, "\n   %% fac = %12.4e", fac) ;
            fflush(msgFile) ;
         }
         X[jcolV] -= fac ;
         for ( irow = jcolV + 1 ; irow < nrowA ; irow++ ) {
            X[irow] -= fac * V[irow] ;
         }
      } else {
         double   rfac, ifac, rsum = X[2*jcolV], isum = X[2*jcolV+1] ;
         int      irow ;
         for ( irow = jcolV + 1 ; irow < nrowA ; irow++ ) {
            double   Vi, Vr, Xi, Xr ;
            Vr = V[2*irow] ; Vi = V[2*irow+1] ;
            Xr = X[2*irow] ; Xi = X[2*irow+1] ;
            rsum += Vr*Xr + Vi*Xi ;
            isum += Vr*Xi - Vi*Xr ;
         }
         rfac = beta * rsum ;
         ifac = beta * isum ;
         X[2*jcolV]   -= rfac ;
         X[2*jcolV+1] -= ifac ;
         for ( irow = jcolV + 1 ; irow < nrowA ; irow++ ) {
            double   Vi, Vr ;
            Vr = V[2*irow] ; Vi = V[2*irow+1] ;
            X[2*irow]   -= rfac*Vr - ifac*Vi ;
            X[2*irow+1] -= rfac*Vi + ifac*Vr ;
         }
      }
   }
}
return ; }
Beispiel #19
0
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ------------------------------------------
   test the SubMtx_scale{1,2,3}vec() methods.

   created -- 98may02, cca
   ------------------------------------------
*/
{
SubMtx   *mtxA ;
double   t1, t2 ;
double   *x0, *x1, *x2, *y0, *y1, *y2 ;
Drand    *drand ;
DV       *xdv0, *xdv1, *xdv2, *ydv0, *ydv1, *ydv2 ;
ZV       *xzv0, *xzv1, *xzv2, *yzv0, *yzv1, *yzv2 ;
FILE     *msgFile ;
int      mode, msglvl, nrowA, seed, type ;

if ( argc != 7 ) {
   fprintf(stdout, 
           "\n\n usage : %s msglvl msgFile type nrowA seed"
           "\n    msglvl  -- message level"
           "\n    msgFile -- message file"
           "\n    type -- type of matrix A"
           "\n       1 -- real"
           "\n       2 -- complex"
           "\n    mode -- mode of matrix A"
           "\n       7 -- diagonal"
           "\n       8 -- block diagonal symmetric"
           "\n       9 -- block diagonal hermitian (complex only)"
           "\n    nrowA -- # of rows in matrix A"
           "\n    seed  -- random number seed"
           "\n", argv[0]) ;
   return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
   fprintf(stderr, "\n message level must be positive\n") ;
   exit(-1) ;
}
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
   return(-1) ;
}
type  = atoi(argv[3]) ;
mode  = atoi(argv[4]) ;
nrowA = atoi(argv[5]) ;
seed  = atoi(argv[6]) ;
fprintf(msgFile, "\n %% %s:"
        "\n %% msglvl  = %d"
        "\n %% msgFile = %s"
        "\n %% type    = %d"
        "\n %% mode    = %d"
        "\n %% nrowA   = %d"
        "\n %% seed    = %d",
        argv[0], msglvl, argv[2], type, mode, nrowA, seed) ;
/*
   -----------------------------
   check for errors in the input
   -----------------------------
*/
if ( nrowA <= 0 ) {
   fprintf(stderr, "\n invalid input\n") ;
   exit(-1) ;
}
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setNormal(drand, 0.0, 1.0) ;
/*
   ----------------------------
   initialize the X ZV objects
   ----------------------------
*/
MARKTIME(t1) ;
if ( type == SPOOLES_REAL ) {
   xdv0 = DV_new() ;
   DV_init(xdv0, nrowA, NULL) ;
   x0 = DV_entries(xdv0) ;
   Drand_fillDvector(drand, nrowA, x0) ;
   xdv1 = DV_new() ;
   DV_init(xdv1, nrowA, NULL) ;
   x1 = DV_entries(xdv1) ;
   Drand_fillDvector(drand, nrowA, x1) ;
   xdv2 = DV_new() ;
   DV_init(xdv2, nrowA, NULL) ;
   x2 = DV_entries(xdv2) ;
   Drand_fillDvector(drand, nrowA, x2) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n %% CPU : %.3f to initialize X ZV objects",
           t2 - t1) ;
   if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n %% X DV objects") ;
      fprintf(msgFile, "\n X0 = zeros(%d,1) ;", nrowA) ;
      DV_writeForMatlab(xdv0, "X0", msgFile) ;
      fprintf(msgFile, "\n X1 = zeros(%d,1) ;", nrowA) ;
      DV_writeForMatlab(xdv1, "X1", msgFile) ;
      fprintf(msgFile, "\n X2 = zeros(%d,1) ;", nrowA) ;
      DV_writeForMatlab(xdv2, "X2", msgFile) ;
      fflush(msgFile) ;
   }
} else if ( type == SPOOLES_COMPLEX ) {
   xzv0 = ZV_new() ;
   ZV_init(xzv0, nrowA, NULL) ;
   x0 = ZV_entries(xzv0) ;
   Drand_fillDvector(drand, 2*nrowA, x0) ;
   xzv1 = ZV_new() ;
   ZV_init(xzv1, nrowA, NULL) ;
   x1 = ZV_entries(xzv1) ;
   Drand_fillDvector(drand, 2*nrowA, x1) ;
   xzv2 = ZV_new() ;
   ZV_init(xzv2, nrowA, NULL) ;
   x2 = ZV_entries(xzv2) ;
   Drand_fillDvector(drand, 2*nrowA, x2) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n %% CPU : %.3f to initialize X ZV objects",
           t2 - t1) ;
   if ( msglvl > 1 ) {
      fprintf(msgFile, "\n\n %% X ZV objects") ;
      fprintf(msgFile, "\n X0 = zeros(%d,1) ;", nrowA) ;
      ZV_writeForMatlab(xzv0, "X0", msgFile) ;
      fprintf(msgFile, "\n X1 = zeros(%d,1) ;", nrowA) ;
      ZV_writeForMatlab(xzv1, "X1", msgFile) ;
      fprintf(msgFile, "\n X2 = zeros(%d,1) ;", nrowA) ;
      ZV_writeForMatlab(xzv2, "X2", msgFile) ;
      fflush(msgFile) ;
   }
}
/*
   ---------------------------------
   initialize the Y DV or ZV objects
   ---------------------------------
*/
MARKTIME(t1) ;
if ( type == SPOOLES_REAL ) {
   ydv0 = DV_new() ;
   DV_init(ydv0, nrowA, NULL) ;
   y0 = DV_entries(ydv0) ;
   ydv1 = DV_new() ;
   DV_init(ydv1, nrowA, NULL) ;
   y1 = DV_entries(ydv1) ;
   ydv2 = DV_new() ;
   DV_init(ydv2, nrowA, NULL) ;
   y2 = DV_entries(ydv2) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n %% CPU : %.3f to initialize Y DV objects",
           t2 - t1) ;
} else if ( type == SPOOLES_COMPLEX ) {
   yzv0 = ZV_new() ;
   ZV_init(yzv0, nrowA, NULL) ;
   y0 = ZV_entries(yzv0) ;
   yzv1 = ZV_new() ;
   ZV_init(yzv1, nrowA, NULL) ;
   y1 = ZV_entries(yzv1) ;
   yzv2 = ZV_new() ;
   ZV_init(yzv2, nrowA, NULL) ;
   y2 = ZV_entries(yzv2) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n %% CPU : %.3f to initialize Y ZV objects",
           t2 - t1) ;
}
/*
   -----------------------------------
   initialize the A matrix SubMtx object
   -----------------------------------
*/
seed++ ;
mtxA = SubMtx_new() ;
switch ( mode ) {
case SUBMTX_DIAGONAL :
case SUBMTX_BLOCK_DIAGONAL_SYM :
case SUBMTX_BLOCK_DIAGONAL_HERM :
   SubMtx_initRandom(mtxA, type, mode, 0, 0, nrowA, nrowA, 0, seed) ;
   break ;
default :
   fprintf(stderr, "\n fatal error in test_solve"
           "\n invalid mode = %d", mode) ;
   exit(-1) ;
}
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% A SubMtx object") ;
   fprintf(msgFile, "\n A = zeros(%d,%d) ;", nrowA, nrowA) ;
   SubMtx_writeForMatlab(mtxA, "A", msgFile) ;
   fflush(msgFile) ;
}
/*
   -------------------
   compute Y0 = A * X0
   -------------------
*/
if ( type == SPOOLES_REAL ) {
   DVzero(nrowA, y0) ;
} else if ( type == SPOOLES_COMPLEX ) {
   DVzero(2*nrowA, y0) ;
}
SubMtx_scale1vec(mtxA, y0, x0) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n Z0 = zeros(%d,1) ;", nrowA) ;
   if ( type == SPOOLES_REAL ) {
      DV_writeForMatlab(ydv0, "Z0", msgFile) ;
   } else if ( type == SPOOLES_COMPLEX ) {
      ZV_writeForMatlab(yzv0, "Z0", msgFile) ;
   }
   fprintf(msgFile, "\n err0 = Z0 - A*X0 ;") ;
   fprintf(msgFile, "\n error0 = max(abs(err0))") ;
   fflush(msgFile) ;
}
if ( type == SPOOLES_REAL ) {
   DVzero(nrowA, y0) ;
   DVzero(nrowA, y1) ;
} else if ( type == SPOOLES_COMPLEX ) {
   DVzero(2*nrowA, y0) ;
   DVzero(2*nrowA, y1) ;
}
SubMtx_scale2vec(mtxA, y0, y1, x0, x1) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n Z0 = zeros(%d,1) ;", nrowA) ;
   fprintf(msgFile, "\n\n Z1 = zeros(%d,1) ;", nrowA) ;
   if ( type == SPOOLES_REAL ) {
      DV_writeForMatlab(ydv0, "Z0", msgFile) ;
      DV_writeForMatlab(ydv1, "Z1", msgFile) ;
   } else if ( type == SPOOLES_COMPLEX ) {
      ZV_writeForMatlab(yzv0, "Z0", msgFile) ;
      ZV_writeForMatlab(yzv1, "Z1", msgFile) ;
   }
   fprintf(msgFile, "\n err1 = [Z0 Z1] - A*[X0 X1] ;") ;
   fprintf(msgFile, "\n error1 = max(abs(err1))") ;
   fflush(msgFile) ;
}
if ( type == SPOOLES_REAL ) {
   DVzero(nrowA, y0) ;
   DVzero(nrowA, y1) ;
   DVzero(nrowA, y2) ;
} else if ( type == SPOOLES_COMPLEX ) {
   DVzero(2*nrowA, y0) ;
   DVzero(2*nrowA, y1) ;
   DVzero(2*nrowA, y2) ;
}
SubMtx_scale3vec(mtxA, y0, y1, y2, x0, x1, x2) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n Z0 = zeros(%d,1) ;", nrowA) ;
   fprintf(msgFile, "\n\n Z1 = zeros(%d,1) ;", nrowA) ;
   fprintf(msgFile, "\n\n Z2 = zeros(%d,1) ;", nrowA) ;
   if ( type == SPOOLES_REAL ) {
      DV_writeForMatlab(ydv0, "Z0", msgFile) ;
      DV_writeForMatlab(ydv1, "Z1", msgFile) ;
      DV_writeForMatlab(ydv2, "Z2", msgFile) ;
   } else if ( type == SPOOLES_COMPLEX ) {
      ZV_writeForMatlab(yzv0, "Z0", msgFile) ;
      ZV_writeForMatlab(yzv1, "Z1", msgFile) ;
      ZV_writeForMatlab(yzv2, "Z2", msgFile) ;
   }
   fprintf(msgFile, "\n err2 = [Z0 Z1 Z2] - A*[X0 X1 X2] ;") ;
   fprintf(msgFile, "\n error3 = max(abs(err2))") ;
   fflush(msgFile) ;
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
SubMtx_free(mtxA) ;
if ( type == SPOOLES_REAL ) {
   DV_free(xdv0) ;
   DV_free(xdv1) ;
   DV_free(xdv2) ;
   DV_free(ydv0) ;
   DV_free(ydv1) ;
   DV_free(ydv2) ;
} else if ( type == SPOOLES_COMPLEX ) {
   ZV_free(xzv0) ;
   ZV_free(xzv1) ;
   ZV_free(xzv2) ;
   ZV_free(yzv0) ;
   ZV_free(yzv1) ;
   ZV_free(yzv2) ;
}
Drand_free(drand) ;

fprintf(msgFile, "\n") ;

return(1) ; }
Beispiel #20
0
/*
   ------------------------------------------------------------
   purpose -- to write an EPS file with a picture of a tree.
              each node can have its own radius and label

   filename  -- name of the file to be written
   xDV       -- x coordinates
   yDV       -- y coordinates
   rscale    -- scaling factor for radius of nodes
   radiusDV  -- radius of nodes, if NULL then radius = 1
   labelflag -- flag to specify whether labels are to be drawn
           1     -- draw labels
       otherwise -- do not draw labels
   fontscale -- scaling factor for font
   labelsIV  -- IV object that contains the labels of the nodes.
       if NULL then the node ids are used
   bbox[] -- bounding box for figure
      bbox[0] -- x_min
      bbox[1] -- y_min
      bbox[2] -- x_max
      bbox[3] -- y_max
   frame[] -- frame to hold tree
      frame[0] -- x_min
      frame[1] -- y_min
      frame[2] -- x_max
      frame[3] -- y_max
   bounds[] -- bounds for local coordinates
      if bounds is NULL then
         the tree fills the frame. note, this is a nonlinear process
         when the nodes have non-constant radii, and may not converge
         when the maximum radius is large when compared to the frame.
         if the process does not converge, a message is printed and
         the program exits.
      else
         bounds[0] -- xi_min
         bounds[1] -- eta_min
         bounds[2] -- xi_max
         bounds[3] -- eta_max
      endif

   recommendations, 
      bbox[] = { 0, 0, 500, 200 } for tall skinny trees
               { 0, 0, 500, 500 } for wide trees
      frame[0] = bbox[0] + 10
      frame[1] = bbox[1] + 10
      frame[2] = bbox[2] - 10
      frame[3] = bbox[3] - 10

   return value
      1 -- normal return
     -1 -- tree is NULL
     -2 -- filename is NULL
     -3 -- xDV is NULL
     -4 -- yDV is NULL
     -5 -- rscale is negative
     -6 -- fontscale is negative
     -7 -- bbox is NULL
     -8 -- frame is NULL

   created -- 99jan07, cca
   ------------------------------------------------------------
*/
int
Tree_drawToEPS (
   Tree     *tree,
   char     *filename,
   DV       *xDV,
   DV       *yDV,
   double   rscale,
   DV       *radiusDV,
   int      labelflag,
   double   fontscale,
   IV       *labelsIV,
   double   bbox[],
   double   frame[],
   double   bounds[]
) {
double   etamax, etamin, ximax, ximin, xmax, xmin, xrmax, xrmin,
         xscale, ymax, ymin, yrmax, yrmin, yscale ;
double   *radius, *x, *xloc, *y, *yloc ;
FILE     *fp ;
int      count, J, K, n ;
int      *fch, *par, *sib ;
/*
   ---------------
   check the input
   ---------------
*/
if ( tree == NULL ) {
   fprintf(stderr, "\n error in Tree_drawToEPS()"
           "\n tree is NULL\n") ;
   return(-1) ;
}
if ( filename == NULL ) {
   fprintf(stderr, "\n error in Tree_drawToEPS()"
           "\n filename is NULL\n") ;
   return(-2) ;
}
if ( xDV == NULL ) {
   fprintf(stderr, "\n error in Tree_drawToEPS()"
           "\n xDV is NULL\n") ;
   return(-3) ;
}
if ( yDV == NULL ) {
   fprintf(stderr, "\n error in Tree_drawToEPS()"
           "\n yDV is NULL\n") ;
   return(-4) ;
}
if ( rscale < 0.0 ) {
   fprintf(stderr, "\n error in Tree_drawToEPS()"
           "\n rscale is negative\n") ;
   return(-5) ;
}
if ( fontscale < 0.0 ) {
   fprintf(stderr, "\n error in Tree_drawToEPS()"
           "\n fontscale is negative\n") ;
   return(-6) ;
}
if ( bbox == NULL ) {
   fprintf(stderr, "\n error in Tree_drawToEPS()"
           "\n bbox is NULL\n") ;
   return(-7) ;
}
if ( frame == NULL ) {
   fprintf(stderr, "\n error in Tree_drawToEPS()"
           "\n frame is NULL\n") ;
   return(-8) ;
}
n   = tree->n ;
par = tree->par ;
fch = tree->fch ;
sib = tree->sib ;
x   = DV_entries(xDV) ;
y   = DV_entries(yDV) ;
if ( radiusDV != NULL ) {
   radius = DV_entries(radiusDV) ;
} else {
   radius = NULL ;
}
#if MYDEBUG > 0
fprintf(stdout, "\n\n x") ;
DVfprintf(stdout, n, x) ;
fprintf(stdout, "\n\n y") ;
DVfprintf(stdout, n, y) ;
if ( radius != NULL ) {
   fprintf(stdout, "\n\n radius") ;
   DVfprintf(stdout, n, radius) ;
}
#endif
xloc = DVinit(n, 0.0) ;
yloc = DVinit(n, 0.0) ;
if ( bounds != NULL ) {
/*
   ------------------------------------------
   get the local coordinates w.r.t the bounds
   ------------------------------------------
*/
   double   etamax, etamin, ximax, ximin, xmax, xmin, xoff, xscale,
            ymax, ymin, yoff, yscale ;
   xmin   = frame[0]  ; xmax   = frame[2]  ;
   ximin  = bounds[0] ; ximax  = bounds[2] ;
   xoff   = (xmin*ximax - xmax*ximin)/(ximax - ximin) ;
   xscale = (xmax - xmin)/(ximax - ximin) ;
   for ( J = 0 ; J < n ; J++ ) {
      xloc[J] = xoff + xscale*x[J] ;
   }
   ymin   = frame[1]  ; ymax   = frame[3]  ;
   etamin = bounds[1] ; etamax = bounds[3] ;
   yoff   = (ymin*etamax - ymax*etamin)/(etamax - etamin) ;
   yscale = (ymax - ymin)/(etamax - etamin) ;
   for ( J = 0 ; J < n ; J++ ) {
      yloc[J] = yoff + yscale*y[J] ;
   }
} else {
/*
   -----------------------------------------
   scale x[] and y[] to fit within the frame
   -----------------------------------------
*/
   xmin = frame[0] ;
   ymin = frame[1] ;
   xmax = frame[2] ;
   ymax = frame[3] ;
#if MYDEBUG > 0
   fprintf(stdout, "\n\n xmin = %.3g, xmax = %.3g", xmin, xmax) ;
#endif
   findLocalCoords(n, x, xloc, rscale, radius, xmin, xmax) ;
#if MYDEBUG > 0
   fprintf(stdout, "\n\n ymin = %.3g, ymax = %.3g", ymin, ymax) ;
#endif
   findLocalCoords(n, y, yloc, rscale, radius, ymin, ymax) ;
}
#if MYDEBUG > 0
   fprintf(stdout, "\n\n xloc") ;
   DVfprintf(stdout, n, xloc) ;
#endif
#if MYDEBUG > 0
   fprintf(stdout, "\n\n yloc") ;
   DVfprintf(stdout, n, yloc) ;
#endif
/*
   -------------
   open the file
   -------------
*/
if ( (fp = fopen(filename, "w")) == NULL ) {
   fprintf(stderr, "\n unable to open file %s", filename) ;
   exit(-1) ;
}
/*
   ----------------------------
   print the header information
   ----------------------------
*/
fprintf(fp, 
        "%%!PS-Adobe-2.0 EPSF-1.2"
        "\n%%%%BoundingBox: %.3g %.3g %.3g %.3g",
        bbox[0], bbox[1], bbox[2], bbox[3]) ;
fprintf(fp, 
        "\n /CSH {"
        "\n %%"
        "\n %% center show a string"
        "\n %%"
        "\n %%  stack"
        "\n %%     string str"
        "\n %%"
        "\n dup stringwidth pop 2 div neg 0 rmoveto"
        "\n show"
        "\n } def") ;
fprintf(fp, 
        "\n /ML {"
        "\n %%"
        "\n %% moveto lineto"
        "\n %%"
        "\n %%  stack"
        "\n %%     x0 y0 x1 y1"
        "\n %%"
        "\n moveto lineto"
        "\n } def") ;
fprintf(fp, 
        "\n /FC {"
        "\n %%"
        "\n %% draw filled circle"
        "\n %%"
        "\n %%  stack"
        "\n %%     x y r"
        "\n %%"
        "\n newpath 2 index 1 index add 2 index moveto 0 360 arc fill"
        "\n } def") ;
fprintf(fp, 
        "\n /OC {"
        "\n %%"
        "\n %% draw open circle"
        "\n %%"
        "\n %%  stack"
        "\n %%     x y r"
        "\n %%"
        "\n newpath 2 index 1 index add 2 index moveto 0 360 arc stroke"
        "\n } def") ;
fprintf(fp, "\n /rscale    %.3f def", rscale) ;
fprintf(fp, "\n /fontscale %.3f def", fontscale) ;
/*
   --------------
   draw the edges
   --------------
*/
fprintf(fp, "\n %.3g %.3g %.3g %.3g rectclip",
        frame[0], frame[1], frame[2] - frame[0], frame[3] - frame[1]) ;
par = tree->par ;
count = 0 ;
for ( J = 0 ; J < n ; J++ ) {
   if ( (K = par[J]) != -1 ) {
      if ( count == 0 ) {
         fprintf(fp, "\n newpath") ;
      }
      fprintf(fp, "\n   %.3g %.3g %.3g %.3g ML",
              xloc[J], yloc[J], xloc[K], yloc[K]) ;
      count++ ;
      if ( count == 100 ) {
         fprintf(fp, "\n stroke") ;
         count = 0 ;
      }
   }
}
if ( count > 0 ) {
   fprintf(fp, "\n stroke") ;
}
/*
   -------------------------
   draw the nodes and labels
   -------------------------
*/
fprintf(fp, "\n\n gsave") ;
if ( labelflag == 1 ) {
   fprintf(fp, 
           "\n  /Helvetica-Bold findfont fontscale scalefont setfont") ;
}
if ( radius == NULL ) {
   for ( J = 0 ; J < n ; J++ ) {
      fprintf(fp, "\n    1.0 setgray") ;
      fprintf(fp, " %.3g %.3g %.3g FC", 
              xloc[J], yloc[J], rscale) ;
      fprintf(fp, "\n    0.0 setgray") ;
      fprintf(fp, " %.3g %.3g %.3g OC", 
              xloc[J], yloc[J], rscale) ;
      if ( labelflag == 1 ) {
         fprintf(fp, "\n   %.3g %.3g moveto ", 
                 xloc[J], yloc[J] - 0.5*rscale) ;
         if ( labelsIV != NULL ) {
            fprintf(fp, " (%d) CSH", IV_entry(labelsIV, J)) ;
         } else {
            fprintf(fp, " (%d) CSH", J) ;
         }
      }
   }
} else {
   for ( J = 0 ; J < n ; J++ ) {
      fprintf(fp, "\n    1.0 setgray") ;
      fprintf(fp, " %.3g %.3g %.3g FC", 
              xloc[J], yloc[J], rscale*radius[J]) ;
      fprintf(fp, "\n    0.0 setgray") ;
      fprintf(fp, " %.3g %.3g %.3g OC", 
              xloc[J], yloc[J], rscale*radius[J]) ;
      if ( labelflag == 1 ) {
         fprintf(fp, "\n   %.3g %.3g %.3g sub moveto ", 
                 xloc[J], yloc[J], 0.25*fontscale) ;
         if ( labelsIV != NULL ) {
            fprintf(fp, " (%d) CSH", IV_entry(labelsIV, J)) ;
         } else {
            fprintf(fp, " (%d) CSH", J) ;
         }
      }
   }
}
fprintf(fp, "\n\n grestore") ;
fprintf(fp, "\n %.3g %.3g %.3g %.3g rectstroke",
        frame[0], frame[1], frame[2] - frame[0], frame[3] - frame[1]) ;
fprintf(fp, "\n\n showpage") ;

return(1) ; }
Beispiel #21
0
/*
   ---------------------------------------
   purpose -- set the fields of the object

   created -- 98may02, cca
   ---------------------------------------
*/
void
DenseMtx_setFields (
   DenseMtx   *mtx,
   int         type,
   int         rowid,
   int         colid,
   int         nrow,
   int         ncol,
   int         inc1,
   int         inc2
) {
double   *dbuffer ;
int      *ibuffer ;
/*
   ---------------
   check the input
   ---------------
*/
if (  mtx == NULL || nrow < 0 || ncol < 0 
   || !((inc1 == ncol && inc2 == 1) || (inc1 == 1 && inc2 == nrow)) ) {
   fprintf(stderr, 
           "\n fatal error in DenseMtx_setFields(%p,%d,%d,%d,%d,%d,%d)"
           "\n bad input\n", 
           mtx, rowid, colid, nrow, ncol, inc1, inc2) ;
   exit(-1) ;
}
dbuffer = DV_entries(&mtx->wrkDV) ;
ibuffer = (int *) dbuffer ;
/*
   ---------------------
   set the scalar fields
   ---------------------
*/
mtx->type  = ibuffer[0] = type  ;
mtx->rowid = ibuffer[1] = rowid ;
mtx->colid = ibuffer[2] = colid ;
mtx->nrow  = ibuffer[3] = nrow  ;
mtx->ncol  = ibuffer[4] = ncol  ;
mtx->inc1  = ibuffer[5] = inc1  ;
mtx->inc2  = ibuffer[6] = inc2  ;
/*
   -------------------
   set up the pointers
   -------------------
*/
mtx->rowind = ibuffer + 7 ;
mtx->colind = mtx->rowind + nrow ;
if ( sizeof(int) == sizeof(double) ) {
   mtx->entries = dbuffer + 7 + nrow + ncol ;
} else if ( 2*sizeof(int) == sizeof(double) ) {
   mtx->entries = dbuffer + (8 + nrow + ncol)/2 ;
}
/*
fprintf(stdout, 
        "\n rowind - ibuffer = %d" 
        "\n colind - rowind  = %d" 
        "\n entries - dbuffer = %d", 
        mtx->rowind - ibuffer,
        mtx->colind - mtx->rowind,
        mtx->entries - dbuffer) ;
*/

return ; }
Beispiel #22
0
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   -----------------------------
   test the SubMtx_solve() method.

   created -- 98apr15, cca
   -----------------------------
*/
{
SubMtx   *mtxA, *mtxB, *mtxX ;
double   idot, rdot, t1, t2 ;
double   *entB, *entX ;
Drand    *drand ;
FILE     *msgFile ;
int      inc1, inc2, mode, msglvl, ncolA, nentA, nrowA, 
         ncolB, nrowB, ncolX, nrowX, seed, type ;

if ( argc != 9 ) {
   fprintf(stdout, 
       "\n\n usage : %s msglvl msgFile type mode nrowA nentA ncolB seed"
       "\n    msglvl  -- message level"
       "\n    msgFile -- message file"
       "\n    type    -- type of matrix A"
       "\n       1 -- real"
       "\n       2 -- complex"
       "\n    mode    -- mode of matrix A"
       "\n       2 -- sparse stored by rows"
       "\n       3 -- sparse stored by columns"
       "\n       5 -- sparse stored by subrows"
       "\n       6 -- sparse stored by subcolumns"
       "\n       7 -- diagonal"
       "\n       8 -- block diagonal symmetric"
       "\n       9 -- block diagonal hermitian"
       "\n    nrowA   -- # of rows in matrix A"
       "\n    nentA   -- # of entries in matrix A"
       "\n    ncolB   -- # of columns in matrix B"
       "\n    seed    -- random number seed"
       "\n", argv[0]) ;
   return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
   fprintf(stderr, "\n message level must be positive\n") ;
   spoolesFatal();
}
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
   return(-1) ;
}
type  = atoi(argv[3]) ;
mode  = atoi(argv[4]) ;
nrowA = atoi(argv[5]) ;
nentA = atoi(argv[6]) ;
ncolB = atoi(argv[7]) ;
seed  = atoi(argv[8]) ;
fprintf(msgFile, "\n %% %s:"
        "\n %% msglvl  = %d"
        "\n %% msgFile = %s"
        "\n %% type    = %d"
        "\n %% mode    = %d"
        "\n %% nrowA   = %d"
        "\n %% nentA   = %d"
        "\n %% ncolB   = %d"
        "\n %% seed    = %d",
        argv[0], msglvl, argv[2], type, mode, 
        nrowA, nentA, ncolB, seed) ;
ncolA = nrowA ;
nrowB = nrowA ;
nrowX = nrowA ;
ncolX = ncolB ;
/*
   -----------------------------
   check for errors in the input
   -----------------------------
*/
if ( nrowA <= 0 || nentA <= 0 || ncolB <= 0 ) {
   fprintf(stderr, "\n invalid input\n") ;
   spoolesFatal();
}
switch ( type ) {
case SPOOLES_REAL :
   switch ( mode ) {
   case SUBMTX_DENSE_SUBROWS :
   case SUBMTX_SPARSE_ROWS :
   case SUBMTX_DENSE_SUBCOLUMNS :
   case SUBMTX_SPARSE_COLUMNS :
   case SUBMTX_DIAGONAL :
   case SUBMTX_BLOCK_DIAGONAL_SYM :
      break ;
   default :
      fprintf(stderr, "\n invalid mode %d\n", mode) ;
      spoolesFatal();
   }
   break ;
case SPOOLES_COMPLEX :
   switch ( mode ) {
   case SUBMTX_DENSE_SUBROWS :
   case SUBMTX_SPARSE_ROWS :
   case SUBMTX_DENSE_SUBCOLUMNS :
   case SUBMTX_SPARSE_COLUMNS :
   case SUBMTX_DIAGONAL :
   case SUBMTX_BLOCK_DIAGONAL_SYM :
   case SUBMTX_BLOCK_DIAGONAL_HERM :
      break ;
   default :
      fprintf(stderr, "\n invalid mode %d\n", mode) ;
      spoolesFatal();
   }
   break ;
default :
   fprintf(stderr, "\n invalid type %d\n", type) ;
   spoolesFatal();
   break ;
}
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setNormal(drand, 0.0, 1.0) ;
/*
   ------------------------------
   initialize the X SubMtx object
   ------------------------------
*/
MARKTIME(t1) ;
mtxX = SubMtx_new() ;
SubMtx_initRandom(mtxX, type, SUBMTX_DENSE_COLUMNS, 0, 0, 
                  nrowX, ncolX, nrowX*ncolX, ++seed) ;
SubMtx_denseInfo(mtxX, &nrowX, &ncolX, &inc1, &inc2, &entX) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize X SubMtx object",
        t2 - t1) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% X SubMtx object") ;
   fprintf(msgFile, "\n X = zeros(%d,%d) ;", nrowX, ncolX) ;
   SubMtx_writeForMatlab(mtxX, "X", msgFile) ;
   fflush(msgFile) ;
}
/*
   ------------------------------
   initialize the B SubMtx object
   ------------------------------
*/
MARKTIME(t1) ;
mtxB = SubMtx_new() ;
SubMtx_init(mtxB, type,
            SUBMTX_DENSE_COLUMNS, 0, 0, nrowB, ncolB, nrowB*ncolB) ;
SubMtx_denseInfo(mtxB, &nrowB, &ncolB, &inc1, &inc2, &entB) ;
switch ( mode ) {
case SUBMTX_DENSE_SUBROWS :
case SUBMTX_SPARSE_ROWS :
case SUBMTX_DENSE_SUBCOLUMNS :
case SUBMTX_SPARSE_COLUMNS :
   if ( SUBMTX_IS_REAL(mtxX) ) {
      DVcopy(nrowB*ncolB, entB, entX) ;
   } else if ( SUBMTX_IS_COMPLEX(mtxX) ) {
      ZVcopy(nrowB*ncolB, entB, entX) ;
   }
   break ;
default :
   if ( SUBMTX_IS_REAL(mtxX) ) {
      DVzero(nrowB*ncolB, entB) ;
   } else if ( SUBMTX_IS_COMPLEX(mtxX) ) {
      DVzero(2*nrowB*ncolB, entB) ;
   }
   break ;
}
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize B SubMtx object",
        t2 - t1) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% B SubMtx object") ;
   fprintf(msgFile, "\n B = zeros(%d,%d) ;", nrowB, ncolB) ;
   SubMtx_writeForMatlab(mtxB, "B", msgFile) ;
   fflush(msgFile) ;
}
/*
   -------------------------------------
   initialize the A matrix SubMtx object
   -------------------------------------
*/
seed++ ;
mtxA = SubMtx_new() ;
switch ( mode ) {
case SUBMTX_DENSE_SUBROWS :
case SUBMTX_SPARSE_ROWS :
   SubMtx_initRandomLowerTriangle(mtxA, type, mode, 0, 0, 
                                  nrowA, ncolA, nentA, seed, 1) ;
   break ;
case SUBMTX_DENSE_SUBCOLUMNS :
case SUBMTX_SPARSE_COLUMNS :
   SubMtx_initRandomUpperTriangle(mtxA, type, mode, 0, 0, 
                                  nrowA, ncolA, nentA, seed, 1) ;
   break ;
case SUBMTX_DIAGONAL :
case SUBMTX_BLOCK_DIAGONAL_SYM :
case SUBMTX_BLOCK_DIAGONAL_HERM :
   SubMtx_initRandom(mtxA, type, mode, 0, 0,
                     nrowA, ncolA, nentA, seed) ;
   break ;
default :
   fprintf(stderr, "\n fatal error in test_solve"
           "\n invalid mode = %d", mode) ;
   spoolesFatal();
}
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% A SubMtx object") ;
   fprintf(msgFile, "\n A = zeros(%d,%d) ;", nrowA, ncolA) ;
   SubMtx_writeForMatlab(mtxA, "A", msgFile) ;
   fflush(msgFile) ;
}
/*
   --------------------------------------------------------
   compute B = A * X (for diagonal and block diagonal)
     or    B = (I + A) * X (for lower and upper triangular)
   --------------------------------------------------------
*/
if ( SUBMTX_IS_REAL(mtxA) ) {
   DV       *colDV, *rowDV ;
   double   value, *colX, *rowA, *pBij, *pXij ;
   int      irowA, jcolX ;

   colDV = DV_new() ;
   DV_init(colDV, nrowA, NULL) ;
   colX = DV_entries(colDV) ;
   rowDV = DV_new() ;
   DV_init(rowDV, nrowA, NULL) ;
   rowA = DV_entries(rowDV) ;
   for ( jcolX = 0 ; jcolX < ncolB ; jcolX++ ) {
      SubMtx_fillColumnDV(mtxX, jcolX, colDV) ;
      for ( irowA = 0 ; irowA < nrowA ; irowA++ ) {
         SubMtx_fillRowDV(mtxA, irowA, rowDV) ;
         SubMtx_locationOfRealEntry(mtxX, irowA, jcolX, &pXij) ;
         SubMtx_locationOfRealEntry(mtxB, irowA, jcolX, &pBij) ;
         value = DVdot(nrowA, rowA, colX) ;
         switch ( mode ) {
         case SUBMTX_DENSE_SUBROWS :
         case SUBMTX_SPARSE_ROWS :
         case SUBMTX_DENSE_SUBCOLUMNS :
         case SUBMTX_SPARSE_COLUMNS :
            *pBij = *pXij + value ;
            break ;
         case SUBMTX_DIAGONAL :
         case SUBMTX_BLOCK_DIAGONAL_SYM :
            *pBij = value ;
            break ;
         }
      }
   }
   DV_free(colDV) ;
   DV_free(rowDV) ;
} else if ( SUBMTX_IS_COMPLEX(mtxA) ) {
   ZV       *colZV, *rowZV ;
   double   *colX, *rowA, *pBIij, *pBRij, *pXIij, *pXRij ;
   int      irowA, jcolX ;

   colZV = ZV_new() ;
   ZV_init(colZV, nrowA, NULL) ;
   colX = ZV_entries(colZV) ;
   rowZV = ZV_new() ;
   ZV_init(rowZV, nrowA, NULL) ;
   rowA = ZV_entries(rowZV) ;
   for ( jcolX = 0 ; jcolX < ncolB ; jcolX++ ) {
      SubMtx_fillColumnZV(mtxX, jcolX, colZV) ;
      for ( irowA = 0 ; irowA < nrowA ; irowA++ ) {
         SubMtx_fillRowZV(mtxA, irowA, rowZV) ;
         SubMtx_locationOfComplexEntry(mtxX, 
                                       irowA, jcolX, &pXRij, &pXIij) ;
         SubMtx_locationOfComplexEntry(mtxB, 
                                       irowA, jcolX, &pBRij, &pBIij) ;
         ZVdotU(nrowA, rowA, colX, &rdot, &idot) ;
         switch ( mode ) {
         case SUBMTX_DENSE_SUBROWS :
         case SUBMTX_SPARSE_ROWS :
         case SUBMTX_DENSE_SUBCOLUMNS :
         case SUBMTX_SPARSE_COLUMNS :
            *pBRij = *pXRij + rdot ;
            *pBIij = *pXIij + idot ;
            break ;
         case SUBMTX_DIAGONAL :
         case SUBMTX_BLOCK_DIAGONAL_SYM :
         case SUBMTX_BLOCK_DIAGONAL_HERM :
            *pBRij = rdot ;
            *pBIij = idot ;
            break ;
         }
      }
   }
   ZV_free(colZV) ;
   ZV_free(rowZV) ;
}
/*
   ----------------------
   print out the matrices
   ----------------------
*/
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% X SubMtx object") ;
   fprintf(msgFile, "\n X = zeros(%d,%d) ;", nrowX, ncolX) ;
   SubMtx_writeForMatlab(mtxX, "X", msgFile) ;
   fprintf(msgFile, "\n\n %% A SubMtx object") ;
   fprintf(msgFile, "\n A = zeros(%d,%d) ;", nrowA, ncolA) ;
   SubMtx_writeForMatlab(mtxA, "A", msgFile) ;
   fprintf(msgFile, "\n\n %% B SubMtx object") ;
   fprintf(msgFile, "\n B = zeros(%d,%d) ;", nrowB, ncolB) ;
   SubMtx_writeForMatlab(mtxB, "B", msgFile) ;
   fflush(msgFile) ;
}
/*
   -----------------
   check with matlab
   -----------------
*/
if ( msglvl > 1 ) {
   switch ( mode ) {
   case SUBMTX_DENSE_SUBROWS :
   case SUBMTX_SPARSE_ROWS :
   case SUBMTX_DENSE_SUBCOLUMNS :
   case SUBMTX_SPARSE_COLUMNS :
      fprintf(msgFile,
              "\n\n emtx   = abs(B - X - A*X) ;"
              "\n\n condA = cond(eye(%d,%d) + A)"
              "\n\n maxabsZ = max(max(abs(emtx))) ", nrowA, nrowA) ;
      fflush(msgFile) ;
      break ;
   case SUBMTX_DIAGONAL :
   case SUBMTX_BLOCK_DIAGONAL_SYM :
   case SUBMTX_BLOCK_DIAGONAL_HERM :
      fprintf(msgFile,
              "\n\n emtx   = abs(B - A*X) ;"
              "\n\n condA = cond(A)"
              "\n\n maxabsZ = max(max(abs(emtx))) ") ;
      fflush(msgFile) ;
      break ;
   }
}
/*
   ----------------------------------------
   compute the solve DY = B or (I + A)Y = B
   ----------------------------------------
*/
SubMtx_solve(mtxA, mtxB) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% Y SubMtx object") ;
   fprintf(msgFile, "\n Y = zeros(%d,%d) ;", nrowB, ncolB) ;
   SubMtx_writeForMatlab(mtxB, "Y", msgFile) ;
   fprintf(msgFile,
           "\n\n %% solerror   = abs(Y - X) ;"
           "\n\n solerror   = abs(Y - X) ;"
           "\n\n maxabserror = max(max(solerror)) ") ;
   fflush(msgFile) ;
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
SubMtx_free(mtxA) ;
SubMtx_free(mtxX) ;
SubMtx_free(mtxB) ;
Drand_free(drand) ;

fprintf(msgFile, "\n") ;

return(1) ; }
Beispiel #23
0
/*
   -----------------------------------------------------------
   A contains the following data from the A = QR factorization

   A(1:ncolA,1:ncolA) = R
   A(j+1:nrowA,j) is v_j, the j-th householder vector, 
       where v_j[j] = 1.0

   we compute Y = Q^T X when A is real
          and Y = Q^H X when A is complex

   NOTE: A, Y and X must be column major.
   NOTE: Y and X can be the same object,
         in which case X is overwritten with Y

   created -- 98dec10, cca
   -----------------------------------------------------------
*/
void
A2_applyQT (
   A2     *Y,
   A2     *A,
   A2     *X,
   DV     *workDV,
   int    msglvl,
   FILE   *msgFile
) {
double   *betas ;
int      irowA, jcolA, jcolX, ncolA, ncolX, nrowA ;
/*
   ---------------
   check the input
   ---------------
*/
if ( A == NULL ) {
   fprintf(stderr, "\n fatal error in A2_applyQT()"
           "\n A is NULL\n") ;
   exit(-1) ;
}
if ( X == NULL ) {
   fprintf(stderr, "\n fatal error in A2_applyQT()"
           "\n X is NULL\n") ;
   exit(-1) ;
}
if ( workDV == NULL ) {
   fprintf(stderr, "\n fatal error in A2_applyQT()"
           "\n workDV is NULL\n") ;
   exit(-1) ;
}
if ( msglvl > 0 && msgFile == NULL ) {
   fprintf(stderr, "\n fatal error in A2_applyQT()"
           "\n msglvl > 0 and msgFile is NULL\n") ;
   exit(-1) ;
}
nrowA = A2_nrow(A) ;
ncolA = A2_ncol(A) ;
ncolX = A2_ncol(X) ;
if ( nrowA <= 0 ) {
   fprintf(stderr, "\n fatal error in A2_applyQT()"
           "\n nrowA = %d\n", nrowA) ;
   exit(-1) ;
}
if ( ncolA <= 0 ) {
   fprintf(stderr, "\n fatal error in A2_applyQT()"
           "\n ncolA = %d\n", nrowA) ;
   exit(-1) ;
}
if ( nrowA != A2_nrow(X) ) {
   fprintf(stderr, "\n fatal error in A2_applyQT()"
           "\n nrowA = %d, nrowX = %d\n", nrowA, A2_nrow(X)) ;
   exit(-1) ;
}
switch ( A->type ) {
case SPOOLES_REAL :
case SPOOLES_COMPLEX :
   break ;
default :
   fprintf(stderr, "\n fatal error in A2_applyQT()"
           "\n invalid type for A\n") ;
   exit(-1) ;
}
if ( A->type != X->type ) {
   fprintf(stderr, "\n fatal error in A2_applyQT()"
           "\n A->type = %d, X->type = %d\n", A->type, X->type) ;
   exit(-1) ;
}
if ( A2_inc1(A) != 1 ) {
   fprintf(stderr, "\n fatal error in A2_applyQT()"
           "\n A->inc1 = %d \n", A2_inc1(A)) ; 
   exit(-1) ;
}
if ( A2_inc1(X) != 1 ) {
   fprintf(stderr, "\n fatal error in A2_applyQT()"
           "\n X->inc1 = %d, \n", A2_inc1(X)) ;
   exit(-1) ;
}
/*
   --------------------------------------------------
   compute the beta values, beta_j = 2./(V_j^H * V_j)
   --------------------------------------------------
*/
DV_setSize(workDV, ncolA) ;
betas = DV_entries(workDV) ;
if ( A2_IS_REAL(A) ) {
   int   irowA, jcolA ;
   double   sum ;
   double   *colA ;

   for ( jcolA = 0 ; jcolA < ncolA ; jcolA++ ) {
      sum = 1.0 ;
      colA = A2_column(A, jcolA) ;
      for ( irowA = jcolA + 1 ; irowA < nrowA ; irowA++ ) {
         sum += colA[irowA] * colA[irowA] ;
      }
      betas[jcolA] = 2./sum ;
   }
} else {
   double   ival, rval, sum ;
   double   *colA ;

   for ( jcolA = 0 ; jcolA < ncolA ; jcolA++ ) {
      sum = 1.0 ;
      colA = A2_column(A, jcolA) ;
      for ( irowA = jcolA + 1 ; irowA < nrowA ; irowA++ ) {
         rval = colA[2*irowA] ; ival = colA[2*irowA+1] ;
         sum += rval*rval + ival*ival ;
      }
      betas[jcolA] = 2./sum ;
   }
}
/*
   ------------------------------------------
   loop over the number of columns in X and Y
   ------------------------------------------
*/
for ( jcolX = 0 ; jcolX < ncolX ; jcolX++ ) {
   double   *V, *colX, *colY ;
   int      jcolV ;
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n\n %% jcolX = %d", jcolX) ;
      fflush(msgFile) ;
   }
/*
   -------------------------------
   copy X(:,jcolX) into Y(:,jcolX)
   -------------------------------
*/
   colY = A2_column(Y, jcolX) ;
   colX = A2_column(X, jcolX) ;
   if ( A2_IS_REAL(A) ) {
      DVcopy(nrowA, colY, colX) ;
   } else {
      DVcopy(2*nrowA, colY, colX) ;
   }
   for ( jcolV = 0 ; jcolV < ncolA ; jcolV++ ) {
      double   beta ;
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n   %% jcolV = %d", jcolV) ;
         fflush(msgFile) ;
      }
/*
      ------------------------------------------------------------
      update colY = (I - beta_jcolV * V_jcolV * V_jcolV^T)colY
                  = colY - beta_jcolV * V_jcolV * V_jcolV^T * colY
                  = colY - (beta_jcolV * V_jcolV^T * Y) * V_jcolV 
      ------------------------------------------------------------
*/
      V = A2_column(A, jcolV) ;
      beta = betas[jcolV] ;
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n   %% beta = %12.4e", beta) ;
         fflush(msgFile) ;
      }
      if ( A2_IS_REAL(A) ) {
         double   fac, sum = colY[jcolV] ;
         int      irow ;
         for ( irow = jcolV + 1 ; irow < nrowA ; irow++ ) {
            if ( msglvl > 2 ) {
               fprintf(msgFile, 
                       "\n      %% V[%d] = %12.4e, X[%d] = %12.4e",
                       irow, V[irow], irow, colY[irow]) ;
               fflush(msgFile) ;
            }
            sum += V[irow] * colY[irow] ;
         }
         if ( msglvl > 2 ) {
            fprintf(msgFile, "\n   %% sum = %12.4e", sum) ;
            fflush(msgFile) ;
         }
         fac = beta * sum ;
         if ( msglvl > 2 ) {
            fprintf(msgFile, "\n   %% fac = %12.4e", fac) ;
            fflush(msgFile) ;
         }
         colY[jcolV] -= fac ;
         for ( irow = jcolV + 1 ; irow < nrowA ; irow++ ) {
            colY[irow] -= fac * V[irow] ;
         }
      } else {
         double   rfac, ifac, 
                  rsum = colY[2*jcolV], isum = colY[2*jcolV+1] ;
         int      irow ;
         for ( irow = jcolV + 1 ; irow < nrowA ; irow++ ) {
            double   Vi, Vr, Yi, Yr ;
            Vr = V[2*irow] ; Vi = V[2*irow+1] ;
            Yr = colY[2*irow] ; Yi = colY[2*irow+1] ;
            rsum += Vr*Yr + Vi*Yi ;
            isum += Vr*Yi - Vi*Yr ;
         }
         rfac = beta * rsum ;
         ifac = beta * isum ;
         colY[2*jcolV]   -= rfac ;
         colY[2*jcolV+1] -= ifac ;
         for ( irow = jcolV + 1 ; irow < nrowA ; irow++ ) {
            double   Vi, Vr ;
            Vr = V[2*irow] ; Vi = V[2*irow+1] ;
            colY[2*irow]   -= rfac*Vr - ifac*Vi ;
            colY[2*irow+1] -= rfac*Vi + ifac*Vr ;
         }
      }
   }
}
return ; }
Beispiel #24
0
/*
   -----------------------
   input a matrix

   created -- 98jan28, cca
   -----------------------
*/
static void
inputMatrix (
   InpMtx   *inpmtx,
   int       nrow,
   int       ncol,
   int       rowstride,
   int       colstride,
   int       rowind[],
   int       colind[],
   double    mtxent[]
) {
int      col, ii, jj, kk, nent, row ;
int      *ivec1, *ivec2 ;

prepareToAddNewEntries(inpmtx, nrow*ncol) ;
nent  = inpmtx->nent ;
ivec1 = IV_entries(&inpmtx->ivec1IV) ;
ivec2 = IV_entries(&inpmtx->ivec2IV) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   for ( jj = 0, kk = nent ; jj < ncol ; jj++ ) {
      col = colind[jj] ;
      for ( ii = 0 ; ii < nrow ; ii++, kk++ ) {
         row = rowind[ii] ;
         ivec1[kk] = row ;
         ivec2[kk] = col ;
      }
   }
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   for ( jj = 0, kk = nent ; jj < ncol ; jj++ ) {
      col = colind[jj] ;
      for ( ii = 0 ; ii < nrow ; ii++, kk++ ) {
         row = rowind[ii] ;
         ivec1[kk] = col ;
         ivec2[kk] = row ;
      }
   }
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   for ( jj = 0, kk = nent ; jj < ncol ; jj++ ) {
      col = colind[jj] ;
      for ( ii = 0 ; ii < nrow ; ii++, kk++ ) {
         row = rowind[ii] ;
         if ( row <= col ) {
            ivec1[kk] = row ;
         } else {
            ivec1[kk] = col ;
         }
         ivec2[kk] = col - row ;
      }
   }
}
IV_setSize(&inpmtx->ivec1IV, nent + nrow*ncol) ;
IV_setSize(&inpmtx->ivec2IV, nent + nrow*ncol) ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   double   *dvec = DV_entries(&inpmtx->dvecDV) ;
   int      ij ;
   for ( jj = 0, kk = nent ; jj < ncol ; jj++ ) {
      for ( ii = 0 ; ii < nrow ; ii++, kk++ ) {
         ij = ii*rowstride + jj*colstride ;
         dvec[kk] = mtxent[ij] ;
      }
   }
   DV_setSize(&inpmtx->dvecDV, nent + nrow*ncol) ;
} if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   double   *dvec = DV_entries(&inpmtx->dvecDV) ;
   int      ij ;
   for ( jj = 0, kk = nent ; jj < ncol ; jj++ ) {
      for ( ii = 0 ; ii < nrow ; ii++, kk++ ) {
         ij = ii*rowstride + jj*colstride ;
         dvec[2*kk]   = mtxent[2*ij]   ;
         dvec[2*kk+1] = mtxent[2*ij+1] ;
      }
   }
   DV_setSize(&inpmtx->dvecDV,  2*(nent + nrow*ncol)) ;
}
inpmtx->nent += nrow*ncol ;
inpmtx->storageMode = INPMTX_RAW_DATA ;

return ; }
Beispiel #25
0
/*
   --------------------------------------------------------------
   purpose -- create and return an A2 object that contains rows
              of A and rows from update matrices of the children.
              the matrix may not be in staircase form

   created -- 98may25, cca
   --------------------------------------------------------------
*/
A2 *
FrontMtx_QR_assembleFront (
   FrontMtx   *frontmtx,
   int        J,
   InpMtx     *mtxA,
   IVL        *rowsIVL,
   int        firstnz[],
   int        colmap[],
   Chv        *firstchild,
   DV         *workDV,
   int        msglvl,
   FILE       *msgFile
) {
A2       *frontJ ;
Chv      *chvI ;
double   *rowI, *rowJ, *rowentA ;
int      ii, irow, irowA, irowI, jcol, jj, jrow, ncolI, ncolJ, 
         nentA, nrowI, nrowJ, nrowFromA ;
int      *colindA, *colindI, *colindJ, *map, *rowids, *rowsFromA ;
/*
   ---------------
   check the input
   ---------------
*/
if ( frontmtx == NULL || mtxA == NULL || rowsIVL == NULL
   || (msglvl > 0 && msgFile == NULL) ) {
   fprintf(stderr, "\n fatal error in FrontMtx_QR_assembleFront()"
           "\n bad input\n") ;
   exit(-1) ;
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n\n inside FrontMtx_QR_assembleFront(%d)", J) ;
   fflush(msgFile) ;
}
/*
   --------------------------------------------------
   set up the map from global to local column indices
   --------------------------------------------------
*/
FrontMtx_columnIndices(frontmtx, J, &ncolJ, &colindJ) ;
for ( jcol = 0 ; jcol < ncolJ ; jcol++ ) {
   colmap[colindJ[jcol]] = jcol ;
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n front %d's column indices", J) ;
   IVfprintf(msgFile, ncolJ, colindJ) ;
   fflush(msgFile) ;
}
/*
   -------------------------------------------------
   compute the size of the front and map the global 
   indices of the update matrices into local indices
   -------------------------------------------------
*/
IVL_listAndSize(rowsIVL, J, &nrowFromA, &rowsFromA) ;
nrowJ = nrowFromA ;
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n %d rows from A", nrowFromA) ;
   fflush(msgFile) ;
}
for ( chvI = firstchild ; chvI != NULL ; chvI = chvI->next ) {
   nrowJ += chvI->nD ;
   Chv_columnIndices(chvI, &ncolI, &colindI) ;
   for ( jcol = 0 ; jcol < ncolI ; jcol++ ) {
      colindI[jcol] = colmap[colindI[jcol]] ;
   }
   if ( msglvl > 3 ) {
      fprintf(msgFile, "\n %d rows from child %d", chvI->nD, chvI->id) ;
      fflush(msgFile) ;
   }
}
/*
   ----------------------------------------------------------
   get workspace for the rowids[nrowJ] and map[nrowJ] vectors
   ----------------------------------------------------------
*/
if ( sizeof(int) == sizeof(double) ) {
   DV_setSize(workDV, 2*nrowJ) ;
} else if ( 2*sizeof(int) == sizeof(double) ) {
   DV_setSize(workDV, nrowJ) ;
}
rowids = (int *) DV_entries(workDV) ;
map    = rowids + nrowJ ;
IVramp(nrowJ, rowids, 0, 1) ;
IVfill(nrowJ, map, -1) ;
/*
   -----------------------------------------------------------------
   get the map from incoming rows to their place in the front matrix
   -----------------------------------------------------------------
*/
for ( irow = jrow = 0 ; irow < nrowFromA ; irow++, jrow++ ) {
   irowA = rowsFromA[irow] ;
   map[jrow] = colmap[firstnz[irowA]] ;
}
for ( chvI = firstchild ; chvI != NULL ; chvI = chvI->next ) {
   nrowI = chvI->nD ;
   Chv_columnIndices(chvI, &ncolI, &colindI) ;
   for ( irow = 0 ; irow < nrowI ; irow++, jrow++ ) {
      map[jrow] = colindI[irow] ;
   }
}
IV2qsortUp(nrowJ, map, rowids) ;
for ( irow = 0 ; irow < nrowJ ; irow++ ) {
   map[rowids[irow]] = irow ;
}
/*
   ----------------------------
   allocate the A2 front object
   ----------------------------
*/
frontJ = A2_new() ;
A2_init(frontJ, frontmtx->type, nrowJ, ncolJ, ncolJ, 1, NULL) ;
A2_zero(frontJ) ;
/*
   ------------------------------------
   load the original rows of the matrix
   ------------------------------------
*/
for ( jrow = 0 ; jrow < nrowFromA ; jrow++ ) {
   irowA = rowsFromA[jrow] ;
   rowJ  = A2_row(frontJ, map[jrow]) ;
   if ( A2_IS_REAL(frontJ) ) {
      InpMtx_realVector(mtxA, irowA, &nentA, &colindA, &rowentA) ;
   } else if ( A2_IS_COMPLEX(frontJ) ) {
      InpMtx_complexVector(mtxA, irowA, &nentA, &colindA, &rowentA) ;
   }
   if ( msglvl > 3 ) {
      fprintf(msgFile, "\n loading row %d", irowA) ;
      fprintf(msgFile, "\n global indices") ;
      IVfprintf(msgFile, nentA, colindA) ;
      fflush(msgFile) ;
   }
   if ( A2_IS_REAL(frontJ) ) {
      for ( ii = 0 ; ii < nentA ; ii++ ) {
         jj = colmap[colindA[ii]] ;
         rowJ[jj] = rowentA[ii] ;
      }
   } else if ( A2_IS_COMPLEX(frontJ) ) {
      for ( ii = 0 ; ii < nentA ; ii++ ) {
         jj = colmap[colindA[ii]] ;
         rowJ[2*jj]   = rowentA[2*ii]   ;
         rowJ[2*jj+1] = rowentA[2*ii+1] ;
      }
   }
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n after assembling rows of A") ;
   A2_writeForHumanEye(frontJ, msgFile) ;
   fflush(msgFile) ;
}
/*
   ----------------------------------
   load the updates from the children 
   ----------------------------------
*/
for ( chvI = firstchild ; chvI != NULL ; chvI = chvI->next ) {
   nrowI = chvI->nD ;
   Chv_columnIndices(chvI, &ncolI, &colindI) ;
   if ( msglvl > 3 ) {
      fprintf(msgFile, "\n loading child %d", chvI->id) ;
      fprintf(msgFile, "\n child's column indices") ;
      IVfprintf(msgFile, ncolI, colindI) ;
      Chv_writeForHumanEye(chvI, msgFile) ;
      fflush(msgFile) ;
   }
   rowI = Chv_entries(chvI) ;
   for ( irowI = 0 ; irowI < nrowI ; irowI++, jrow++ ) {
      rowJ = A2_row(frontJ, map[jrow]) ;
      if ( A2_IS_REAL(frontJ) ) {
         for ( ii = irowI ; ii < ncolI ; ii++ ) {
            jj = colindI[ii] ;
            rowJ[jj] = rowI[ii] ;
         }
         rowI += ncolI - irowI - 1 ;
      } else if ( A2_IS_COMPLEX(frontJ) ) {
         for ( ii = irowI ; ii < ncolI ; ii++ ) {
            jj = colindI[ii] ;
            rowJ[2*jj]   = rowI[2*ii]   ;
            rowJ[2*jj+1] = rowI[2*ii+1] ;
         }
         rowI += 2*(ncolI - irowI - 1) ;
      }
   }
   if ( msglvl > 3 ) {
      fprintf(msgFile, "\n after assembling child %d", chvI->id) ;
      A2_writeForHumanEye(frontJ, msgFile) ;
      fflush(msgFile) ;
   }
}
return(frontJ) ; }
Beispiel #26
0
/*
   --------------------------------------------------------------
   purpose -- compute A = QR, where Q is a product of householder
              vectors, (I - beta_j v_j v_j^T). on return, v_j is 
              found in the lower triangle of A, v_j(j) = 1.0.

   return value -- # of floating point operations

   created -- 98may25, cca
   --------------------------------------------------------------
*/
double
A2_QRreduce (
   A2       *mtxA,
   DV       *workDV,
   int      msglvl,
   FILE     *msgFile
) {
A2       tempA ;
double   nops ;
double   beta0 ;
double   *colA, *H0, *W0 ;
int      inc1, inc2, jcol, lastrow, length, ncolA, nrowA, nstep ;
/*
   ---------------
   check the input
   ---------------
*/
if (   mtxA == NULL || workDV == NULL
    || (msglvl > 0 && msgFile == NULL) ) {
   fprintf(stderr, "\n fatal error in A2_QRreduce()"
           "\n bad input\n") ;
   exit(-1) ;
}
if ( ! (A2_IS_REAL(mtxA) || A2_IS_COMPLEX(mtxA)) ) {
   fprintf(stderr, "\n fatal error in A2_QRreduce()"
           "\n matrix must be real or complex\n") ;
   exit(-1) ;
}
nrowA = A2_nrow(mtxA) ; 
ncolA = A2_ncol(mtxA) ;
inc1  = A2_inc1(mtxA) ;
inc2  = A2_inc2(mtxA) ;
if ( A2_IS_REAL(mtxA) ) {
   DV_setSize(workDV, nrowA + ncolA) ;
   H0 = DV_entries(workDV) ;
   W0 = H0 + nrowA ;
} else if ( A2_IS_COMPLEX(mtxA) ) {
   DV_setSize(workDV, 2*(nrowA + ncolA)) ;
   H0 = DV_entries(workDV) ;
   W0 = H0 + 2*nrowA ;
}
/*
   -------------------------------------------------
   determine the number of steps = min(ncolA, nrowA)
   -------------------------------------------------
*/
nstep = (ncolA <= nrowA) ? ncolA : nrowA ;
/*
   -------------------
   loop over the steps
   -------------------
*/
nops = 0.0 ; 
for ( jcol = 0 ; jcol < nstep ; jcol++ ) {
   if ( msglvl > 3 ) {
      fprintf(msgFile, "\n %% jcol = %d", jcol) ;
   }
/*
   ----------------------------------
   copy the column of A into a vector
   and find the last nonzero element
   ----------------------------------
*/
   A2_subA2(&tempA, mtxA, jcol, nrowA-1, jcol, ncolA-1) ;
   length = 1 + copyIntoVec1(&tempA, H0, msglvl, msgFile) ;
   lastrow = jcol + length - 1 ;
   if ( msglvl > 5 ) {
      fprintf(msgFile, 
            "\n %% return from copyIntoVec1, length = %d, lastrow = %d",
            length, lastrow) ;
   }
/*
   ------------------------------
   compute the Householder vector
   and place into the column of A
   ------------------------------
*/
   colA = A2_column(mtxA, jcol) ;
   if ( A2_IS_REAL(mtxA) ) {
      nops += getHouseholderVector1(SPOOLES_REAL, length, H0, 
                                    &beta0, msglvl, msgFile) ;
      A2_subA2(&tempA, mtxA, jcol, lastrow, jcol, jcol) ;
      A2_setColumn(&tempA, H0, 0) ;
      H0[0] = 1.0 ;
   } else if ( A2_IS_COMPLEX(mtxA) ) {
      nops += getHouseholderVector1(SPOOLES_COMPLEX, length, H0, 
                                    &beta0, msglvl, msgFile) ;
      A2_subA2(&tempA, mtxA, jcol, lastrow, jcol, jcol) ;
      A2_setColumn(&tempA, H0, 0) ;
      H0[0] = 1.0 ; H0[1] = 0.0 ;
   }
   if ( msglvl > 5 && jcol == 0 ) {
      fprintf(msgFile, "\n %% beta0 = %12.4e;", beta0) ;
   }
   if ( beta0 != 0.0 && jcol + 1 < ncolA ) {
      A2_subA2(&tempA, mtxA, jcol, lastrow, jcol+1, ncolA-1) ;
/*
      ------------------------------------------------
      compute w = v^T * A(jcol:lastrow,jcol+1:nrowA-1)
      ------------------------------------------------
*/
      if ( msglvl > 3 ) {
         fprintf(msgFile, "\n %% compute w") ;
      }
      nops += computeW1(&tempA, H0, W0, msglvl, msgFile) ;
/*
      -------------------------------------------------
      update A(jcol:lastrow,jcol+1:nrowA-1) -= beta*v*w
      -------------------------------------------------
*/
      if ( msglvl > 3 ) {
         fprintf(msgFile, "\n %% update A") ;
      }
      nops += updateA1(&tempA, H0, beta0, W0, msglvl, msgFile) ;
   }
}
return(nops) ; }
Beispiel #27
0
/*
   ---------------------------------------
   purpose -- set the fields of the object

   created -- 98may01, cca
   ---------------------------------------
*/
void
SubMtx_setFields (
   SubMtx   *mtx,
   int      type,
   int      mode,
   int      rowid,
   int      colid,
   int      nrow,
   int      ncol,
   int      nent
) {
double   *dbuffer ;
int      nint ;
int      *ibuffer ;
/*
   ---------------
   check the input
   ---------------
*/
if (  mtx == NULL ) {
   fprintf(stderr, "\n fatal error in SubMtx_setFields()"
           "\n mtx is NULL\n") ;
   exit(-1) ;
}
if (  nrow <= 0 ) {
   fprintf(stderr, "\n fatal error in SubMtx_setFields()"
           "\n nrow = %d <= 0\n", nrow) ;
   exit(-1) ;
}
if (  ncol <= 0 ) {
   fprintf(stderr, "\n fatal error in SubMtx_setFields()"
           "\n ncol = %d <= 0\n", ncol) ;
   exit(-1) ;
}
if (  nrow <= 0 ) {
   fprintf(stderr, "\n fatal error in SubMtx_setFields()"
           "\n nent = %d <= 0\n", nent) ;
   exit(-1) ;
}
switch ( type ) {
case SPOOLES_REAL :
case SPOOLES_COMPLEX :
   break ;
default :
   fprintf(stderr, "\n fatal error in SubMtx_setFields()"
           "\n invalid type %d", type) ;
   exit(-1) ;
}
switch ( mode ) {
case SUBMTX_DENSE_ROWS :
case SUBMTX_DENSE_COLUMNS :
case SUBMTX_DIAGONAL :
case SUBMTX_SPARSE_ROWS :
case SUBMTX_SPARSE_COLUMNS :
case SUBMTX_SPARSE_TRIPLES :
case SUBMTX_DENSE_SUBROWS :
case SUBMTX_DENSE_SUBCOLUMNS :
case SUBMTX_BLOCK_DIAGONAL_SYM :
case SUBMTX_BLOCK_DIAGONAL_HERM :
   break ;
default :
   fprintf(stderr, "\n fatal error in SubMtx_setFields()"
           "\n invalid mode %d", mode) ;
   exit(-1) ;
}
dbuffer = DV_entries(&mtx->wrkDV) ;
ibuffer = (int *) dbuffer ;
/*
   ---------------------
   set the scalar fields
   ---------------------
*/
mtx->type  = ibuffer[0] = type  ;
mtx->mode  = ibuffer[1] = mode  ;
mtx->rowid = ibuffer[2] = rowid ;
mtx->colid = ibuffer[3] = colid ;
mtx->nrow  = ibuffer[4] = nrow  ;
mtx->ncol  = ibuffer[5] = ncol  ;
mtx->nent  = ibuffer[6] = nent  ;
switch ( mode ) {
case SUBMTX_DENSE_ROWS :
case SUBMTX_DENSE_COLUMNS :
case SUBMTX_DIAGONAL :
   nint = 7 + mtx->nrow + mtx->ncol ;
   break ;
case SUBMTX_SPARSE_ROWS :
   nint = 7 + mtx->nrow + mtx->ncol + mtx->nrow + mtx->nent ;
   break ;
case SUBMTX_SPARSE_COLUMNS :
   nint = 7 + mtx->nrow + mtx->ncol + mtx->ncol + mtx->nent ;
   break ;
case SUBMTX_SPARSE_TRIPLES :
   nint = 7 + mtx->nrow + mtx->ncol + mtx->nent + mtx->nent ;
   break ;
case SUBMTX_DENSE_SUBROWS :
   nint = 7 + mtx->nrow + mtx->ncol + mtx->nrow + mtx->nrow ;
   break ;
case SUBMTX_DENSE_SUBCOLUMNS :
   nint = 7 + mtx->nrow + mtx->ncol + mtx->ncol + mtx->ncol ;
   break ;
case SUBMTX_BLOCK_DIAGONAL_SYM :
case SUBMTX_BLOCK_DIAGONAL_HERM :
   nint = 7 + mtx->nrow + mtx->ncol + mtx->nrow ;
   break ;
}
if ( sizeof(int) == sizeof(double) ) {
   mtx->entries = dbuffer + nint ;
} else if ( 2*sizeof(int) == sizeof(double) ) {
   mtx->entries = dbuffer + (nint+1)/2 ;
}
return ; }
Beispiel #28
0
/*
   ----------------------------
   purpose -- set the fields

   created -- 98apr30, cca
   ----------------------------
*/
void
Chv_setFields (
   Chv     *chv,
   int      id,
   int      nD,
   int      nL,
   int      nU,
   int      type,
   int      symflag
) {
double   *dbuffer ;
int      nint     ;
int      *ibuffer ;
/*
   ---------------
   check the input
   ---------------
*/
if (  chv == NULL || nD <= 0 || nL < 0 || nU < 0 ) {
   fprintf(stderr, "\n fatal error in Chv_setFields()"
           "\n bad input, chv %p, nD %d, nL %d, nU %d\n", 
           chv, nD, nL, nU) ;
   exit(-1) ;
}
switch ( type ) {
case SPOOLES_REAL :
   switch ( symflag ) {
   case SPOOLES_SYMMETRIC :
   case SPOOLES_NONSYMMETRIC :
      break ;
   default :
      fprintf(stderr, 
           "\n fatal error in Chv_setFields()"
           "\n type = SPOOLES_REAL, symflag = %d"
           "\n must be SPOOLES_SYMMETRIC or SPOOLES_NONSYMMETRIC\n", 
           symflag) ;
      exit(-1) ;
   }
   break ;
case SPOOLES_COMPLEX :
   switch ( symflag ) {
   case SPOOLES_SYMMETRIC :
   case SPOOLES_HERMITIAN :
   case SPOOLES_NONSYMMETRIC :
      break ;
   default :
      fprintf(stderr, 
              "\n fatal error in Chv_setFields()"
              "\n type = SPOOLES_COMPLEX, symflag = %d"
              "\n must be SPOOLES_SYMMETRIC, SPOOLES_HERMITIAN"
              "\n or SPOOLES_NONSYMMETRIC\n",
              symflag) ;
      exit(-1) ;
   }
   break ;
default :
   fprintf(stderr, 
     "\n fatal error in Chv_setFields()"
     "\n type = %d"
     "\n must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
     type) ;
   exit(-1) ;
} 
dbuffer = DV_entries(&chv->wrkDV) ;
ibuffer = (int *) dbuffer ;
/*
   ---------------------
   set the scalar fields
   ---------------------
*/
chv->id      = ibuffer[0] = id      ;
chv->nD      = ibuffer[1] = nD      ;
chv->nL      = ibuffer[2] = nL      ;
chv->nU      = ibuffer[3] = nU      ;
chv->type    = ibuffer[4] = type    ;
chv->symflag = ibuffer[5] = symflag ;
/*
   -------------------------------------------
   set the colind, rowind and entries pointers
   -------------------------------------------
*/
chv->colind = ibuffer + 6 ;
nint = 6 + nD + nU ;
if ( symflag == SPOOLES_NONSYMMETRIC ) {
   chv->rowind = chv->colind + nD + nU ;
   nint += nD + nL ;
} else {
   chv->rowind = NULL ;
}
if ( sizeof(int) == sizeof(double) ) {
   chv->entries = dbuffer + nint ;
} else if ( 2*sizeof(int) == sizeof(double) ) {
   chv->entries = dbuffer + (nint + 1)/2 ;
}
return ; }
Beispiel #29
0
/*
   ------------------------------------------------------------------
   to fill xDV and yDV with a log10 profile of the magnitudes of
   the entries in the DV object. tausmall and tau big provide
   cutoffs within which to examine the entries. pnzero, pnsmall 
   and pnbig are addresses to hold the number of entries zero,
   smaller than tausmall and larger than taubig, respectively.

   created -- 97feb14, cca
   ------------------------------------------------------------------
*/
void
DV_log10profile (
   DV      *dv,
   int      npts,
   DV       *xDV,
   DV       *yDV,
   double   tausmall,
   double   taubig,
   int      *pnzero,
   int      *pnsmall,
   int      *pnbig
) {
double   deltaVal, maxval, minval, val ;
double   *dvec, *sums, *x, *y ;
int      ii, ipt, nbig, nsmall, nzero, size ;
/*
   ---------------
   check the input
   ---------------
*/
if ( dv == NULL || npts <= 0 || xDV == NULL || yDV == NULL
   || tausmall < 0.0 || taubig < 0.0 || tausmall > taubig
   || pnzero == NULL || pnsmall == NULL || pnbig == NULL ) {
   fprintf(stderr, 
       "\n fatal error in DV_log10profile(%p,%d,%p,%p,%f,%f,%p,%p,%p)"
       "\n bad input\n",
       dv, npts, xDV, yDV, tausmall, taubig, pnzero, pnsmall, pnbig) ;
   exit(-1) ;
}
/*
   -------------------------------------
   find the largest and smallest entries 
   in the range [tausmall, taubig]
   -------------------------------------
*/
nbig = nsmall = nzero = 0 ;
minval = maxval = 0.0 ;
DV_sizeAndEntries(dv, &size, &dvec) ;
for ( ii = 0 ; ii < size ; ii++ ) {
   val = fabs(dvec[ii]) ;
   if ( val == 0.0 ) {
      nzero++ ;
   } else if ( val <= tausmall ) {
      nsmall++ ;
   } else if ( val >= taubig ) {
      nbig++ ;
   } else {
      if ( minval == 0.0 || minval > val ) {
         minval = val ;
      }
      if ( maxval < val ) {
         maxval = val ;
      }
   }
}
*pnzero  = nzero  ;
*pnsmall = nsmall ;
*pnbig   = nbig   ;
#if MYDEBUG > 0
fprintf(stdout, 
        "\n nzero = %d, minval = %e, nsmall = %d, maxval = %e, nbig = %d",
        nzero, minval, nsmall, maxval, nbig) ;
#endif
/*
   ------------------
   set up the buckets
   ------------------
*/
DV_setSize(xDV, npts) ;
DV_setSize(yDV, npts) ;
x = DV_entries(xDV) ;
y = DV_entries(yDV) ;
sums = DVinit(npts, 0.0) ;
minval = log10(minval) ;
maxval = log10(maxval) ;
/*
minval = log10(tausmall) ;
maxval = log10(taubig) ;
*/
deltaVal = (maxval - minval)/(npts - 1) ;
DVfill(npts, x, 0.0) ;
DVfill(npts, y, 0.0) ;
/*
   --------------------------------
   fill the sums and counts vectors
   --------------------------------
*/
for ( ii = 0 ; ii < size ; ii++ ) {
   val = fabs(dvec[ii]) ;
   if ( tausmall < val && val < taubig ) {
      ipt = (log10(val) - minval) / deltaVal ;
      sums[ipt] += val ;
      y[ipt]++ ;
   }
}
#if MYDEBUG > 0
fprintf(stdout, "\n sum(y) = %.0f", DV_sum(yDV)) ;
#endif
/*
   ---------------------------
   set the x-coordinate vector
   ---------------------------
*/
for ( ipt = 0 ; ipt < npts ; ipt++ ) {
   if ( sums[ipt] == 0.0 ) {
      x[ipt] = minval + ipt*deltaVal ;
   } else {
      x[ipt] = log10(sums[ipt]/y[ipt]) ;
   }
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
DVfree(sums) ;

return ; }