예제 #1
0
/*
   ----------------------------
   purpose -- basic initializer

   created -- 98may02, cca
   ----------------------------
*/
void
DenseMtx_init (
   DenseMtx   *mtx,
   int        type,
   int        rowid,
   int        colid,
   int        nrow,
   int        ncol,
   int        inc1,
   int        inc2
) {
int   nbytes ;
/*
   ---------------
   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_init(%p,%d,%d,%d,%d,%d,%d)"
           "\n bad input\n", 
           mtx, rowid, colid, nrow, ncol, inc1, inc2) ;
   exit(-1) ;
}
switch ( type ) {
case SPOOLES_REAL :
case SPOOLES_COMPLEX :
   break ;
default :
   fprintf(stderr, 
           "\n fatal error in DenseMtx_init(%p,%d,%d,%d,%d,%d,%d,%d)"
           "\n bad type %d\n", 
           mtx, type, rowid, colid, nrow, ncol, inc1, inc2, type) ;
   exit(-1) ;
   break ;
}
/*
   -------------------------------------------------------
   get and set the number of bytes needed in the workspace
   -------------------------------------------------------
*/
nbytes = DenseMtx_nbytesNeeded(type, nrow, ncol) ;
DenseMtx_setNbytesInWorkspace(mtx, nbytes) ;
/*
   --------------
   set the fields
   --------------
*/
DenseMtx_setFields(mtx, type, rowid, colid, nrow, ncol, inc1, inc2) ;
if ( nrow > 0 ) {
   IVramp(nrow, mtx->rowind, 0, 1) ;
}
if ( ncol > 0 ) {
   IVramp(ncol, mtx->colind, 0, 1) ;
}
return ; }
예제 #2
0
파일: sort.c 프로젝트: bialk/SPOOLES
/*
   -------------------------------------------------
   sort the columns of the matrix in ascending order
   of the colids[] vector. on return, colids is
   in asending order. return value is the number
   of column swaps made.

   created -- 98apr15, cca
   -------------------------------------------------
*/
int
A2_sortColumnsUp (
   A2   *mtx,
   int   ncol,
   int   colids[]
) {
int   ii, mincol, mincolid, nswap, target ;
/*
   ---------------
   check the input
   ---------------
*/
if ( mtx == NULL || mtx->n2 < ncol || ncol < 0 || colids == NULL ) {
   fprintf(stderr, "\n fatal error in A2_sortColumnsUp(%p,%d,%p)"
           "\n bad input\n", mtx, ncol, colids) ;
   if ( mtx != NULL ) {
      A2_writeStats(mtx, stderr) ;
   }
   exit(-1) ;
}
if ( ! (A2_IS_REAL(mtx) || A2_IS_COMPLEX(mtx)) ) {
   fprintf(stderr, "\n fatal error in A2_sortColumnsUp(%p,%d,%p)"
           "\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n", 
           mtx, ncol, colids, mtx->type) ;
   exit(-1) ;
}
nswap = 0 ;
if ( mtx->inc2 == 1 ) {
   double   *dvtmp ;
   int      irow, nrow ;
   int      *ivtmp ;
/*
   ---------------------------------------------------
   matrix is stored by rows, so permute each row
   ---------------------------------------------------
*/
   ivtmp = IVinit(ncol, -1) ;
   if ( A2_IS_REAL(mtx) ) {
      dvtmp = DVinit(ncol, 0.0) ;
   } else if ( A2_IS_COMPLEX(mtx) ) {
      dvtmp = DVinit(2*ncol, 0.0) ;
   }
   IVramp(ncol, ivtmp, 0, 1) ;
   IV2qsortUp(ncol, colids, ivtmp) ;
   nrow = mtx->n1 ;
   for ( irow = 0 ; irow < nrow ; irow++ ) {
      if ( A2_IS_REAL(mtx) ) {
         DVcopy(ncol, dvtmp, A2_row(mtx, irow)) ;
         DVgather(ncol, A2_row(mtx, irow), dvtmp, ivtmp) ;
      } else if ( A2_IS_COMPLEX(mtx) ) {
         ZVcopy(ncol, dvtmp, A2_row(mtx, irow)) ;
         ZVgather(ncol, A2_row(mtx, irow), dvtmp, ivtmp) ;
      }
   }
   IVfree(ivtmp) ;
   DVfree(dvtmp) ;
} else {
/*
   ----------------------------------------
   use a simple insertion sort to swap cols
   ----------------------------------------
*/
   for ( target = 0 ; target < ncol ; target++ ) {
      mincol   = target ;
      mincolid = colids[target] ;
      for ( ii = target + 1 ; ii < ncol ; ii++ ) {
         if ( mincolid > colids[ii] ) {
            mincol   = ii ;
            mincolid = colids[ii] ;
         }
      }
      if ( mincol != target ) {
         colids[mincol] = colids[target] ;
         colids[target] = mincolid ;
         A2_swapColumns(mtx, target, mincol) ;
         nswap++ ;
      }
   }
}
return(nswap) ; }
예제 #3
0
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ------------------------------------
   test the copyEntriesToVector routine

   created -- 98may01, cca,
   ------------------------------------
*/
{
Chv      *chvJ, *chvI ;
double   imag, real, t1, t2 ;
double   *dvec, *entries ;
Drand    *drand ;
FILE     *msgFile ;
int      count, first, ierr, ii, iilast, ipivot, irow, jcol, jj, 
         jjlast, maxnent, mm, msglvl, ncol, nD, nent, nentD, nentL, 
         nentL11, nentL21, nentU, nentU11, nentU12, nL, npivot, nrow,
         nU, pivotingflag, seed, storeflag, symflag, total, type ;
int      *colind, *pivotsizes, *rowind ;

if ( argc != 10 ) {
   fprintf(stdout, 
"\n\n usage : %s msglvl msgFile nD nU type symflag "
"\n         pivotingflag storeflag seed"
"\n    msglvl    -- message level"
"\n    msgFile   -- message file"
"\n    nD        -- # of rows and columns in the (1,1) block"
"\n    nU        -- # of columns in the (1,2) block"
"\n    type      -- entries type"
"\n        1 --> real"
"\n        2 --> complex"
"\n    symflag   -- symmetry flag"
"\n        0 --> symmetric"
"\n        1 --> nonsymmetric"
"\n    pivotingflag -- pivoting flag"
"\n        if symflag = 1 and pivotingflag = 1 then"
"\n           construct pivotsizes[] vector"
"\n        endif"
"\n    storeflag -- flag to denote how to store entries"
"\n        0 --> store by rows"
"\n        1 --> store by columns"
"\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) ;
}
nD           = atoi(argv[3]) ;
nU           = atoi(argv[4]) ;
type         = atoi(argv[5]) ;
symflag      = atoi(argv[6]) ;
pivotingflag = atoi(argv[7]) ;
storeflag    = atoi(argv[8]) ;
seed         = atoi(argv[9]) ;
if ( msglvl > 0 ) {
   switch ( storeflag ) {
   case 0  : fprintf(msgFile, "\n\n %% STORE BY ROWS") ; break ;
   case 1  : fprintf(msgFile, "\n\n %% STORE BY COLUMNS") ; break ;
   default : 
      fprintf(stderr, "\n bad value %d for storeflag", storeflag) ;
      break ;
   }
}
nL = nU ;
if ( symflag == SPOOLES_NONSYMMETRIC ) {
   pivotingflag = 0 ;
}
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setNormal(drand, 0.0, 1.0) ;
Drand_setSeed(drand, seed) ;
/*
   --------------------------
   initialize the chvJ object
   --------------------------
*/
MARKTIME(t1) ;
chvJ = Chv_new() ;
Chv_init(chvJ, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize matrix objects",
        t2 - t1) ;
nent = Chv_nent(chvJ) ;
entries = Chv_entries(chvJ) ;
if ( CHV_IS_REAL(chvJ) ) {
   Drand_fillDvector(drand, nent, entries) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
   Drand_fillDvector(drand, 2*nent, entries) ;
}
Chv_columnIndices(chvJ, &ncol, &colind) ;
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
   Chv_rowIndices(chvJ, &nrow, &rowind) ;
   IVramp(nrow, rowind, 0, 1) ;
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n %% chevron a") ;
   Chv_writeForMatlab(chvJ, "a", msgFile) ;
   fflush(msgFile) ;
}
/*
   --------------------------
   initialize the chvI object
   --------------------------
*/
MARKTIME(t1) ;
chvI = Chv_new() ;
Chv_init(chvI, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize matrix objects",
        t2 - t1) ;
Chv_zero(chvI) ;
Chv_columnIndices(chvI, &ncol, &colind) ;
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chvI) ) {
   Chv_rowIndices(chvI, &nrow, &rowind) ;
   IVramp(nrow, rowind, 0, 1) ;
}
if ( symflag == 0 && pivotingflag == 1 ) {
/*
   ------------------------------
   create the pivotsizes[] vector
   ------------------------------
*/
   Drand_setUniform(drand, 1, 2.999) ;
   pivotsizes = IVinit(nD, 0) ;
   Drand_fillIvector(drand, nD, pivotsizes) ;
/*
   fprintf(msgFile, "\n initial pivotsizes[] : ") ;
   IVfp80(msgFile, nD, pivotsizes, 80, &ierr) ;
*/
   for ( npivot = count = 0 ; npivot < nD ; npivot++ ) {
      count += pivotsizes[npivot] ;
      if ( count > nD ) {
         pivotsizes[npivot]-- ;
         count-- ;
      } 
      if ( count == nD ) {
         break ;
      }
   }
   npivot++ ;
/*
   fprintf(msgFile, "\n final pivotsizes[] : ") ;
   IVfp80(msgFile, npivot, pivotsizes, 80, &ierr) ;
*/
} else {
   npivot = 0 ;
   pivotsizes = NULL ;
}
/*
   --------------------------------------------------
   first test: copy lower, diagonal and upper entries
   --------------------------------------------------
*/
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
   nentL = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_STRICT_LOWER);
} else {
   nentL = 0 ;
}
nentD = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_DIAGONAL) ;
nentU = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_STRICT_UPPER) ;
maxnent = nentL ;
if ( maxnent < nentD ) { maxnent = nentD ; }
if ( maxnent < nentU ) { maxnent = nentU ; }
if ( CHV_IS_REAL(chvJ) ) {
   dvec = DVinit(maxnent, 0.0) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
   dvec = DVinit(2*maxnent, 0.0) ;
}
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
/*
   --------------------------------------
   copy the entries in the lower triangle,
   then move into the chvI object
   --------------------------------------
*/
   nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                                  dvec, CHV_STRICT_LOWER, storeflag) ;
   if ( nent != nentL ) {
      fprintf(stderr, "\n error: nentL = %d, nent = %d", nentL, nent) ;
      exit(-1) ;
   }
   if ( storeflag == 0 ) {
      for ( irow = 0, mm = 0 ; irow < nrow ; irow++ ) {
         jjlast = (irow < nD) ? irow - 1 : nD - 1 ;
         for ( jj = 0 ; jj <= jjlast ; jj++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jj, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ;
               imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jj, real, imag) ;
            }
         }
      }
   } else {
      for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++ ) {
         for ( irow = jcol + 1 ; irow < nrow ; irow++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
/*
fprintf(msgFile, "\n %% mm = %d, a(%d,%d) = %20.12e + %20.12e*i",
        mm, irow, jcol, real, imag) ;
*/
               Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
            }
         }
      }
   }
}
/*
   ---------------------------------------
   copy the entries in the diagonal matrix
   then move into the chvI object
   ---------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                               dvec, CHV_DIAGONAL, storeflag) ;
if ( nent != nentD ) {
   fprintf(stderr, "\n error: nentD = %d, nent = %d", nentD, nent) ;
   exit(-1) ;
}
if ( pivotsizes == NULL ) {
   for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++, mm++ ) {
      if ( CHV_IS_REAL(chvJ) ) {
         real = dvec[mm] ; 
         Chv_setRealEntry(chvI, jcol, jcol, real) ;
      } else if ( CHV_IS_COMPLEX(chvJ) ) {
         real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
         Chv_setComplexEntry(chvI, jcol, jcol, real, imag) ;
      }
   }
} else {
   for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
      if ( pivotsizes[ipivot] == 1 ) {
         if ( CHV_IS_REAL(chvJ) ) {
            real = dvec[mm] ; 
            Chv_setRealEntry(chvI, irow, irow, real) ;
         } else if ( CHV_IS_COMPLEX(chvJ) ) {
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
         }
         mm++ ; irow++ ;
      } else {
         if ( CHV_IS_REAL(chvJ) ) {
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow, irow, real) ;
            mm++ ; 
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow, irow+1, real) ;
            mm++ ; 
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow+1, irow+1, real) ;
            mm++ ; 
            irow += 2 ;
         } else if ( CHV_IS_COMPLEX(chvJ) ) {
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
            mm++ ; 
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, irow+1, real, imag) ;
            mm++ ; 
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow+1, irow+1, real, imag) ;
            mm++ ; 
            irow += 2 ;
         }
      }
   }
}
/*
   --------------------------------------
   copy the entries in the upper triangle,
   then move into the chvI object
   --------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                               dvec, CHV_STRICT_UPPER, storeflag) ;
if ( nent != nentU ) {
   fprintf(stderr, "\n error: nentU = %d, nent = %d", nentU, nent) ;
   exit(-1) ;
}
if ( storeflag == 1 ) {
   if ( pivotsizes == NULL ) {
      for ( jcol = mm = 0 ; jcol < ncol ; jcol++ ) {
         iilast = (jcol < nD) ? jcol - 1 : nD - 1 ;
         for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ; 
               Chv_setRealEntry(chvI, ii, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
            }
         }
      }
   } else {
      for ( ipivot = jcol = mm = 0 ; ipivot < npivot ; ipivot++ ) {
         iilast = jcol - 1 ;
         for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, ii, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
            }
         }
         jcol++ ;
         if ( pivotsizes[ipivot] == 2 ) {
            for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, ii, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
               }
            }
            jcol++ ;
         }
      }
      for ( jcol = nD ; jcol < ncol ; jcol++ ) {
         for ( irow = 0 ; irow < nD ; irow++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
            }
         }
      }
   }
} else {
   if ( pivotsizes == NULL ) {
      for ( irow = mm = 0 ; irow < nD ; irow++ ) {
         for ( jcol = irow + 1 ; jcol < ncol ; jcol++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
            }
         }
      }
   } else {
      for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
         if ( pivotsizes[ipivot] == 1 ) {
            for ( jcol = irow + 1 ; jcol < ncol ; jcol++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, irow, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
               }
            }
            irow++ ;
         } else {
            for ( jcol = irow + 2 ; jcol < ncol ; jcol++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, irow, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
               }
            }
            for ( jcol = irow + 2 ; jcol < ncol ; jcol++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, irow+1, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, irow+1, jcol, real, imag) ;
               }
            }
            irow += 2 ;
         }
      }
   }
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n %% chevron b") ;
   Chv_writeForMatlab(chvI, "b", msgFile) ;
   fprintf(msgFile, 
           "\n\n emtx1 = abs(a - b) ; enorm1 = max(max(emtx1))") ;
   fflush(msgFile) ;
}
DVfree(dvec) ;
/*
   -----------------------------------------------------
   second test: copy lower (1,1), lower (2,1), diagonal,
                upper(1,1) and upper(1,2) blocks
   -----------------------------------------------------
*/
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
   nentL11 = Chv_countEntries(chvJ, npivot, pivotsizes, 
                              CHV_STRICT_LOWER_11) ;
   nentL21 = Chv_countEntries(chvJ, npivot, pivotsizes, 
                              CHV_LOWER_21) ;
} else {
   nentL11 = 0 ;
   nentL21 = 0 ;
}
nentD   = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_DIAGONAL) ;
nentU11 = Chv_countEntries(chvJ, npivot, pivotsizes, 
                           CHV_STRICT_UPPER_11) ;
nentU12 = Chv_countEntries(chvJ, npivot, pivotsizes, 
                           CHV_UPPER_12) ;
maxnent = nentL11 ;
if ( maxnent < nentL21 ) { maxnent = nentL21 ; }
if ( maxnent < nentD   ) { maxnent = nentD   ; }
if ( maxnent < nentU11 ) { maxnent = nentU11 ; }
if ( maxnent < nentU12 ) { maxnent = nentU12 ; }
fprintf(msgFile, 
        "\n %% nentL11 = %d, nentL21 = %d"
        "\n %% nentD = %d, nentU11 = %d, nentU12 = %d",
        nentL11, nentL21, nentD, nentU11, nentU12) ;
if ( CHV_IS_REAL(chvJ) ) {
   dvec = DVinit(maxnent, 0.0) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
   dvec = DVinit(2*maxnent, 0.0) ;
}
Chv_zero(chvI) ;
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
/*
   ------------------------------------------
   copy the entries in the lower (1,1) block,
   then move into the chvI object
   ------------------------------------------
*/
   nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                                 dvec, CHV_STRICT_LOWER_11, storeflag) ;
   if ( nent != nentL11 ) {
      fprintf(stderr, "\n error: nentL = %d, nent = %d", nentL, nent) ;
      exit(-1) ;
   }
   if ( storeflag == 0 ) {
      for ( irow = 0, mm = 0 ; irow < nD ; irow++ ) {
         jjlast = (irow < nD) ? irow - 1 : nD - 1 ;
         for ( jj = 0 ; jj <= jjlast ; jj++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jj, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jj, real, imag) ;
            }
         }
      }
   } else {
      for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++ ) {
         for ( irow = jcol + 1 ; irow < nD ; irow++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
            }
         }
      }
   }
/*
   ------------------------------------------
   copy the entries in the lower (2,1) block,
   then move into the chvI object
   ------------------------------------------
*/
   nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                                  dvec, CHV_LOWER_21, storeflag);
   if ( nent != nentL21 ) {
      fprintf(stderr, "\n error: nentL21 = %d, nent = %d", 
              nentL21, nent) ;
      exit(-1) ;
   }
   if ( storeflag == 0 ) {
      for ( irow = nD, mm = 0 ; irow < nrow ; irow++ ) {
         for ( jcol = 0 ; jcol < nD ; jcol++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
            }
         }
      }
   } else {
      for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++ ) {
         for ( irow = nD ; irow < nrow ; irow++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
            }
         }
      }
   }
}
/*
   ---------------------------------------
   copy the entries in the diagonal matrix
   then move into the chvI object
   ---------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                               dvec, CHV_DIAGONAL, storeflag) ;
if ( nent != nentD ) {
   fprintf(stderr, "\n error: nentD = %d, nent = %d", nentD, nent) ;
   exit(-1) ;
}
if ( pivotsizes == NULL ) {
   for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++, mm++ ) {
      if ( CHV_IS_REAL(chvJ) ) {
         real = dvec[mm] ;
         Chv_setRealEntry(chvI, jcol, jcol, real) ;
      } else if ( CHV_IS_COMPLEX(chvJ) ) {
         real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
         Chv_setComplexEntry(chvI, jcol, jcol, real, imag) ;
      }
   }
} else {
   for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
      if ( pivotsizes[ipivot] == 1 ) {
         if ( CHV_IS_REAL(chvJ) ) {
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow, irow, real) ;
         } else if ( CHV_IS_COMPLEX(chvJ) ) {
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
         }
         mm++ ; irow++ ;
      } else {
         if ( CHV_IS_REAL(chvJ) ) {
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow, irow, real) ;
            mm++ ; 
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow, irow+1, real) ;
            mm++ ; 
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow+1, irow+1, real) ;
            mm++ ; 
         } else if ( CHV_IS_COMPLEX(chvJ) ) {
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
            mm++ ; 
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, irow+1, real, imag) ;
            mm++ ; 
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow+1, irow+1, real, imag) ;
            mm++ ; 
         }
         irow += 2 ;
      }
   }
}
/*
   -----------------------------------------
   copy the entries in the upper (1,1) block
   then move into the chvI object
   -----------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                               dvec, CHV_STRICT_UPPER_11, storeflag) ;
if ( nent != nentU11 ) {
   fprintf(stderr, "\n error: nentU11 = %d, nent = %d", nentU11, nent) ;
   exit(-1) ;
}
if ( storeflag == 1 ) {
   if ( pivotsizes == NULL ) {
      for ( jcol = mm = 0 ; jcol < nD ; jcol++ ) {
         iilast = (jcol < nD) ? jcol - 1 : nD - 1 ;
         for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, ii, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
            }
         }
      }
   } else {
      for ( ipivot = jcol = mm = 0 ; ipivot < npivot ; ipivot++ ) {
         iilast = jcol - 1 ;
         for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, ii, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
            }
         }
         jcol++ ;
         if ( pivotsizes[ipivot] == 2 ) {
            for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, ii, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
               }
            }
            jcol++ ;
         }
      }
   }
} else {
   if ( pivotsizes == NULL ) {
      for ( irow = mm = 0 ; irow < nD ; irow++ ) {
         for ( jcol = irow + 1 ; jcol < nD ; jcol++, mm++ ) {
            if ( CHV_IS_REAL(chvJ) ) {
               real = dvec[mm] ;
               Chv_setRealEntry(chvI, irow, jcol, real) ;
            } else if ( CHV_IS_COMPLEX(chvJ) ) {
               real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
               Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
            }
         }
      }
   } else {
      for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
         if ( pivotsizes[ipivot] == 1 ) {
            for ( jcol = irow + 1 ; jcol < nD ; jcol++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, irow, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
               }
            }
            irow++ ;
         } else {
            for ( jcol = irow + 2 ; jcol < nD ; jcol++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, irow, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
               }
            }
            for ( jcol = irow + 2 ; jcol < nD ; jcol++, mm++ ) {
               if ( CHV_IS_REAL(chvJ) ) {
                  real = dvec[mm] ;
                  Chv_setRealEntry(chvI, irow+1, jcol, real) ;
               } else if ( CHV_IS_COMPLEX(chvJ) ) {
                  real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
                  Chv_setComplexEntry(chvI, irow+1, jcol, real, imag) ;
               }
            }
            irow += 2 ;
         }
      }
   }
}
/*
   -----------------------------------------
   copy the entries in the upper (1,2) block
   then move into the chvI object
   -----------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent, 
                               dvec, CHV_UPPER_12, storeflag) ;
if ( nent != nentU12 ) {
   fprintf(stderr, "\n error: nentU12 = %d, nent = %d", nentU12, nent) ;
   exit(-1) ;
}
if ( storeflag == 1 ) {
   for ( jcol = nD, mm = 0 ; jcol < ncol ; jcol++ ) {
      for ( irow = 0 ; irow < nD ; irow++, mm++ ) {
         if ( CHV_IS_REAL(chvJ) ) {
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow, jcol, real) ;
         } else if ( CHV_IS_COMPLEX(chvJ) ) {
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
         }
      }
   }
} else {
   for ( irow = mm = 0 ; irow < nD ; irow++ ) {
      for ( jcol = nD ; jcol < ncol ; jcol++, mm++ ) {
         if ( CHV_IS_REAL(chvJ) ) {
            real = dvec[mm] ;
            Chv_setRealEntry(chvI, irow, jcol, real) ;
         } else if ( CHV_IS_COMPLEX(chvJ) ) {
            real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
            Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
         }
      }
   }
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n %% chevron b") ;
   Chv_writeForMatlab(chvI, "b", msgFile) ;
   fprintf(msgFile, 
           "\n\n emtx2 = abs(a - b) ; enorm2 = max(max(emtx2))") ;
   fprintf(msgFile, "\n\n [ enorm1 enorm2]") ;
   fflush(msgFile) ;
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
if ( pivotsizes != NULL ) {
   IVfree(pivotsizes) ;
}
Chv_free(chvJ) ;
Chv_free(chvI) ;
Drand_free(drand) ;
DVfree(dvec) ;

fprintf(msgFile, "\n") ;

return(1) ; }
예제 #4
0
파일: split.c 프로젝트: fransklaver/SPOOLES
/*
   ----------------------------------------------------------------
   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 ; }
예제 #5
0
/*
   --------------------------------------------------------------------
   purpose -- merge the front tree allowing at most
              maxzeros zero entries inside a front

   return -- 
      IV object that has the old front to new front map

   created -- 96jun23, cca
   modified -- 97dec18, cca
      bug fixed that incorrectly counted the number of zeros in a front
   --------------------------------------------------------------------
*/
ETree *
ETree_mergeFrontsAny (
   ETree   *etree,
   int     maxzeros,
   IV      *nzerosIV
) {
ETree   *etree2 ;
int     J, K, nfront, nvtx, nnew ;
int     *bndwghts, *cost, *fch, *map, *nodwghts, 
        *nzeros, *par, *place, *rep, *sib, *temp ;
IV      *mapIV ;
Tree    *tree ;
/*
   ---------------
   check the input
   ---------------
*/
if (  etree == NULL 
   || (nfront = etree->nfront) <= 0
   || (nvtx = etree->nvtx) <= 0 ) {
   fprintf(stderr, "\n fatal error in ETree_mergeFrontsAny(%p,%d)"
           "\n bad input\n", etree, maxzeros) ;
   spoolesFatal();
}
if ( IV_size(nzerosIV) != nfront ) {
   fprintf(stderr, "\n fatal error in ETree_mergeFrontsAny(%p,%d,%p)"
           "\n size(nzerosIV) = %d, nfront = %d\n", 
           etree, maxzeros, nzerosIV, IV_size(nzerosIV), nfront) ;
   spoolesFatal();
}
nzeros = IV_entries(nzerosIV) ;
tree     = etree->tree ;
nodwghts = IVinit(nfront, 0) ;
bndwghts = IVinit(nfront, 0) ;
par = IVinit(nfront, -1) ;
fch = IVinit(nfront, -1) ;
sib = IVinit(nfront, -1) ;
IVcopy(nfront, par, tree->par) ;
IVcopy(nfront, fch, tree->fch) ;
IVcopy(nfront, sib, tree->sib) ;
IVcopy(nfront, nodwghts, IV_entries(etree->nodwghtsIV)) ;
IVcopy(nfront, bndwghts, IV_entries(etree->bndwghtsIV)) ;
/*
   ----------------------
   set up working storage
   ----------------------
*/
rep = IVinit(nfront, -1) ;
IVramp(nfront, rep, 0, 1) ;
cost   = IVinit(nfront, 0) ;
/*
   ------------------------------------------
   perform a post-order traversal of the tree
   ------------------------------------------
*/
for ( J = Tree_postOTfirst(tree) ;
      J != -1 ;
      J = Tree_postOTnext(tree, J) ) {
#if MYDEBUG > 0
   fprintf(stdout, "\n\n ##### visiting front %d", J) ;
   fflush(stdout) ;
#endif
   visitAny(J, par, fch, sib, nodwghts, bndwghts, 
            rep, cost, nzeros, maxzeros) ;
}
#if MYDEBUG > 0
   fprintf(stdout, "\n\n whoa, finished") ;
   fflush(stdout) ;
#endif
/*
   -------------------------------------------------
   take the map from fronts to representative fronts
   and make the map from old fronts to new fronts
   -------------------------------------------------
*/
mapIV = IV_new() ;
IV_init(mapIV, nfront, NULL) ;
map   = IV_entries(mapIV) ;
place = IVinit(nfront, -1) ;
for ( J = 0, nnew = 0 ; J < nfront ; J++ ) {
#if MYDEBUG > 0
   fprintf(stdout, "\n rep[%d] = %d", J, rep[J]) ;
   fflush(stdout) ;
#endif
   if ( rep[J] != J ) {
      K = J ;
      while ( rep[K] != K ) {
#if MYDEBUG > 0
      fprintf(stdout, "\n    rep[%d] = %d", K, rep[K]) ;
      fflush(stdout) ;
#endif
         K = rep[K] ;
      }
      rep[J] = K ;
#if MYDEBUG > 0
      fprintf(stdout, "\n    setting rep[%d] = %d", J, rep[J]) ;
      fflush(stdout) ;
#endif
   } else {
      place[J] = nnew++ ;
   }
}
for ( J = 0 ; J < nfront ; J++ ) {
   K = rep[J] ;
   map[J] = place[K] ;
}
/*
   -------------------------------
   get the compressed ETree object
   -------------------------------
*/
etree2 = ETree_compress(etree, mapIV) ;
/*
   -------------------------
   remap the nzeros[] vector
   -------------------------
*/
temp = IVinit(nfront, 0) ;
IVcopy(nfront, temp, nzeros) ;
IV_setSize(nzerosIV, nnew) ;
nzeros = IV_entries(nzerosIV) ;
for ( J = 0 ; J < nfront ; J++ ) {
   if ( rep[J] == J ) {
      nzeros[map[J]] = temp[J] ;
   }
}
IVfree(temp) ;
/*
   ------------------------
   free the working storage
   ------------------------
*/
IVfree(par)      ;
IVfree(fch)      ;
IVfree(sib)      ;
IVfree(nodwghts) ;
IVfree(bndwghts) ;
IVfree(rep)      ;
IVfree(cost)     ;
IVfree(place)    ;
IV_free(mapIV)   ;

return(etree2) ; }
예제 #6
0
파일: split.c 프로젝트: fransklaver/SPOOLES
/*
   ----------------------------------------------------------------
   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 ; }
예제 #7
0
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ------------------------------------
   test the Chv_assembleChv() method.

   created -- 98apr18, cca
   ------------------------------------
*/
{
Chv     *chvI, *chvJ ;
double   imag, real, t1, t2 ;
double   *entriesI, *entriesJ ;
Drand    *drand ;
FILE     *msgFile ;
int      ierr, ii, irow, jcol,
         lastcol, msglvl, ncolI, ncolJ, nDI, nDJ, nentI, nentJ, 
         nrowI, nrowJ, nUI, nUJ, seed, symflag, type ;
int      *colindI, *colindJ, *rowindI, *rowindJ, *temp ;

if ( argc != 10 ) {
   fprintf(stdout, 
"\n\n usage : %s msglvl msgFile nDJ nUJ nDI nUI type symflag seed "
"\n    msglvl  -- message level"
"\n    msgFile -- message file"
"\n    nDJ     -- # of rows and columns in the (1,1) block"
"\n    nUJ     -- # of columns in the (1,2) block"
"\n    nDI     -- # of rows and columns in the (1,1) block"
"\n    nUI     -- # of columns in the (1,2) block"
"\n    type    -- entries type"
"\n       1 --> real"
"\n       2 --> complex"
"\n    symflag -- symmetry flag"
"\n       0 --> symmetric"
"\n       1 --> hermitian"
"\n       2 --> nonsymmetric"
"\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) ;
}
nDJ     = atoi(argv[3]) ;
nUJ     = atoi(argv[4]) ;
nDI     = atoi(argv[5]) ;
nUI     = atoi(argv[6]) ;
type    = atoi(argv[7]) ;
symflag = atoi(argv[8]) ;
seed    = atoi(argv[9]) ;
if (  nDJ <= 0 || nUJ < 0 
   || nDI <= 0 || nUI < 0 
   || nDI >= nDJ || (nDI + nUI) >= (nDJ + nUJ)
   || nUI >= (nDJ + nUJ - nDI)
   || (  symflag != SPOOLES_SYMMETRIC
      && symflag != SPOOLES_HERMITIAN
      && symflag != SPOOLES_NONSYMMETRIC) ) {
   fprintf(stderr, "\n invalid input"
      "\n nDJ = %d, nUJ = %d, nDI = %d, nUI = %d, symflag = %d\n",
           nDJ, nUJ, nDI, nUI, symflag) ;
   exit(-1) ;
}
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setUniform(drand, -1.0, 1.0) ;
/*
   ----------------------------
   initialize the ChvJ object
   ----------------------------
*/
MARKTIME(t1) ;
chvJ = Chv_new() ;
Chv_init(chvJ, 0, nDJ, nUJ, nUJ, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize chv object",
        t2 - t1) ;
fflush(msgFile) ;
Chv_columnIndices(chvJ, &ncolJ, &colindJ) ;
temp = IVinit(2*(nDJ+nUJ), -1) ;
IVramp(2*(nDJ+nUJ), temp, 0, 1) ;
IVshuffle(2*(nDJ+nUJ), temp, ++seed) ;
IVcopy(ncolJ, colindJ, temp) ;
IVfree(temp) ;
IVqsortUp(ncolJ, colindJ) ;
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
   Chv_rowIndices(chvJ, &nrowJ, &rowindJ) ;
   IVcopy(nrowJ, rowindJ, colindJ) ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n %% column indices") ;
   IVfprintf(msgFile, ncolJ, colindJ) ;
}
lastcol = colindJ[ncolJ-1] ;
nentJ = Chv_nent(chvJ) ;
entriesJ = Chv_entries(chvJ) ;
if ( CHV_IS_REAL(chvJ) ) {
   Drand_fillDvector(drand, nentJ, entriesJ) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
   Drand_fillDvector(drand, 2*nentJ, entriesJ) ;
}
if ( CHV_IS_HERMITIAN(chvJ) ) {
/*
   ---------------------------------------------------------
   hermitian example, set imaginary part of diagonal to zero
   ---------------------------------------------------------
*/
   for ( irow = 0 ; irow < nDJ ; irow++ ) {
      Chv_complexEntry(chvJ, irow, irow, &real, &imag) ;
      Chv_setComplexEntry(chvJ, irow, irow, real, 0.0) ;
   }
}
/*
   ---------------------------
   initialize the ChvI object
   ---------------------------
*/
chvI = Chv_new() ;
Chv_init(chvI, 0, nDI, nUI, nUI, type, symflag) ;
Chv_columnIndices(chvI, &ncolI, &colindI) ;
temp = IVinit(ncolJ, -1) ;
IVramp(ncolJ, temp, 0, 1) ;
while ( 1 ) {
   IVshuffle(ncolJ, temp, ++seed) ;
   IVqsortUp(ncolI, temp) ;
   if ( temp[0] < nDJ ) {
      break ;
   }
}
for ( ii = 0 ; ii < ncolI ; ii++ ) {
   colindI[ii] = colindJ[temp[ii]] ;
}
IVfree(temp) ;
if ( CHV_IS_NONSYMMETRIC(chvI) ) {
   Chv_rowIndices(chvI, &nrowI, &rowindI) ;
   IVcopy(nrowI, rowindI, colindI) ;
}
nentI = Chv_nent(chvI) ;
entriesI = Chv_entries(chvI) ;
if ( CHV_IS_REAL(chvI) ) {
   Drand_fillDvector(drand, nentI, entriesI) ;
} else if ( CHV_IS_COMPLEX(chvI) ) {
   Drand_fillDvector(drand, 2*nentI, entriesI) ;
}
if ( CHV_IS_HERMITIAN(chvI) ) {
/*
   ---------------------------------------------------------
   hermitian example, set imaginary part of diagonal to zero
   ---------------------------------------------------------
*/
   for ( irow = 0 ; irow < nDI ; irow++ ) {
      Chv_complexEntry(chvI, irow, irow, &real, &imag) ;
      Chv_setComplexEntry(chvI, irow, irow, real, 0.0) ;
   }
}
/*
   --------------------------------------------------
   write out the two chevron objects to a matlab file
   --------------------------------------------------
*/
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n a = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
   Chv_writeForMatlab(chvJ, "a", msgFile) ;
   fprintf(msgFile, "\n b = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
   Chv_writeForMatlab(chvI, "b", msgFile) ;
}
/*
   ---------------------------------------------
   assemble the chvI object into the chvJ object
   ---------------------------------------------
*/
Chv_assembleChv(chvJ, chvI) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n %% after assembly") ;
   fprintf(msgFile, "\n c = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
   Chv_writeForMatlab(chvJ, "c", msgFile) ;
}
/*
   -----------------
   compute the error
   -----------------
*/
fprintf(msgFile, "\n max(max(abs(c - (b + a))))") ;
/*
   ------------------------
   free the working storage
   ------------------------
*/
Chv_free(chvJ) ;
Chv_free(chvI) ;
Drand_free(drand) ;

fprintf(msgFile, "\n") ;

return(1) ; }
예제 #8
0
파일: init.c 프로젝트: JuliaFEM/SPOOLES
/*
   ----------------------------
   purpose -- basic initializer

   created -- 98may01, cca
   ----------------------------
*/
void
SubMtx_init (
   SubMtx   *mtx,
   int      type,
   int      mode,
   int      rowid,
   int      colid,
   int      nrow,
   int      ncol,
   int      nent
) {
int   nbytes ;
int   *colind, *rowind ;
/*
   ---------------
   check the input
   ---------------
*/
if (  mtx == NULL ) {
   fprintf(stderr, "\n fatal error in SubMtx_init()"
           "\n mtx is NULL\n") ;
   exit(-1) ;
}
if (  nrow <= 0 ) {
   fprintf(stderr, "\n fatal error in SubMtx_init()"
           "\n nrow = %d <= 0\n", nrow) ;
   exit(-1) ;
}
if (  ncol <= 0 ) {
   fprintf(stderr, "\n fatal error in SubMtx_init()"
           "\n ncol = %d <= 0\n", ncol) ;
   exit(-1) ;
}
if (  nrow <= 0 ) {
   fprintf(stderr, "\n fatal error in SubMtx_init()"
           "\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_init()"
           "\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_init()"
           "\n invalid mode %d", mode) ;
   exit(-1) ;
}
/*
   -------------------------------------------------------
   get and set the number of bytes needed in the workspace
   -------------------------------------------------------
*/
nbytes = SubMtx_nbytesNeeded(type, mode, nrow, ncol, nent) ;
SubMtx_setNbytesInWorkspace(mtx, nbytes) ;
DVzero(nbytes/sizeof(double), (double *) SubMtx_workspace(mtx)) ;
/*
   --------------
   set the fields
   --------------
*/
SubMtx_setFields(mtx, type, mode, rowid, colid, nrow, ncol, nent) ;
SubMtx_rowIndices(mtx, &nrow, &rowind) ;
IVramp(nrow, rowind, 0, 1) ;
SubMtx_columnIndices(mtx, &ncol, &colind) ;
IVramp(ncol, colind, 0, 1) ;

return ; }
예제 #9
0
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   -------------------------------------
   test the Chv_update{H,S,N}() methods.
   T := T - U^T * D * U
   T := T - U^H * D * U
   T := T - L   * D * U

   created -- 98apr23, cca
   -------------------------------------
*/
{
Chv     *chvT ;
SubMtx     *mtxD, *mtxL, *mtxU ;
double   imag, ops, real, t1, t2 ;
Drand    *drand ;
DV       *tempDV ;
FILE     *msgFile ;
int      irow, msglvl, ncolT, nDT, ncolU, nentT, nentU, nrowD, 
         nrowL, nrowT, offset, seed, size, sparsityflag, symflag, type ;
int      *colindT, *colindU, *ivec, *rowindL, *rowindT ;

if ( argc != 13 ) {
   fprintf(stdout, 
           "\n\n usage : %s msglvl msgFile type symflag sparsityflag"
           "\n         ncolT ncolU nrowD nentU offset seed"
           "\n    msglvl  -- message level"
           "\n    msgFile -- message file"
           "\n    type    -- entries type"
           "\n       1 -- real"
           "\n       2 -- complex"
           "\n    symflag -- type of matrix U"
           "\n       0 -- symmetric"
           "\n       1 -- hermitian"
           "\n       2 -- nonsymmetric"
           "\n    sparsityflag -- dense or sparse"
           "\n       0 -- dense"
           "\n       1 -- sparse"
           "\n    ncolT   -- # of rows and columns in matrix T"
           "\n    nDT     -- # of internal rows and columns in matrix T"
           "\n    ncolU   -- # of rows and columns in matrix U"
           "\n    nrowD   -- # of rows and columns in matrix D"
           "\n    nentU   -- # of entries in matrix U"
           "\n    offset  -- distance between D_I and T"
           "\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]) ;
symflag      = atoi(argv[4]) ;
sparsityflag = atoi(argv[5]) ;
ncolT        = atoi(argv[6]) ;
nDT          = atoi(argv[7]) ;
ncolU        = atoi(argv[8]) ;
nrowD        = atoi(argv[9]) ;
nentU        = atoi(argv[10]) ;
offset       = atoi(argv[11]) ;
seed         = atoi(argv[12]) ;
fprintf(msgFile, "\n %% %s:"
        "\n %% msglvl       = %d"
        "\n %% msgFile      = %s"
        "\n %% type         = %d"
        "\n %% symflag      = %d"
        "\n %% sparsityflag = %d"
        "\n %% ncolT        = %d"
        "\n %% nDT          = %d"
        "\n %% ncolU        = %d"
        "\n %% nrowD        = %d"
        "\n %% nentU        = %d"
        "\n %% offset       = %d"
        "\n %% seed         = %d",
        argv[0], msglvl, argv[2], type, symflag, sparsityflag, 
        ncolT, nDT, ncolU, nrowD, nentU, offset, seed) ;
/*
   -----------------------------
   check for errors in the input
   -----------------------------
*/
if (  (type != SPOOLES_REAL 
       && type != SPOOLES_COMPLEX) 
   || (symflag != SPOOLES_SYMMETRIC 
       && symflag != SPOOLES_HERMITIAN 
       && symflag != SPOOLES_NONSYMMETRIC) 
   || (sparsityflag < 0 || sparsityflag > 1)
   || ncolT <= 0 || ncolU > (ncolT + offset) || nrowD <= 0 ) {
   fprintf(stderr, "\n invalid input\n") ;
   spoolesFatal();
}
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, ++seed) ;
Drand_setNormal(drand, 0.0, 1.0) ;
/*
   -----------------------
   get a vector of indices
   -----------------------
*/
size = nrowD + offset + ncolT ;
ivec = IVinit(size, -1) ;
IVramp(size, ivec, 0, 1) ;
/*
   ----------------------------
   initialize the T Chv object
   ----------------------------
*/
fprintf(msgFile, "\n\n %% symflag = %d", symflag) ;
MARKTIME(t1) ;
chvT = Chv_new() ;
Chv_init(chvT, 0, nDT, ncolT - nDT, ncolT - nDT, type, symflag) ;
nentT = Chv_nent(chvT) ;
if ( CHV_IS_REAL(chvT) ) {
   Drand_fillDvector(drand, nentT, Chv_entries(chvT)) ;
} else if ( CHV_IS_COMPLEX(chvT) ) {
   Drand_fillDvector(drand, 2*nentT, Chv_entries(chvT)) ;
}
Chv_columnIndices(chvT, &ncolT, &colindT) ;
IVcopy(ncolT, colindT, ivec + nrowD + offset) ;
if ( CHV_IS_NONSYMMETRIC(chvT) ) {
   Chv_rowIndices(chvT, &nrowT, &rowindT) ;
   IVcopy(nrowT, rowindT, colindT) ;
}
IVfree(ivec) ;
if ( CHV_IS_HERMITIAN(chvT) ) {
   fprintf(msgFile, "\n\n %% hermitian\n") ;
/*
   ---------------------------------------------------------
   hermitian example, set imaginary part of diagonal to zero
   ---------------------------------------------------------
*/
   for ( irow = 0 ; irow < nDT ; irow++ ) {
      Chv_complexEntry(chvT, irow, irow, &real, &imag) ;
      Chv_setComplexEntry(chvT, irow, irow, real, 0.0) ;
   }
}
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize chvT Chv object",
        t2 - t1) ;
fprintf(msgFile, "\n T = zeros(%d,%d); ", size, size) ;
Chv_writeForMatlab(chvT, "T", msgFile) ;
/*
   ---------------------------
   initialize the D Mtx object
   ---------------------------
*/
MARKTIME(t1) ;
mtxD = SubMtx_new() ;
if ( CHV_IS_REAL(chvT) ) {
   if ( CHV_IS_SYMMETRIC(chvT) ) {
      SubMtx_initRandom(mtxD, SPOOLES_REAL, SUBMTX_BLOCK_DIAGONAL_SYM,
                      0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
   } else {
      SubMtx_initRandom(mtxD, SPOOLES_REAL, SUBMTX_DIAGONAL, 
                      0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
   }
} else if ( CHV_IS_COMPLEX(chvT) ) {
   if ( CHV_IS_HERMITIAN(chvT) ) {
      SubMtx_initRandom(mtxD,SPOOLES_COMPLEX,SUBMTX_BLOCK_DIAGONAL_HERM,
                      0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
   } else if ( CHV_IS_SYMMETRIC(chvT) ) {
      SubMtx_initRandom(mtxD,SPOOLES_COMPLEX, SUBMTX_BLOCK_DIAGONAL_SYM,
                      0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
   } else {
      SubMtx_initRandom(mtxD, SPOOLES_COMPLEX, SUBMTX_DIAGONAL, 
                      0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
   }
}
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize D SubMtx object",
        t2 - t1) ;
fprintf(msgFile, "\n D = zeros(%d,%d) ;", nrowD, nrowD) ;
SubMtx_writeForMatlab(mtxD, "D", msgFile) ;
/*
   ----------------------------
   initialize the U SubMtx object
   ----------------------------
*/
MARKTIME(t1) ;
mtxU = SubMtx_new() ;
if ( CHV_IS_REAL(chvT) ) {
   if ( sparsityflag == 0 ) {
      SubMtx_initRandom(mtxU, SPOOLES_REAL, SUBMTX_DENSE_COLUMNS, 
                      0, 0, nrowD, ncolU, nentU, ++seed) ;
   } else {
      SubMtx_initRandom(mtxU, SPOOLES_REAL, SUBMTX_SPARSE_COLUMNS, 
                      0, 0, nrowD, ncolU, nentU, ++seed) ;
   }
} else if ( CHV_IS_COMPLEX(chvT) ) {
   if ( sparsityflag == 0 ) {
      SubMtx_initRandom(mtxU, SPOOLES_COMPLEX, SUBMTX_DENSE_COLUMNS, 
                      0, 0, nrowD, ncolU, nentU, ++seed) ;
   } else {
      SubMtx_initRandom(mtxU, SPOOLES_COMPLEX, SUBMTX_SPARSE_COLUMNS, 
                      0, 0, nrowD, ncolU, nentU, ++seed) ;
   }
}
ivec = IVinit(offset + ncolT, -1) ;
IVramp(offset + ncolT, ivec, nrowD, 1) ;
IVshuffle(offset + ncolT, ivec, ++seed) ;
SubMtx_columnIndices(mtxU, &ncolU, &colindU) ;
IVcopy(ncolU, colindU, ivec) ;
IVqsortUp(ncolU, colindU) ;
IVfree(ivec) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize U SubMtx object",
        t2 - t1) ;
fprintf(msgFile, "\n U = zeros(%d,%d) ;", nrowD, size) ;
SubMtx_writeForMatlab(mtxU, "U", msgFile) ;
if ( CHV_IS_NONSYMMETRIC(chvT) ) {
/*
   ----------------------------
   initialize the L SubMtx object
   ----------------------------
*/
   MARKTIME(t1) ;
   mtxL = SubMtx_new() ;
   if ( CHV_IS_REAL(chvT) ) {
      if ( sparsityflag == 0 ) {
         SubMtx_initRandom(mtxL, SPOOLES_REAL, SUBMTX_DENSE_ROWS,
                         0, 0, ncolU, nrowD, nentU, ++seed) ;
      } else {
         SubMtx_initRandom(mtxL, SPOOLES_REAL, SUBMTX_SPARSE_ROWS,
                         0, 0, ncolU, nrowD, nentU, ++seed) ;
      }
   } else if ( CHV_IS_COMPLEX(chvT) ) {
      if ( sparsityflag == 0 ) {
         SubMtx_initRandom(mtxL, SPOOLES_COMPLEX, SUBMTX_DENSE_ROWS,
                         0, 0, ncolU, nrowD, nentU, ++seed) ;
      } else {
         SubMtx_initRandom(mtxL, SPOOLES_COMPLEX, SUBMTX_SPARSE_ROWS,
                         0, 0, ncolU, nrowD, nentU, ++seed) ;
      }
   }
   SubMtx_rowIndices(mtxL, &nrowL, &rowindL) ;
   IVcopy(nrowL, rowindL, colindU) ;
   MARKTIME(t2) ;
   fprintf(msgFile, "\n %% CPU : %.3f to initialize L SubMtx object",
           t2 - t1) ;
   fprintf(msgFile, "\n L = zeros(%d,%d) ;", size, nrowD) ;
   SubMtx_writeForMatlab(mtxL, "L", msgFile) ;
} else {
   mtxL = NULL ;
}
/*
   --------------------------------
   compute the matrix-matrix update
   --------------------------------
*/
tempDV = DV_new() ;
ops = 8*nrowD*nrowD*ncolU ;
if ( CHV_IS_SYMMETRIC(chvT) ) {
   Chv_updateS(chvT, mtxD, mtxU, tempDV) ;
} else if ( CHV_IS_HERMITIAN(chvT) ) {
   Chv_updateH(chvT, mtxD, mtxU, tempDV) ;
} else if ( CHV_IS_NONSYMMETRIC(chvT) ) {
   Chv_updateN(chvT, mtxL, mtxD, mtxU, tempDV) ;
}
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to compute m-m, %.3f mflops",
        t2 - t1, ops*1.e-6/(t2 - t1)) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n %% Z Chv object") ;
   fprintf(msgFile, "\n Z = zeros(%d,%d); ", size, size) ;
   Chv_writeForMatlab(chvT, "Z", msgFile) ;
   fflush(msgFile) ;
}
/*
   -----------------
   check with matlab
   -----------------
*/
if ( msglvl > 1 ) {
   if ( CHV_IS_HERMITIAN(chvT) ) {
      fprintf(msgFile, "\n\n B  =  ctranspose(U) * D * U ;") ;
   } else if ( CHV_IS_SYMMETRIC(chvT) ) {
      fprintf(msgFile, "\n\n B  =  transpose(U) * D * U ;") ;
   } else {
      fprintf(msgFile, "\n\n B  =  L * D * U ;") ;
   }
   fprintf(msgFile, 
           "\n\n for irow = 1:%d"
           "\n      for jcol = 1:%d"
           "\n         if T(irow,jcol) ~= 0.0"
           "\n            T(irow,jcol) = T(irow,jcol) - B(irow,jcol) ;"
           "\n         end"
           "\n      end"
           "\n   end"
           "\n emtx   = abs(Z - T) ;",
           size, size) ;
   fprintf(msgFile, "\n\n maxabs = max(max(emtx)) ") ;
   fflush(msgFile) ;
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
if ( mtxL != NULL ) {
   SubMtx_free(mtxL) ;
}
Chv_free(chvT) ;
SubMtx_free(mtxD) ;
SubMtx_free(mtxU) ;
DV_free(tempDV) ;
Drand_free(drand) ;

fprintf(msgFile, "\n") ;

return(1) ; }
예제 #10
0
파일: QRutil.c 프로젝트: damiannz/spooles
/*
   --------------------------------------------------------------
   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) ; }
예제 #11
0
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ---------------------------------------
   test the Chv_addChevron() method.

   created -- 98apr18, cca
   ---------------------------------------
*/
{
Chv     *chv ;
double   alpha[2] ;
double   imag, real, t1, t2 ;
double   *chvent, *entries ;
Drand    *drand ;
FILE     *msgFile ;
int      chvsize, count, ichv, ierr, ii, iloc, irow, jcol,
         lastcol, msglvl, ncol, nD, nent, nL, nrow, nU, 
         off, seed, symflag, type, upper ;
int      *chvind, *colind, *keys, *rowind, *temp ;

if ( argc != 10 ) {
   fprintf(stdout, 
           "\n\n usage : %s msglvl msgFile nD nU type symflag seed "
           "\n         alphareal alphaimag"
           "\n    msglvl  -- message level"
           "\n    msgFile -- message file"
           "\n    nD      -- # of rows and columns in the (1,1) block"
           "\n    nU      -- # of columns in the (1,2) block"
           "\n    type    -- entries type"
           "\n       1 --> real"
           "\n       2 --> complex"
           "\n    symflag -- symmetry flag"
           "\n       0 --> symmetric"
           "\n       1 --> hermitian"
           "\n       2 --> nonsymmetric"
           "\n    seed    -- random number seed"
           "\n    alpha   -- scaling parameter"
           "\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) ;
}
nD       = atoi(argv[3]) ;
nU       = atoi(argv[4]) ;
type     = atoi(argv[5]) ;
symflag  = atoi(argv[6]) ;
seed     = atoi(argv[7]) ;
alpha[0] = atof(argv[8]) ;
alpha[1] = atof(argv[9]) ;
if (  nD <= 0 || nU < 0 || symflag < 0 || symflag > 2 ) {
   fprintf(stderr, "\n invalid input"
           "\n nD = %d, nU = %d, symflag = %d\n", nD, nU, symflag) ;
   exit(-1) ;
}
fprintf(msgFile, "\n alpha = %12.4e + %12.4e*i ;", alpha[0], alpha[1]) ;
nL = nU ;
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setUniform(drand, -1.0, 1.0) ;
/*
   ----------------------------
   initialize the Chv object
   ----------------------------
*/
MARKTIME(t1) ;
chv = Chv_new() ;
Chv_init(chv, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize chv object",
        t2 - t1) ;
fflush(msgFile) ;
Chv_columnIndices(chv, &ncol, &colind) ;
temp = IVinit(2*(nD+nU), -1) ;
IVramp(2*(nD+nU), temp, 0, 1) ;
IVshuffle(2*(nD+nU), temp, ++seed) ;
IVcopy(ncol, colind, temp) ;
IVqsortUp(ncol, colind) ;
if ( CHV_IS_NONSYMMETRIC(chv) ) {
   Chv_rowIndices(chv, &nrow, &rowind) ;
   IVcopy(nrow, rowind, colind) ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n %% column indices") ;
   IVfprintf(msgFile, ncol, colind) ;
}
lastcol = colind[ncol-1] ;
nent = Chv_nent(chv) ;
entries = Chv_entries(chv) ;
if ( CHV_IS_REAL(chv) ) {
   Drand_fillDvector(drand, nent, entries) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
   Drand_fillDvector(drand, 2*nent, entries) ;
}
if ( CHV_IS_HERMITIAN(chv) ) {
/*
   ---------------------------------------------------------
   hermitian example, set imaginary part of diagonal to zero
   ---------------------------------------------------------
*/
   for ( irow = 0 ; irow < nD ; irow++ ) {
      Chv_complexEntry(chv, irow, irow, &real, &imag) ;
      Chv_setComplexEntry(chv, irow, irow, real, 0.0) ;
   }
}

if ( msglvl > 1 ) {
   fprintf(msgFile, "\n a = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
   Chv_writeForMatlab(chv, "a", msgFile) ;
}
/*
   --------------------------------------------------
   fill a chevron with random numbers and indices
   that are a subset of a front's, as in the assembly
   of original matrix entries.
   --------------------------------------------------
*/
Drand_setUniform(drand, 0, nD) ;
iloc = (int) Drand_value(drand) ;
ichv = colind[iloc] ;
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
   upper = nD - iloc + nU ;
} else {
   upper = 2*(nD - iloc) - 1 + nL + nU ;
}
Drand_setUniform(drand, 1, upper) ;
chvsize = (int) Drand_value(drand) ;
fprintf(msgFile, "\n %% iloc = %d, ichv = %d, chvsize = %d", 
        iloc, ichv, chvsize) ;
chvind  = IVinit(chvsize, -1) ;
chvent  = DVinit(2*chvsize, 0.0) ;
Drand_setNormal(drand, 0.0, 1.0) ;
if ( CHV_IS_REAL(chv) ) {
   Drand_fillDvector(drand, chvsize, chvent) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
   Drand_fillDvector(drand, 2*chvsize, chvent) ;
}
keys    = IVinit(upper+1, -1) ;
keys[0] = 0 ;
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
   for ( ii = iloc + 1, count = 1 ; ii < nD + nU ; ii++ ) {
      keys[count++] = colind[ii] - ichv ;
   }
} else {
   for ( ii = iloc + 1, count = 1 ; ii < nD + nU ; ii++ ) {
      keys[count++] =   colind[ii] - ichv ;
      keys[count++] = - colind[ii] + ichv ;
   }
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n %% iloc = %d, ichv = %d", iloc, ichv) ;
   fprintf(msgFile, "\n %% upper = %d", upper) ;
   fprintf(msgFile, "\n %% chvsize = %d", chvsize) ;
   fprintf(msgFile, "\n %% initial keys") ;
   IVfprintf(msgFile, count, keys) ;
}
   IVshuffle(count, keys, ++seed) ;
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n %% shuffled keys") ;
   IVfp80(msgFile, count, keys, 80, &ierr) ;
}
IVcopy(chvsize, chvind, keys) ;
if ( CHV_IS_REAL(chv) ) {
   IVDVqsortUp(chvsize, chvind, chvent) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
   IVZVqsortUp(chvsize, chvind, chvent) ;
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n %% chvind") ;
   IVfprintf(msgFile, chvsize, chvind) ;
}
if ( CHV_IS_HERMITIAN(chv) ) {
   for ( ii = 0 ; ii < chvsize ; ii++ ) {
      if ( chvind[ii] == 0 ) {
         chvent[2*ii+1] = 0.0 ;
      }
   }
}
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n b = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
   if ( CHV_IS_REAL(chv) ) {
      if ( CHV_IS_SYMMETRIC(chv) ) {
         for ( ii = 0 ; ii < chvsize ; ii++ ) {
            off = chvind[ii] ;
            fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
                    colind[iloc]+1, colind[iloc]+off+1, chvent[ii]) ;
            fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
                    colind[iloc]+off+1, colind[iloc]+1, chvent[ii]) ;
         }
      } else {
         for ( ii = 0 ; ii < chvsize ; ii++ ) {
            off = chvind[ii] ;
            if ( off > 0 ) {
               fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
                       colind[iloc]+1, colind[iloc]+off+1, chvent[ii]) ;
            } else {
               fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
                       colind[iloc]-off+1, colind[iloc]+1, chvent[ii]) ;
            }
         }
      }
   } else if ( CHV_IS_COMPLEX(chv) ) {
      if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
         for ( ii = 0 ; ii < chvsize ; ii++ ) {
            off = chvind[ii] ;
            fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
                    colind[iloc]+1, colind[iloc]+off+1,
                    chvent[2*ii], chvent[2*ii+1]) ;
            if ( CHV_IS_HERMITIAN(chv) ) {
               fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
                       colind[iloc]+off+1, colind[iloc]+1, 
                       chvent[2*ii], -chvent[2*ii+1]) ;
            } else {
               fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
                       colind[iloc]+off+1, colind[iloc]+1, 
                       chvent[2*ii], chvent[2*ii+1]) ;
            }
         }
      } else {
         for ( ii = 0 ; ii < chvsize ; ii++ ) {
            off = chvind[ii] ;
            if ( off > 0 ) {
               fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
                       colind[iloc]+1, colind[iloc]+off+1,
                       chvent[2*ii], chvent[2*ii+1]) ;
            } else {
               fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
                       colind[iloc]-off+1, colind[iloc]+1, 
                       chvent[2*ii], chvent[2*ii+1]) ;
            }
         }
      }
   }
}
/*
   ------------------------------------
   add the chevron into the Chv object
   ------------------------------------
*/
Chv_addChevron(chv, alpha, ichv, chvsize, chvind, chvent) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n %% after adding the chevron") ;
   fprintf(msgFile, "\n c = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
   Chv_writeForMatlab(chv, "c", msgFile) ;
}
/*
   -----------------
   compute the error
   -----------------
*/
fprintf(msgFile, "\n max(max(abs(c - (a + alpha*b))))") ;
/*
   ------------------------
   free the working storage
   ------------------------
*/
Chv_free(chv) ;
Drand_free(drand) ;
IVfree(temp) ;
IVfree(chvind) ;
DVfree(chvent) ;
IVfree(keys) ;

fprintf(msgFile, "\n") ;

return(1) ; }
예제 #12
0
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ---------------------------------------------------
   test the Chv_findPivot(), swap and update methods.
   the program's output is a matlab file
   to check correctness of the code.

   created -- 98jan24, cca
   ---------------------------------------------------
*/
{
Chv     *chv ;
double   imag, real, tau, t1, t2 ;
double   *entries ;
Drand    *drand ;
DV       *workDV ;
FILE     *msgFile ;
int      icol, ii, ipvt, irow, jcol, jpvt, jrow, msglvl, ncol, nD, 
         ndelay, nent, nL, nrow, ntest, nU, rc, pivotsize, seed, 
         symflag, tag, temp, type ;
int      *colind, *rowind ;

if ( argc != 9 ) {
   fprintf(stdout, 
           "\n\n usage : %s msglvl msgFile nD nU type symflag seed tau "
           "\n    msglvl  -- message level"
           "\n    msgFile -- message file"
           "\n    nD      -- # of rows and columns in the (1,1) block"
           "\n    nU      -- # of columns in the (1,2) block"
           "\n    type    -- entries type"
           "\n       1 --> real"
           "\n       2 --> complex"
           "\n    symflag -- symmetry flag"
           "\n       0 --> symmetric"
           "\n       1 --> hermitian"
           "\n       2 --> nonsymmetric"
           "\n    seed    -- random number seed"
           "\n    tau     -- bound on magnitudes of factor entries"
           "\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) ;
}
nD      = atoi(argv[3]) ;
nU      = atoi(argv[4]) ;
type    = atoi(argv[5]) ;
symflag = atoi(argv[6]) ;
seed    = atoi(argv[7]) ;
tau     = atof(argv[8]) ;
fprintf(msgFile, "\n %% testChv:"
        "\n %% msglvl  = %d"
        "\n %% msgFile = %s"
        "\n %% nD      = %d"
        "\n %% nU      = %d"
        "\n %% type    = %d"
        "\n %% symflag = %d"
        "\n %% seed    = %d"
        "\n %% tau     = %12.4e",
        msglvl, argv[2], nD, nU, type, symflag, seed, tau) ;
nL   = nU ;
nrow = nD + nL ;
ncol = nD + nU ;
/*
   -----------------------------
   check for errors in the input
   -----------------------------
*/
if (  nD <= 0 || nU < 0 
   || (symflag != SPOOLES_SYMMETRIC
   &&  symflag !=  SPOOLES_HERMITIAN
   &&  symflag !=  SPOOLES_NONSYMMETRIC) ) {
   fprintf(stderr, "\n invalid input"
      "\n nD = %d, nL = %d, nU = %d, symflag = %d\n",
           nD, nL, nU, symflag) ;
   exit(-1) ;
}
if (  (symflag ==  SPOOLES_SYMMETRIC || symflag ==  SPOOLES_HERMITIAN) 
   && nL != nU ) {
   fprintf(stderr, "\n invalid input"
      "\n symflag = %d, nL = %d, nU = %d", symflag, nL, nU) ;
   exit(-1) ;
}
fprintf(msgFile,
        "\n nD = %d ;"
        "\n nL = %d ;"
        "\n nU = %d ;"
        "\n nrow = nD + nL ;"
        "\n ncol = nD + nU ;",
        nD, nL, nU) ;
/*
   --------------------------------------
   initialize the random number generator
   --------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setNormal(drand, 0.0, 1.0) ;
/*
   --------------------------
   initialize the Chv object
   --------------------------
*/
MARKTIME(t1) ;
chv = Chv_new() ;
Chv_init(chv, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize chv object",
        t2 - t1) ;
fflush(msgFile) ;
Chv_columnIndices(chv, &ncol, &colind) ;
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chv) ) {
   Chv_rowIndices(chv, &nrow, &rowind) ;
   IVramp(nrow, rowind, 0, 1) ;
}
/*
   ------------------------------------
   load the entries with random entries
   ------------------------------------
*/
nent    = Chv_nent(chv) ;
entries = Chv_entries(chv) ;
if ( CHV_IS_REAL(chv) ) {
   Drand_fillDvector(drand, nent, entries) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
   Drand_fillDvector(drand, 2*nent, entries) ;
}
if ( msglvl > 4 ) {
   fprintf(msgFile, "\n raw entries vector") ;
   DVfprintf(msgFile, 2*nent, entries) ;
   fflush(msgFile) ;
}
if ( CHV_IS_HERMITIAN(chv) ) {
/*
   ---------------------------------------------------------
   hermitian example, set imaginary part of diagonal to zero
   ---------------------------------------------------------
*/
   for ( irow = 0 ; irow < nD ; irow++ ) {
      Chv_complexEntry(chv, irow, irow, &real, &imag) ;
      Chv_setComplexEntry(chv, irow, irow, real, 0.0) ;
   }
}
fprintf(msgFile, "\n %% matrix entries") ;
Chv_writeForMatlab(chv, "a", msgFile) ;
/*
   ------------
   find a pivot 
   ------------
*/
workDV = DV_new() ;
ndelay = 0 ;
ntest  = 0 ;
pivotsize = Chv_findPivot(chv, workDV, tau, ndelay, 
                           &irow, &jcol, &ntest) ;
fprintf(msgFile, "\n\n %% pivotsize = %d", pivotsize) ;
ipvt = irow ;
jpvt = jcol ;
if (  (symflag == SPOOLES_SYMMETRIC || symflag == SPOOLES_HERMITIAN)
   && irow > jcol ) {
   temp = irow ;
   irow = jcol ;
   jcol = temp ;
}
fprintf(msgFile, "\n\n irow = %d ; \n jcol = %d ;", irow+1, jcol+1) ;
/*
   -------------------------
   swap the rows and columns
   -------------------------
*/
if ( pivotsize == 0 ) {
   exit(0) ;
} else if ( pivotsize == 1 ) {
   fprintf(msgFile, 
           "\n b = a ;"
           "\n xtemp = b(irow,:) ;"
           "\n b(irow,:) = b(1,:) ;"
           "\n b(1,:) = xtemp ;"
           "\n xtemp = b(:,jcol) ;"
           "\n b(:,jcol) = b(:,1) ;"
           "\n b(:,1) = xtemp ;") ;
   if ( CHV_IS_SYMMETRIC(chv) || symflag == CHV_IS_HERMITIAN(chv) ) {
      Chv_swapRowsAndColumns(chv, 0, irow) ;
   } else {
      Chv_swapRows(chv, 0, irow) ;
      Chv_swapColumns(chv, 0, jcol) ;
   }
} else if ( pivotsize == 2 ) {
   if ( symflag < 2 ) {
      fprintf(msgFile, 
              "\n b = a ;"
              "\n xtemp = b(irow,:) ;"
              "\n b(irow,:) = b(1,:) ;"
              "\n b(1,:) = xtemp ;"
              "\n xtemp = b(:,irow) ;"
              "\n b(:,irow) = b(:,1) ;"
              "\n b(:,1) = xtemp ;"
              "\n xtemp = b(jcol,:) ;"
              "\n b(jcol,:) = b(2,:) ;"
              "\n b(2,:) = xtemp ;"
              "\n xtemp = b(:,jcol) ;"
              "\n b(:,jcol) = b(:,2) ;"
              "\n b(:,2) = xtemp ;") ;
      Chv_swapRowsAndColumns(chv, 0, irow) ;
      Chv_swapRowsAndColumns(chv, 1, jcol) ;
   } else {
      fprintf(stderr, "\n fatal error, symflag = %d, pvtsize = %d",
              symflag, pivotsize) ;
      exit(-1) ;
   }
}
/*
   -----------------------------------------
   check that the swap was executed properly
   -----------------------------------------
*/
fprintf(msgFile, "\n %% matrix entries") ;
Chv_writeForMatlab(chv, "c", msgFile) ;
fprintf(msgFile, "\n maxerrswap = norm(c - a)") ;
/*
   ---------------------------
   ramp the indices once again
   ---------------------------
*/
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chv) ) {
   Chv_rowIndices(chv, &nrow, &rowind) ;
   IVramp(nrow, rowind, 0, 1) ;
}
/*
   -----------------------------------
   perform the rank-1 or rank-2 update
   -----------------------------------
*/
fprintf(msgFile, "\n\n ckeep = b ;") ;
fprintf(msgFile, "\n\n c = b ;") ;
if ( pivotsize == 1 ) {
   rc = Chv_r1upd(chv) ;
   fprintf(msgFile, 
           "\n\n d = c(1,1) ;"
           "\n l = c(2:nrow,1)/d ;"
           "\n u = c(1,2:ncol) ;") ;
   if ( nD > 1 ) {
      fprintf(msgFile, 
           "\n c(2:nrow,2:ncol) = c(2:nrow,2:ncol) - l*u ;") ;
   }
   fprintf(msgFile, 
           "\n u = u / d ;"
           "\n c(1:1,1:1) = d ; "
           "\n c(1:1,2:ncol) = u ; "
           "\n c(2:ncol,1:1) = l ; ") ;
   fprintf(msgFile, "\n c(nD+1:nrow,nD+1:ncol) = 0 ;") ;
} else {
   rc = Chv_r2upd(chv) ;
   fprintf(msgFile, 
           "\n\n d = c(1:2,1:2) ;"
           "\n l = c(3:nrow,1:2) / d ;"
           "\n u = c(1:2,3:ncol) ;") ;
   if ( nD > 2 ) {
      fprintf(msgFile, 
              "\n c(3:nrow,3:ncol) = c(3:nrow,3:ncol) - l*u ;") ;
   }
   fprintf(msgFile, 
           "\n u = d \\ u ; "
           "\n c(1:2,1:2) = d ; "
           "\n c(1:2,3:ncol) = u ; "
           "\n c(3:ncol,1:2) = l ; ") ;
   if ( nU > 0 ) {
      fprintf(msgFile, 
           "\n c(nD+1:nrow,nD+1:ncol) = 0 ;") ;
   }
}
fprintf(msgFile, "\n %% matrix entries after update") ;
Chv_writeForMatlab(chv, "f", msgFile) ;
fprintf(msgFile, "\n maxerrupd = norm(f - c)") ;
/*
   ------------------------------------------------------
   check out the maximum magnitude of elements in l and u
   ------------------------------------------------------
*/
fprintf(msgFile, "\n ipvt = %d", ipvt + 1) ;
fprintf(msgFile, "\n jpvt = %d", jpvt + 1) ;
fprintf(msgFile, "\n pivotsize = %d", pivotsize) ;
fprintf(msgFile, "\n tau = %12.4e", tau) ;
if ( symflag < 2 ) {
   fprintf(msgFile, "\n ubound = max(max(abs(u))) ") ;
} else {
   fprintf(msgFile, 
           "\n lbound = max(max(abs(l))) "
           "\n ubound = max(max(abs(u))) ") ;
}
/*
   ------------------------
   free the working storage
   ------------------------
*/
Chv_free(chv) ;
Drand_free(drand) ;
DV_free(workDV) ;
           
fprintf(msgFile, "\n") ;

return(1) ; }
예제 #13
0
파일: util.c 프로젝트: bialk/SPOOLES
/*
   ----------------------------------------------------------------
   purpose -- to create an InpMtx object filled with random entries

   input --

      mtx         -- matrix object, if NULL, it is created
      inputMode   -- input mode for the object,
                     indices only, real or complex entries
      coordType   -- coordinate type for the object,
                     by rows, by columns or by chevrons
      storageMode -- storage mode for the object,
                     raw data, sorted or by vectors
      nrow        -- # of rows
      ncol        -- # of columns
      symflag     -- symmetry flag for the matrix,
                     symmetric, hermitian or nonsymmetric
      nonzerodiag -- if 1, entries are placed on the diagonal
      nitem       -- # of items to be placed into the matrix
      seed        --  random number seed

   return value ---
      1 -- normal return
     -1 -- mtx is NULL
     -2 -- bad input mode
     -3 -- bad coordinate type
     -4 -- bad storage mode
     -5 -- nrow or ncol <= 0
     -6 -- bad symmetry flag
     -7 -- hermitian matrix but not complex
     -8 -- symmetric or hermitian matrix but nrow != ncol
     -9 -- nitem < 0
   ----------------------------------------------------------------
*/
int
InpMtx_randomMatrix (
   InpMtx   *mtx,
   int      inputMode,
   int      coordType,
   int      storageMode,
   int      nrow,
   int      ncol,
   int      symflag,
   int      nonzerodiag,
   int      nitem,
   int      seed
) {
double   *dvec ;
Drand    *drand ;
int      col, ii, neqns, row ;
int      *colids, *rowids ;
/*
   ---------------
   check the input
   ---------------
*/
if ( mtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n mtx is NULL\n") ;
   return(-1) ;
}
switch ( inputMode ) {
case INPMTX_INDICES_ONLY :
case SPOOLES_REAL        :
case SPOOLES_COMPLEX     :
   break ;
default :
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n bad input mode %d\n", inputMode) ;
   return(-2) ;
   break ;
}
switch ( coordType ) {
case INPMTX_BY_ROWS     :
case INPMTX_BY_COLUMNS  :
case INPMTX_BY_CHEVRONS :
   break ;
default :
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n bad coordinate type %d\n", coordType) ;
   return(-3) ;
   break ;
}
switch ( storageMode ) {
case INPMTX_RAW_DATA   :
case INPMTX_SORTED     :
case INPMTX_BY_VECTORS :
   break ;
default :
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n bad storage mode%d\n", storageMode) ;
   return(-4) ;
   break ;
}
if ( nrow <= 0 || ncol <= 0 ) {
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n nrow = %d, ncol = %d\n", nrow, ncol) ;
   return(-5) ;
}
switch ( symflag ) {
case SPOOLES_SYMMETRIC    :
case SPOOLES_HERMITIAN    :
case SPOOLES_NONSYMMETRIC :
   break ;
default :
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n bad symmetry flag%d\n", symflag) ;
   return(-6) ;
   break ;
}
if ( symflag == SPOOLES_HERMITIAN && inputMode != SPOOLES_COMPLEX ) {
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n symmetryflag is Hermitian, requires complex type\n") ;
   return(-7) ;
}
if ( (symflag == SPOOLES_SYMMETRIC || symflag == SPOOLES_HERMITIAN)
  && nrow != ncol ) {
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n symmetric or hermitian matrix, nrow %d, ncol%d\n",
           nrow, ncol) ;
   return(-8) ;
}
if ( nitem < 0 ) {
   fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
           "\n nitem = %d\n", nitem) ;
   return(-9) ;
}
/*--------------------------------------------------------------------*/
neqns = (nrow <= ncol) ? nrow : ncol ;
if ( nonzerodiag == 1 ) {
   nitem += neqns ;
}
/*
   ---------------------
   initialize the object
   ---------------------
*/
InpMtx_init(mtx, INPMTX_BY_ROWS, inputMode, nitem, 0) ;
/*
   ----------------
   fill the triples
   ----------------
*/
drand = Drand_new() ;
Drand_setSeed(drand, seed) ;
rowids = IVinit(nitem, -1) ;
colids = IVinit(nitem, -1) ;
if ( nonzerodiag == 1 ) {
   IVramp(neqns, rowids, 0, 1) ;
   Drand_setUniform(drand, 0, nrow) ;
   Drand_fillIvector(drand, nitem - neqns, rowids + neqns) ;
   Drand_setUniform(drand, 0, ncol) ;
   IVramp(neqns, colids, 0, 1) ;
   Drand_fillIvector(drand, nitem - neqns, colids + neqns) ;
} else {
   Drand_setUniform(drand, 0, nrow) ;
   Drand_fillIvector(drand, nitem, rowids) ;
   Drand_setUniform(drand, 0, ncol) ;
   Drand_fillIvector(drand, nitem, colids) ;
}
if ( symflag == SPOOLES_SYMMETRIC || symflag == SPOOLES_HERMITIAN ) {
   for ( ii = 0 ; ii < nitem ; ii++ ) {
      if ( (row = rowids[ii]) > (col = colids[ii]) ) {
         rowids[ii] = col ;
         colids[ii] = row ;
      }
   }
}
if ( inputMode == SPOOLES_REAL ) {
   dvec = DVinit(nitem, 0.0) ;
   Drand_setUniform(drand, 0.0, 1.0) ;
   Drand_fillDvector(drand, nitem, dvec) ;
} else if ( inputMode == SPOOLES_COMPLEX ) {
   dvec = DVinit(2*nitem, 0.0) ;
   Drand_setUniform(drand, 0.0, 1.0) ;
   Drand_fillDvector(drand, 2*nitem, dvec) ;
   if ( symflag == SPOOLES_HERMITIAN ) {
      for ( ii = 0 ; ii < nitem ; ii++ ) {
         if ( rowids[ii] == colids[ii] ) {
            dvec[2*ii+1] = 0.0 ;
         }
      }
   }
} else {
   dvec = NULL ;
}
/*
   ----------------
   load the triples
   ----------------
*/
switch ( inputMode ) {
case INPMTX_INDICES_ONLY :
   InpMtx_inputTriples(mtx, nitem, rowids, colids) ;
   break ;
case SPOOLES_REAL :
   InpMtx_inputRealTriples(mtx, nitem, rowids, colids, dvec) ;
   break ;
case SPOOLES_COMPLEX :
   InpMtx_inputComplexTriples(mtx, nitem, rowids, colids, dvec) ;
   break ;
}
/*
   ----------------------------------------
   set the coordinate type and storage mode
   ----------------------------------------
*/
InpMtx_changeCoordType(mtx, coordType) ;
InpMtx_changeStorageMode(mtx, storageMode) ;
/*
   ------------------------
   free the working storage
   ------------------------
*/
Drand_free(drand) ;
IVfree(rowids) ;
IVfree(colids) ;
if ( dvec != NULL ) {
   DVfree(dvec) ;
}
return(1) ; }
예제 #14
0
파일: sort.c 프로젝트: bialk/SPOOLES
/*
   ----------------------------------------------
   sort the rows of the matrix in ascending order
   of the rowids[] vector. on return, rowids is
   in asending order. return value is the number
   of row swaps made.

   created -- 98apr15, cca
   ----------------------------------------------
*/
int
A2_sortRowsUp (
   A2    *mtx,
   int   nrow,
   int   rowids[]
) {
int   ii, minrow, minrowid, nswap, target ;
/*
   ---------------
   check the input
   ---------------
*/
if ( mtx == NULL || mtx->n1 < nrow || nrow < 0 || rowids == NULL ) {
   fprintf(stderr, "\n fatal error in A2_sortRowsUp(%p,%d,%p)"
           "\n bad input\n", mtx, nrow, rowids) ;
   if ( mtx != NULL ) {
      A2_writeStats(mtx, stderr) ;
   }
   exit(-1) ;
}
if ( ! (A2_IS_REAL(mtx) || A2_IS_COMPLEX(mtx)) ) {
   fprintf(stderr, "\n fatal error in A2_sortRowsUp(%p,%d,%p)"
           "\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n", 
           mtx, nrow, rowids, mtx->type) ;
   exit(-1) ;
}
nswap = 0 ;
if ( mtx->inc1 == 1 ) {
   double   *dvtmp ;
   int      jcol, ncol ;
   int      *ivtmp ;
/*
   ---------------------------------------------------
   matrix is stored by columns, so permute each column
   ---------------------------------------------------
*/
   ivtmp = IVinit(nrow, -1) ;
   if ( A2_IS_REAL(mtx) ) {
      dvtmp = DVinit(nrow, 0.0) ;
   } else if ( A2_IS_COMPLEX(mtx) ) {
      dvtmp = DVinit(2*nrow, 0.0) ;
   }
   IVramp(nrow, ivtmp, 0, 1) ;
   IV2qsortUp(nrow, rowids, ivtmp) ;
   ncol = mtx->n2 ;
   for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
      if ( A2_IS_REAL(mtx) ) {
         DVcopy(nrow, dvtmp, A2_column(mtx, jcol)) ;
         DVgather(nrow, A2_column(mtx, jcol), dvtmp, ivtmp) ;
      } else if ( A2_IS_COMPLEX(mtx) ) {
         ZVcopy(nrow, dvtmp, A2_column(mtx, jcol)) ;
         ZVgather(nrow, A2_column(mtx, jcol), dvtmp, ivtmp) ;
      }
   }
   IVfree(ivtmp) ;
   DVfree(dvtmp) ;
} else {
/*
   ----------------------------------------
   use a simple insertion sort to swap rows
   ----------------------------------------
*/
   for ( target = 0 ; target < nrow ; target++ ) {
      minrow   = target ;
      minrowid = rowids[target] ;
      for ( ii = target + 1 ; ii < nrow ; ii++ ) {
         if ( minrowid > rowids[ii] ) {
            minrow   = ii ;
            minrowid = rowids[ii] ;
         }
      }
      if ( minrow != target ) {
         rowids[minrow] = rowids[target] ;
         rowids[target] = minrowid ;
         A2_swapRows(mtx, target, minrow) ;
         nswap++ ;
      }
   }
}

return(nswap) ; }
예제 #15
0
/*
   -------------------------------------------------------
   purpose -- merge the front tree allowing a parent 
              to absorb all children when that creates 
              at most maxzeros zero entries inside a front

   return -- 
      IV object that has the old front to new front map

   created -- 98jan29, cca
   -------------------------------------------------------
*/
ETree *
ETree_mergeFrontsAll (
   ETree   *etree,
   int     maxzeros,
   IV      *nzerosIV
) {
ETree   *etree2 ;
int     cost, J, Jall, K, KandBnd, nfront, nvtx, nnew ;
int     *bndwghts, *fch, *map, *nodwghts, *nzeros, *rep, *sib, *temp ;
IV      *mapIV ;
Tree    *tree ;
/*
   ---------------
   check the input
   ---------------
*/
if (  etree == NULL || nzerosIV == NULL
   || (nfront = etree->nfront) <= 0
   || (nvtx = etree->nvtx) <= 0 ) {
   fprintf(stderr, "\n fatal error in ETree_mergeFrontsAll(%p,%d,%p)"
           "\n bad input\n", etree, maxzeros, nzerosIV) ;
   if ( etree != NULL ) {
      fprintf(stderr, "\n nfront = %d, nvtx = %d",
              etree->nfront, etree->nvtx) ;
   }
   spoolesFatal();
}
if ( IV_size(nzerosIV) != nfront ) {
   fprintf(stderr, "\n fatal error in ETree_mergeFrontsAll(%p,%d,%p)"
           "\n size(nzerosIV) = %d, nfront = %d\n", 
           etree, maxzeros, nzerosIV, IV_size(nzerosIV), nfront) ;
   spoolesFatal();
}
nzeros = IV_entries(nzerosIV) ;
/*
   ----------------------
   set up working storage
   ----------------------
*/
tree     = etree->tree ;
fch      = ETree_fch(etree) ;
sib      = ETree_sib(etree) ;
nodwghts = IVinit(nfront, 0) ;
IVcopy(nfront, nodwghts, ETree_nodwghts(etree)) ;
bndwghts = ETree_bndwghts(etree) ;
rep = IVinit(nfront, -1) ;
IVramp(nfront, rep, 0, 1) ;
/*
   ------------------------------------------
   perform a post-order traversal of the tree
   ------------------------------------------
*/
for ( K = Tree_postOTfirst(tree) ;
      K != -1 ;
      K = Tree_postOTnext(tree, K) ) {
#if MYDEBUG > 0
   fprintf(stdout, "\n\n ##### visiting front %d", K) ;
   fflush(stdout) ;
#endif
   if ( (J = fch[K]) != -1 ) {
      KandBnd = nodwghts[K] + bndwghts[K] ;
      Jall = 0 ;
      cost = 2*nzeros[K] ;
      for ( J = fch[K] ; J != -1 ; J = sib[J] ) {
         Jall += nodwghts[J] ;
         cost -= nodwghts[J]*nodwghts[J] ;
         cost += 2*nodwghts[J]*(KandBnd - bndwghts[J]) ;
         cost += 2*nzeros[J] ;
      }
      cost += Jall*Jall ;
      cost = cost/2 ;
#if MYDEBUG > 0
      fprintf(stdout, "\n cost = %d", cost) ;
      fflush(stdout) ;
#endif
      if ( cost <= maxzeros ) {
         for ( J = fch[K] ; J != -1 ; J = sib[J] ) {
#if MYDEBUG > 0
            fprintf(stdout, "\n merging %d into %d", J, K) ;
            fflush(stdout) ;
#endif
            rep[J] = K ;
            nodwghts[K] += nodwghts[J] ;
         }
         nzeros[K] = cost ;
      }
   }
}
#if MYDEBUG > 0
   fprintf(stdout, "\n\n whoa, finished") ;
   fflush(stdout) ;
#endif
/*
   -------------------------------------------------
   take the map from fronts to representative fronts
   and make the map from old fronts to new fronts
   -------------------------------------------------
*/
mapIV = IV_new() ;
IV_init(mapIV, nfront, NULL) ;
map   = IV_entries(mapIV) ;
for ( J = 0, nnew = 0 ; J < nfront ; J++ ) {
   if ( rep[J] == J ) {
      map[J] = nnew++ ;
   } else {
      K = J ;
      while ( rep[K] != K ) {
         K = rep[K] ;
      }
      rep[J] = K ;
   }
}
for ( J = 0 ; J < nfront ; J++ ) {
   if ( (K = rep[J]) != J ) {
      map[J] = map[K] ;
   }
}
/*
   -------------------------------
   get the compressed ETree object
   -------------------------------
*/
etree2 = ETree_compress(etree, mapIV) ;
/*
   -------------------------
   remap the nzeros[] vector
   -------------------------
*/
temp = IVinit(nfront, 0) ;
IVcopy(nfront, temp, nzeros) ;
IV_setSize(nzerosIV, nnew) ;
nzeros = IV_entries(nzerosIV) ;
for ( J = 0 ; J < nfront ; J++ ) {
   if ( rep[J] == J ) {
      nzeros[map[J]] = temp[J] ;
   }
}
IVfree(temp) ;
/*
   ------------------------
   free the working storage
   ------------------------
*/
IVfree(nodwghts) ;
IVfree(rep)      ;
IV_free(mapIV)   ;

return(etree2) ; }
예제 #16
0
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   -------------------------------------
   test the Chv_r1upd() method.
   the program's output is a matlab file
   to check correctness of the code.

   created -- 98apr30, cca
   -------------------------------------
*/
{
Chv     *chv ;
double   imag, real, t1, t2 ;
double   *entries ;
Drand    *drand ;
FILE     *msgFile ;
int      ii, irow, jcol, msglvl, ncol, nD, nent, nL, nrow, nU, 
         rc, seed, symflag, tag, type ;
int      *colind, *rowind ;

if ( argc != 8 ) {
   fprintf(stdout, 
           "\n\n usage : %s msglvl msgFile nD nU type symflag seed "
           "\n    msglvl  -- message level"
           "\n    msgFile -- message file"
           "\n    nD      -- # of rows and columns in the (1,1) block"
           "\n    nU      -- # of columns in the (1,2) block"
           "\n    type    -- entries type"
           "\n       1 --> real"
           "\n       2 --> complex"
           "\n    symflag -- symmetry flag"
           "\n       0 --> hermitian"
           "\n       1 --> symmetric"
           "\n       2 --> nonsymmetric "
           "\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) ;
}
nD      = atoi(argv[3]) ;
nU      = atoi(argv[4]) ;
type    = atoi(argv[5]) ;
symflag = atoi(argv[6]) ;
seed    = atoi(argv[7]) ;
fprintf(msgFile, "\n %% testChv:"
        "\n %% msglvl  = %d"
        "\n %% msgFile = %s"
        "\n %% nD      = %d"
        "\n %% nU      = %d"
        "\n %% type    = %d"
        "\n %% symflag = %d"
        "\n %% seed    = %d",
        msglvl, argv[2], nD, nU, type, symflag, seed) ;
nL = nU ;
/*
   -----------------------------
   check for errors in the input
   -----------------------------
*/
if (  nD <= 0 || nL < 0 || nU < 0 
   || symflag < 0 || symflag > 3 ) {
   fprintf(stderr, "\n invalid input"
      "\n nD = %d, nL = %d, nU = %d, symflag = %d\n",
           nD, nL, nU, symflag) ;
   exit(-1) ;
}
if ( symflag <= 2 && nL != nU ) {
   fprintf(stderr, "\n invalid input"
      "\n symflag = %d, nL = %d, nU = %d", symflag, nL, nU) ;
   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 Chv object
   ----------------------------
*/
MARKTIME(t1) ;
chv = Chv_new() ;
Chv_init(chv, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize chv object",
        t2 - t1) ;
fflush(msgFile) ;
Chv_columnIndices(chv, &ncol, &colind) ;
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chv) ) {
   Chv_rowIndices(chv, &nrow, &rowind) ;
   IVramp(nrow, rowind, 0, 1) ;
}
/*
   ------------------------------------
   load the entries with random entries
   ------------------------------------
*/
nent    = Chv_nent(chv) ;
entries = Chv_entries(chv) ;
if ( CHV_IS_REAL(chv) ) {
   Drand_fillDvector(drand, nent, entries) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
   Drand_fillDvector(drand, 2*nent, entries) ;
}
if ( CHV_IS_HERMITIAN(chv) ) {
   for ( irow = 0 ; irow < nD ; irow++ ) {
      Chv_complexEntry(chv, irow, irow, &real, &imag) ;
      Chv_setComplexEntry(chv, irow, irow, real, 0.0) ;
   }
}
fprintf(msgFile, "\n %% matrix entries") ;
Chv_writeForMatlab(chv, "a", msgFile) ;
/*
   ---------------------------------------
   write out matlab code for rank-1 update
   ---------------------------------------
*/
fprintf(msgFile,
        "\n nD = %d ;"
        "\n nL = %d ;"
        "\n nU = %d ;"
        "\n nrow = nD + nL ;"
        "\n ncol = nD + nU ;"
        "\n b = a ; "
        "\n d = a(1,1) ;"
        "\n l = a(2:nrow,1) / d ; "
        "\n u = a(1,2:ncol) ; "
        "\n b(2:nrow,2:ncol) = a(2:nrow,2:ncol) - l * u ; "
        "\n u = u / d ; "
        "\n b(1,1) = d ; "
        "\n b(1,2:ncol) = u ; "
        "\n b(2:nrow,1) = l ; ",
        nD, nL, nU) ;
if ( nL > 0 && nU > 0 ) {
   fprintf(msgFile, "\n b(nD+1:nrow,nD+1:ncol) = 0.0 ;") ;
}
/*
   -------------------------
   perform the rank-1 update
   -------------------------
*/
rc = Chv_r1upd(chv) ;
/*
fprintf(msgFile, "\n raw entries vector") ;
DVfprintf(msgFile, 2*nent, entries) ;
*/
fprintf(msgFile, "\n %% matrix entries after update") ;
Chv_writeForMatlab(chv, "c", msgFile) ;
fprintf(msgFile, "\n maxerr = max(max(abs(c-b)))") ;
/*
   ------------------------
   free the working storage
   ------------------------
*/
Chv_free(chv) ;
Drand_free(drand) ;
           
fprintf(msgFile, "\n") ;

return(1) ; }
예제 #17
0
/*
   ------------------------------------------------
   given a permutation and a vector to map vertices 
   into compressed vertices, create and return a 
   permutation object for the compressed vertices.

   created -- 96may02, cca
   ------------------------------------------------
*/
Perm *
Perm_compress (
   Perm   *perm,
   IV     *eqmapIV
) {
int    n, N, v, vcomp, vnew ;
int    *eqmap, *head, *link, *newToOld, *oldToNew, *vals ; 
Perm   *perm2 ;
/*
   ---------------
   check the input
   ---------------
*/
if (  perm == NULL 
   || (n = perm->size) <= 0
   || eqmapIV == NULL 
   || n != IV_size(eqmapIV)
   || (eqmap = IV_entries(eqmapIV)) == NULL ) {
   fprintf(stderr, "\n fatal error in Perm_compress(%p,%p)"
           "\n bad input\n", perm, eqmapIV) ;
   if ( perm != NULL ) {
      Perm_writeStats(perm, stderr) ;
   }
   if ( eqmapIV != NULL ) {
      IV_writeStats(eqmapIV, stderr) ;
   }
   spoolesFatal();
}
n = perm->size ;
if ( (oldToNew = perm->oldToNew) == NULL ) {
   Perm_fillOldToNew(perm) ;
   oldToNew = perm->oldToNew ;
}
if ( (newToOld = perm->newToOld) == NULL ) {
   Perm_fillNewToOld(perm) ;
   newToOld = perm->newToOld ;
}
/*
   ---------------------------------
   create the new permutation object
   ---------------------------------
*/
N = 1 + IVmax(n, eqmap, &v) ;
perm2 = Perm_new() ;
Perm_initWithTypeAndSize(perm2, 3, N) ;
/*
   --------------------------------------------
   get the head/link structure for the vertices
   --------------------------------------------
*/
head = IVinit(N, -1) ;
link = IVinit(n, -1) ;
for ( v = 0 ; v < n ; v++ ) {
   vcomp = eqmap[v] ;
   link[v] = head[vcomp] ;
   head[vcomp] = v ;
}
/*
   ---------------------------
   get the two vectors to sort
   ---------------------------
*/
IVramp(N, perm2->newToOld, 0, 1) ;
vals = IVinit(N, -1) ;
for ( vcomp = 0 ; vcomp < N ; vcomp++ ) {
   v = head[vcomp] ;
   vnew = perm->oldToNew[v] ;
   for ( v = link[v] ; v != -1 ; v = link[v] ) {
      if ( vnew > perm->oldToNew[v] ) {
         vnew = perm->oldToNew[v] ;
      }
   }
   vals[vcomp] = vnew ;
}
IV2qsortUp(N, vals, perm2->newToOld) ;
for ( vcomp = 0 ; vcomp < N ; vcomp++ ) {
   perm2->oldToNew[perm2->newToOld[vcomp]] = vcomp ;
}
/*
   ---------------------
   free the working data
   ---------------------
*/
IVfree(head) ;
IVfree(link) ;
IVfree(vals) ;

return(perm2) ; }