Esempio n. 1
0
File: util.c Progetto: bialk/SPOOLES
/*
   -----------------------------------------------------------
   purpose -- compute the checksums of the indices and entries

      sums[0] = sum_{ii=0}^{nent} abs(ivec1[ii])
      sums[1] = sum_{ii=0}^{nent} abs(ivec2[ii])
      if real or complex entries then
         sums[2] = sum_{ii=0}^{nent} magnitudes of entries
      endif

   created -- 98may16, cca
   -----------------------------------------------------------
*/
void
InpMtx_checksums (
   InpMtx   *inpmtx,
   double   sums[]
) {
int   ient, nent ;
int   *ivec1, *ivec2 ;
/*
   ---------------
   check the input
   ---------------
*/
if ( inpmtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_checksums(%p,%p)"
           "\n bad input\n", inpmtx, sums) ;
   exit(-1) ;
}
switch ( inpmtx->inputMode ) {
case INPMTX_INDICES_ONLY :
case SPOOLES_REAL :
case SPOOLES_COMPLEX :
   break ;
default :
   fprintf(stderr, "\n fatal error in InpMtx_checksums(%p,%p)"
           "\n bad inputMode\n", inpmtx, sums) ;
   exit(-1) ;
}
sums[0] = sums[1] = sums[2] = 0.0 ;
if ( (nent = InpMtx_nent(inpmtx)) <= 0 ) {
   return ;
}
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
for ( ient = 0 ; ient < nent ; ient++ ) {
   sums[0] += abs(ivec1[ient]) ;
   sums[1] += abs(ivec2[ient]) ;
}
switch ( inpmtx->inputMode ) {
case INPMTX_INDICES_ONLY :
   break ;
case SPOOLES_REAL : {
   double *dvec  = InpMtx_dvec(inpmtx)  ;
   for ( ient = 0 ; ient < nent ; ient++ ) {
      sums[2] += fabs(dvec[ient]) ;
   }
   } break ;
case SPOOLES_COMPLEX : {
   double *dvec  = InpMtx_dvec(inpmtx)  ;
   for ( ient = 0 ; ient < nent ; ient++ ) {
      sums[2] += Zabs(dvec[2*ient], dvec[2*ient+1]) ;
   }
   } break ;
}
return ; }
Esempio n. 2
0
File: util.c Progetto: bialk/SPOOLES
/*
   -----------------------------------
   map entries into the upper triangle

   created -- 98jan28, cca
   -----------------------------------
*/
void
InpMtx_mapToUpperTriangle (
   InpMtx   *inpmtx
) {
int      col, ii, nent, row ;
int      *ivec1, *ivec2 ;
/*
   ---------------
   check the input
   ---------------
*/
if ( inpmtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapToUpperTriangle(%p)"
           "\n bad input\n", inpmtx) ;
   exit(-1) ;
}
if ( !(   INPMTX_IS_BY_ROWS(inpmtx)
       || INPMTX_IS_BY_COLUMNS(inpmtx)
       || INPMTX_IS_BY_CHEVRONS(inpmtx) ) ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapToUpperTriangle(%p)"
           "\n bad coordType = %d, must be 1, 2, or 3\n", 
           inpmtx, inpmtx->coordType) ;
   exit(-1) ;
}
nent  = inpmtx->nent ;
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( (row = ivec1[ii]) > (col = ivec2[ii]) ) {
         ivec1[ii] = col ;
         ivec2[ii] = row ;
      }
   }
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( (row = ivec2[ii]) > (col = ivec1[ii]) ) {
         ivec1[ii] = row ;
         ivec2[ii] = col ;
      }
   }
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( ivec2[ii] < 0 ) {
         ivec2[ii] = -ivec2[ii] ;
      }
   }
}
inpmtx->storageMode = INPMTX_RAW_DATA ;

return ; }
Esempio n. 3
0
File: util.c Progetto: bialk/SPOOLES
/*
   -----------------------------------
   map entries into the lower triangle

   created -- 98jan28, cca
   -----------------------------------
*/
void
InpMtx_mapToLowerTriangle (
   InpMtx   *inpmtx
) {
int      col, ii, nent, row ;
int      *ivec1, *ivec2 ;
/*
   ---------------
   check the input
   ---------------
*/
if ( inpmtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapToLowerTriangle(%p)"
           "\n bad input\n", inpmtx) ;
   exit(-1) ;
}
if ( !(   INPMTX_IS_BY_ROWS(inpmtx)
       || INPMTX_IS_BY_COLUMNS(inpmtx)
       || INPMTX_IS_BY_CHEVRONS(inpmtx) ) ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapToLowerTriangle(%p)"
           "\n bad coordType\n", inpmtx) ;
   exit(-1) ;
}
nent  = inpmtx->nent ;
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( (row = ivec1[ii]) < (col = ivec2[ii]) ) {
         ivec1[ii] = col ;
         ivec2[ii] = row ;
      }
   }
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( (row = ivec2[ii]) < (col = ivec1[ii]) ) {
         ivec1[ii] = row ;
         ivec2[ii] = col ;
      }
   }
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( ivec2[ii] > 0 ) {
         ivec2[ii] = -ivec2[ii] ;
      }
   }
}
return ; }
Esempio n. 4
0
File: util.c Progetto: bialk/SPOOLES
/*
   ---------------------------------------
   given the data is in raw triples,
   sort and compress the data

   created  -- 98jan28, cca
   modified -- 98sep04, cca
      test to see if the sort is necessary 
   ---------------------------------------
*/
void
InpMtx_sortAndCompress (
   InpMtx   *inpmtx
) {
int      ient, nent, sortMustBeDone ;
int      *ivec1, *ivec2 ;
/*
   ---------------
   check the input
   ---------------
*/
if ( inpmtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_sortAndCompress(%p)"
           "\n bad input\n", inpmtx) ;
   exit(-1) ;
}
if (  INPMTX_IS_SORTED(inpmtx) 
   || INPMTX_IS_BY_VECTORS(inpmtx) 
   || (nent = inpmtx->nent) == 0 ) {
   inpmtx->storageMode = INPMTX_SORTED ;
   return ;
}
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
sortMustBeDone = 0 ;
for ( ient = 1 ; ient < nent ; ient++ ) {
   if ( ivec1[ient-1] > ivec1[ient] 
      || (   ivec1[ient-1] == ivec1[ient] 
          && ivec2[ient-1] > ivec2[ient] ) ) {
      sortMustBeDone = 1 ;
      break ;
   }
}
if ( sortMustBeDone == 1 ) {
   if ( INPMTX_IS_INDICES_ONLY(inpmtx) ) {
      inpmtx->nent = IV2sortUpAndCompress(nent, ivec1, ivec2) ;
   } else if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
      double   *dvec = InpMtx_dvec(inpmtx) ;
      inpmtx->nent = IV2DVsortUpAndCompress(nent, ivec1, ivec2, dvec) ;
   } else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
      double   *dvec = InpMtx_dvec(inpmtx) ;
      inpmtx->nent = IV2ZVsortUpAndCompress(nent, ivec1, ivec2, dvec) ;
   }
}
inpmtx->storageMode = INPMTX_SORTED ;

return ; }
Esempio n. 5
0
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   --------------------------------------------------------------------
   this program tests the Graph_MPI_Bcast() method

   (1) process root generates a random Graph object
       and computes its checksum
   (2) process root broadcasts the Graph object to the other processors
   (3) each process computes the checksum of its Graph object
   (4) the checksums are compared on root

   created -- 98sep10, cca
   --------------------------------------------------------------------
*/
{
char         *buffer ;
double       chksum, t1, t2 ;
double       *sums ;
Drand        drand ;
int          iproc, length, loc, msglvl, myid, nitem, nproc, 
             nvtx, root, seed, size, type, v ;
int          *list ;
FILE         *msgFile ;
Graph        *graph ;
/*
   ---------------------------------------------------------------
   find out the identity of this process and the number of process
   ---------------------------------------------------------------
*/
MPI_Init(&argc, &argv) ;
MPI_Comm_rank(MPI_COMM_WORLD, &myid) ;
MPI_Comm_size(MPI_COMM_WORLD, &nproc) ;
fprintf(stdout, "\n process %d of %d, argc = %d", myid, nproc, argc) ;
fflush(stdout) ;
if ( argc != 8 ) {
   fprintf(stdout, 
           "\n\n usage : %s msglvl msgFile type nvtx nitem root seed "
           "\n    msglvl      -- message level"
           "\n    msgFile     -- message file"
           "\n    type        -- type of graph"
           "\n    nvtx        -- # of vertices"
           "\n    nitem       -- # of items used to generate graph"
           "\n    root        -- root processor for broadcast"
           "\n    seed        -- random number seed"
           "\n", argv[0]) ;
   return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else {
   length = strlen(argv[2]) + 1 + 4 ;
   buffer = CVinit(length, '\0') ;
   sprintf(buffer, "%s.%d", argv[2], myid) ;
   if ( (msgFile = fopen(buffer, "w")) == NULL ) {
      fprintf(stderr, "\n fatal error in %s"
              "\n unable to open file %s\n",
              argv[0], argv[2]) ;
      return(-1) ;
   }
   CVfree(buffer) ;
}
type  = atoi(argv[3]) ;
nvtx  = atoi(argv[4]) ;
nitem = atoi(argv[5]) ;
root  = atoi(argv[6]) ;
seed  = atoi(argv[7]) ;
fprintf(msgFile, 
        "\n %s "
        "\n msglvl  -- %d" 
        "\n msgFile -- %s" 
        "\n type    -- %d" 
        "\n nvtx    -- %d" 
        "\n nitem   -- %d" 
        "\n root    -- %d" 
        "\n seed    -- %d" 
        "\n",
        argv[0], msglvl, argv[2], type, nvtx, nitem, root, seed) ;
fflush(msgFile) ;
/*
   -----------------------
   set up the Graph object
   -----------------------
*/
MARKTIME(t1) ;
graph = Graph_new() ;
if ( myid == root ) {
   InpMtx   *inpmtx ;
   int      nedges, totewght, totvwght, v ;
   int      *adj, *vwghts ;
   IVL      *adjIVL, *ewghtIVL ;
/*
   -----------------------
   generate a random graph
   -----------------------
*/
   inpmtx = InpMtx_new() ;
   InpMtx_init(inpmtx, INPMTX_BY_ROWS, INPMTX_INDICES_ONLY, nitem, 0) ;
   Drand_setDefaultFields(&drand) ;
   Drand_setSeed(&drand, seed) ;
   Drand_setUniform(&drand, 0, nvtx) ;
   Drand_fillIvector(&drand, nitem, InpMtx_ivec1(inpmtx)) ;
   Drand_fillIvector(&drand, nitem, InpMtx_ivec2(inpmtx)) ;
   InpMtx_setNent(inpmtx, nitem) ;
   InpMtx_changeStorageMode(inpmtx, INPMTX_BY_VECTORS) ;
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n\n inpmtx mtx filled with raw entries") ;
      InpMtx_writeForHumanEye(inpmtx, msgFile) ;
      fflush(msgFile) ;
   }
   adjIVL = InpMtx_fullAdjacency(inpmtx) ;
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n\n full adjacency structure") ;
      IVL_writeForHumanEye(adjIVL, msgFile) ;
      fflush(msgFile) ;
   }
   nedges = adjIVL->tsize ;
   if ( type == 1 || type == 3 ) {
      Drand_setUniform(&drand, 1, 10) ;
      vwghts = IVinit(nvtx, 0) ;
      Drand_fillIvector(&drand, nvtx, vwghts) ;
      totvwght = IVsum(nvtx, vwghts) ;
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n\n vertex weights") ;
         IVfprintf(msgFile, nvtx, vwghts) ;
         fflush(msgFile) ;
      }
   } else {
      vwghts = NULL ;
      totvwght = nvtx ;
   }
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n\n totvwght %d", totvwght) ;
      fflush(msgFile) ;
   }
   if ( type == 2 || type == 3 ) {
      ewghtIVL = IVL_new() ;
      IVL_init1(ewghtIVL, IVL_CHUNKED, nvtx) ;
      Drand_setUniform(&drand, 1, 100) ;
      totewght = 0 ;
      for ( v = 0 ; v < nvtx ; v++ ) {
         IVL_listAndSize(adjIVL, v, &size, &adj) ;
         IVL_setList(ewghtIVL, v, size, NULL) ;
         IVL_listAndSize(ewghtIVL, v, &size, &adj) ;
         Drand_fillIvector(&drand, size, adj) ;
         totewght += IVsum(size, adj) ;
      }
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n\n ewghtIVL") ;
         IVL_writeForHumanEye(ewghtIVL, msgFile) ;
         fflush(msgFile) ;
      }
   } else {
      ewghtIVL = NULL ;
      totewght = nedges ;
   }
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n\n totewght %d", totewght) ;
      fflush(msgFile) ;
   }
   Graph_init2(graph, type, nvtx, 0, nedges, totvwght, totewght,
               adjIVL, vwghts, ewghtIVL) ;
   InpMtx_free(inpmtx) ;
}
MARKTIME(t2) ;
fprintf(msgFile, 
        "\n CPU %8.3f : initialize the Graph object", t2 - t1) ;
fflush(msgFile) ;
if ( msglvl > 2 ) {
   Graph_writeForHumanEye(graph, msgFile) ;
} else {
   Graph_writeStats(graph, msgFile) ;
}
fflush(msgFile) ;
if ( myid == root ) {
/*
   ----------------------------------------
   compute the checksum of the Graph object
   ----------------------------------------
*/
   chksum = graph->type + graph->nvtx + graph->nvbnd 
          + graph->nedges + graph->totvwght + graph->totewght ;
   for ( v = 0 ; v < nvtx ; v++ ) {
      IVL_listAndSize(graph->adjIVL, v, &size, &list) ;
      chksum += 1 + v + size + IVsum(size, list) ;
   }
   if ( graph->vwghts != NULL ) {
      chksum += IVsum(nvtx, graph->vwghts) ;
   }
   if ( graph->ewghtIVL != NULL ) {
      for ( v = 0 ; v < nvtx ; v++ ) {
         IVL_listAndSize(graph->ewghtIVL, v, &size, &list) ;
         chksum += 1 + v + size + IVsum(size, list) ;
      }
   }
   fprintf(msgFile, "\n\n local chksum = %12.4e", chksum) ;
   fflush(msgFile) ;
}
/*
   --------------------------
   broadcast the Graph object
   --------------------------
*/
MARKTIME(t1) ;
graph = Graph_MPI_Bcast(graph, root, msglvl, msgFile, MPI_COMM_WORLD) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : broadcast the Graph object", t2 - t1) ;
if ( msglvl > 2 ) {
   Graph_writeForHumanEye(graph, msgFile) ;
} else {
   Graph_writeStats(graph, msgFile) ;
}
/*
   ----------------------------------------
   compute the checksum of the Graph object
   ----------------------------------------
*/
chksum = graph->type + graph->nvtx + graph->nvbnd 
       + graph->nedges + graph->totvwght + graph->totewght ;
for ( v = 0 ; v < nvtx ; v++ ) {
   IVL_listAndSize(graph->adjIVL, v, &size, &list) ;
   chksum += 1 + v + size + IVsum(size, list) ;
}
if ( graph->vwghts != NULL ) {
   chksum += IVsum(nvtx, graph->vwghts) ;
}
if ( graph->ewghtIVL != NULL ) {
   for ( v = 0 ; v < nvtx ; v++ ) {
      IVL_listAndSize(graph->ewghtIVL, v, &size, &list) ;
      chksum += 1 + v + size + IVsum(size, list) ;
   }
}
fprintf(msgFile, "\n\n local chksum = %12.4e", chksum) ;
fflush(msgFile) ;
/*
   ---------------------------------------
   gather the checksums from the processes
   ---------------------------------------
*/
sums = DVinit(nproc, 0.0) ;
MPI_Gather((void *) &chksum, 1, MPI_DOUBLE, 
           (void *) sums, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD) ;
if ( myid == 0 ) {
   fprintf(msgFile, "\n\n sums") ;
   DVfprintf(msgFile, nproc, sums) ;
   for ( iproc = 0 ; iproc < nproc ; iproc++ ) {
      sums[iproc] -= chksum ;
   }
   fprintf(msgFile, "\n\n errors") ;
   DVfprintf(msgFile, nproc, sums) ;
   fprintf(msgFile, "\n\n maxerror = %12.4e", DVmax(nproc, sums, &loc));
}
/*
   ----------------
   free the objects
   ----------------
*/
DVfree(sums) ;
Graph_free(graph) ;
/*
   ------------------------
   exit the MPI environment
   ------------------------
*/
MPI_Finalize() ;

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

return(0) ; }
Esempio n. 6
0
PetscErrorCode MatFactorNumeric_SeqSpooles(Mat F,Mat A,const MatFactorInfo *info)
{  
  Mat_Spooles        *lu = (Mat_Spooles*)(F)->spptr;
  ChvManager         *chvmanager ;
  Chv                *rootchv ;
  IVL                *adjIVL;
  PetscErrorCode     ierr;
  PetscInt           nz,nrow=A->rmap->n,irow,nedges,neqns=A->cmap->n,*ai,*aj,i,*diag=0,fierr;
  PetscScalar        *av;
  double             cputotal,facops;
#if defined(PETSC_USE_COMPLEX)
  PetscInt           nz_row,*aj_tmp;
  PetscScalar        *av_tmp;
#else
  PetscInt           *ivec1,*ivec2,j;
  double             *dvec;
#endif
  PetscBool          isSeqAIJ,isMPIAIJ;
  
  PetscFunctionBegin;
  if (lu->flg == DIFFERENT_NONZERO_PATTERN) { /* first numeric factorization */      
    (F)->ops->solve   = MatSolve_SeqSpooles;
    (F)->assembled    = PETSC_TRUE; 
    
    /* set Spooles options */
    ierr = SetSpoolesOptions(A, &lu->options);CHKERRQ(ierr); 

    lu->mtxA = InpMtx_new();
  }

  /* copy A to Spooles' InpMtx object */
  ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isSeqAIJ);CHKERRQ(ierr);
  ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isMPIAIJ);CHKERRQ(ierr);
  if (isSeqAIJ){
    Mat_SeqAIJ   *mat = (Mat_SeqAIJ*)A->data;
    ai=mat->i; aj=mat->j; av=mat->a;
    if (lu->options.symflag == SPOOLES_NONSYMMETRIC) {
      nz=mat->nz;
    } else { /* SPOOLES_SYMMETRIC || SPOOLES_HERMITIAN */
      nz=(mat->nz + A->rmap->n)/2;
      diag=mat->diag;
    }
  } else { /* A is SBAIJ */
      Mat_SeqSBAIJ *mat = (Mat_SeqSBAIJ*)A->data;
      ai=mat->i; aj=mat->j; av=mat->a;
      nz=mat->nz;
  } 
  InpMtx_init(lu->mtxA, INPMTX_BY_ROWS, lu->options.typeflag, nz, 0);
 
#if defined(PETSC_USE_COMPLEX)
    for (irow=0; irow<nrow; irow++) {
      if ( lu->options.symflag == SPOOLES_NONSYMMETRIC || !(isSeqAIJ || isMPIAIJ)){
        nz_row = ai[irow+1] - ai[irow];
        aj_tmp = aj + ai[irow];
        av_tmp = av + ai[irow];
      } else {
        nz_row = ai[irow+1] - diag[irow];
        aj_tmp = aj + diag[irow];
        av_tmp = av + diag[irow];
      }
      for (i=0; i<nz_row; i++){
        InpMtx_inputComplexEntry(lu->mtxA, irow, *aj_tmp++,PetscRealPart(*av_tmp),PetscImaginaryPart(*av_tmp));
        av_tmp++;
      }
    }
#else
    ivec1 = InpMtx_ivec1(lu->mtxA); 
    ivec2 = InpMtx_ivec2(lu->mtxA);
    dvec  = InpMtx_dvec(lu->mtxA);
    if ( lu->options.symflag == SPOOLES_NONSYMMETRIC || !isSeqAIJ){
      for (irow = 0; irow < nrow; irow++){
        for (i = ai[irow]; i<ai[irow+1]; i++) ivec1[i] = irow;
      }
      IVcopy(nz, ivec2, aj);
      DVcopy(nz, dvec, av);
    } else { 
      nz = 0;
      for (irow = 0; irow < nrow; irow++){
        for (j = diag[irow]; j<ai[irow+1]; j++) {
          ivec1[nz] = irow;
          ivec2[nz] = aj[j];
          dvec[nz]  = av[j];
          nz++;
        }
      }
    }
    InpMtx_inputRealTriples(lu->mtxA, nz, ivec1, ivec2, dvec); 
#endif

  InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS); 
  if ( lu->options.msglvl > 0 ) {
    int err;
    printf("\n\n input matrix");
    ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n input matrix");CHKERRQ(ierr);
    InpMtx_writeForHumanEye(lu->mtxA, lu->options.msgFile);
    err = fflush(lu->options.msgFile);
    if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");    
  }

  if ( lu->flg == DIFFERENT_NONZERO_PATTERN){ /* first numeric factorization */  
    /*---------------------------------------------------
    find a low-fill ordering
         (1) create the Graph object
         (2) order the graph 
    -------------------------------------------------------*/  
    if (lu->options.useQR){
      adjIVL = InpMtx_adjForATA(lu->mtxA);
    } else {
      adjIVL = InpMtx_fullAdjacency(lu->mtxA);
    }
    nedges = IVL_tsize(adjIVL);

    lu->graph = Graph_new();
    Graph_init2(lu->graph, 0, neqns, 0, nedges, neqns, nedges, adjIVL, NULL, NULL);
    if ( lu->options.msglvl > 2 ) {
      int err;

      if (lu->options.useQR){
        ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n graph of A^T A");CHKERRQ(ierr);
      } else {
        ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n graph of the input matrix");CHKERRQ(ierr);
      }
      Graph_writeForHumanEye(lu->graph, lu->options.msgFile);
      err = fflush(lu->options.msgFile);
      if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");    
    }

    switch (lu->options.ordering) {
    case 0:
      lu->frontETree = orderViaBestOfNDandMS(lu->graph,
                     lu->options.maxdomainsize, lu->options.maxzeros, lu->options.maxsize,
                     lu->options.seed, lu->options.msglvl, lu->options.msgFile); break;
    case 1:
      lu->frontETree = orderViaMMD(lu->graph,lu->options.seed,lu->options.msglvl,lu->options.msgFile); break;
    case 2:
      lu->frontETree = orderViaMS(lu->graph, lu->options.maxdomainsize,
                     lu->options.seed,lu->options.msglvl,lu->options.msgFile); break;
    case 3:
      lu->frontETree = orderViaND(lu->graph, lu->options.maxdomainsize, 
                     lu->options.seed,lu->options.msglvl,lu->options.msgFile); break;
    default:
      SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Unknown Spooles's ordering");
    }

    if ( lu->options.msglvl > 0 ) {
      int err;

      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n front tree from ordering");CHKERRQ(ierr);
      ETree_writeForHumanEye(lu->frontETree, lu->options.msgFile);
      err = fflush(lu->options.msgFile);
      if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");    
    }
  
    /* get the permutation, permute the front tree */
    lu->oldToNewIV = ETree_oldToNewVtxPerm(lu->frontETree);
    lu->oldToNew   = IV_entries(lu->oldToNewIV);
    lu->newToOldIV = ETree_newToOldVtxPerm(lu->frontETree);
    if (!lu->options.useQR) ETree_permuteVertices(lu->frontETree, lu->oldToNewIV);

    /* permute the matrix */
    if (lu->options.useQR){
      InpMtx_permute(lu->mtxA, NULL, lu->oldToNew);
    } else {
      InpMtx_permute(lu->mtxA, lu->oldToNew, lu->oldToNew); 
      if ( lu->options.symflag == SPOOLES_SYMMETRIC) {
        InpMtx_mapToUpperTriangle(lu->mtxA); 
      }
#if defined(PETSC_USE_COMPLEX)
      if ( lu->options.symflag == SPOOLES_HERMITIAN ) {
        InpMtx_mapToUpperTriangleH(lu->mtxA); 
      }
#endif
      InpMtx_changeCoordType(lu->mtxA, INPMTX_BY_CHEVRONS);
    }
    InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS);

    /* get symbolic factorization */
    if (lu->options.useQR){
      lu->symbfacIVL = SymbFac_initFromGraph(lu->frontETree, lu->graph);
      IVL_overwrite(lu->symbfacIVL, lu->oldToNewIV);
      IVL_sortUp(lu->symbfacIVL);
      ETree_permuteVertices(lu->frontETree, lu->oldToNewIV);
    } else {
      lu->symbfacIVL = SymbFac_initFromInpMtx(lu->frontETree, lu->mtxA);
    }
    if ( lu->options.msglvl > 2 ) {
      int err;

      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n old-to-new permutation vector");CHKERRQ(ierr);
      IV_writeForHumanEye(lu->oldToNewIV, lu->options.msgFile);
      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n new-to-old permutation vector");CHKERRQ(ierr);
      IV_writeForHumanEye(lu->newToOldIV, lu->options.msgFile);
      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n front tree after permutation");CHKERRQ(ierr);
      ETree_writeForHumanEye(lu->frontETree, lu->options.msgFile);
      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n input matrix after permutation");CHKERRQ(ierr);
      InpMtx_writeForHumanEye(lu->mtxA, lu->options.msgFile);
      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n symbolic factorization");CHKERRQ(ierr);
      IVL_writeForHumanEye(lu->symbfacIVL, lu->options.msgFile);
      err = fflush(lu->options.msgFile);
      if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");    
    }  

    lu->frontmtx   = FrontMtx_new();
    lu->mtxmanager = SubMtxManager_new();
    SubMtxManager_init(lu->mtxmanager, NO_LOCK, 0);

  } else { /* new num factorization using previously computed symbolic factor */ 

    if (lu->options.pivotingflag) { /* different FrontMtx is required */
      FrontMtx_free(lu->frontmtx);   
      lu->frontmtx   = FrontMtx_new();
    } else {
      FrontMtx_clearData (lu->frontmtx); 
    }

    SubMtxManager_free(lu->mtxmanager);  
    lu->mtxmanager = SubMtxManager_new();
    SubMtxManager_init(lu->mtxmanager, NO_LOCK, 0);

    /* permute mtxA */
    if (lu->options.useQR){
      InpMtx_permute(lu->mtxA, NULL, lu->oldToNew);
    } else {
      InpMtx_permute(lu->mtxA, lu->oldToNew, lu->oldToNew); 
      if ( lu->options.symflag == SPOOLES_SYMMETRIC ) {
        InpMtx_mapToUpperTriangle(lu->mtxA); 
      }
      InpMtx_changeCoordType(lu->mtxA, INPMTX_BY_CHEVRONS);
    }
    InpMtx_changeStorageMode(lu->mtxA, INPMTX_BY_VECTORS);
    if ( lu->options.msglvl > 2 ) {
      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n input matrix after permutation");CHKERRQ(ierr);
      InpMtx_writeForHumanEye(lu->mtxA, lu->options.msgFile); 
    } 
  } /* end of if( lu->flg == DIFFERENT_NONZERO_PATTERN) */
  
  if (lu->options.useQR){
    FrontMtx_init(lu->frontmtx, lu->frontETree, lu->symbfacIVL, lu->options.typeflag, 
                 SPOOLES_SYMMETRIC, FRONTMTX_DENSE_FRONTS, 
                 SPOOLES_NO_PIVOTING, NO_LOCK, 0, NULL,
                 lu->mtxmanager, lu->options.msglvl, lu->options.msgFile);
  } else {
    FrontMtx_init(lu->frontmtx, lu->frontETree, lu->symbfacIVL, lu->options.typeflag, lu->options.symflag, 
                FRONTMTX_DENSE_FRONTS, lu->options.pivotingflag, NO_LOCK, 0, NULL, 
                lu->mtxmanager, lu->options.msglvl, lu->options.msgFile);   
  }

  if ( lu->options.symflag == SPOOLES_SYMMETRIC ) {  /* || SPOOLES_HERMITIAN ? */
    if ( lu->options.patchAndGoFlag == 1 ) {
      lu->frontmtx->patchinfo = PatchAndGoInfo_new();
      PatchAndGoInfo_init(lu->frontmtx->patchinfo, 1, lu->options.toosmall, lu->options.fudge,
                       lu->options.storeids, lu->options.storevalues);
    } else if ( lu->options.patchAndGoFlag == 2 ) {
      lu->frontmtx->patchinfo = PatchAndGoInfo_new();
      PatchAndGoInfo_init(lu->frontmtx->patchinfo, 2, lu->options.toosmall, lu->options.fudge,
                       lu->options.storeids, lu->options.storevalues);
    }   
  }

  /* numerical factorization */
  chvmanager = ChvManager_new();
  ChvManager_init(chvmanager, NO_LOCK, 1);
  DVfill(10, lu->cpus, 0.0);
  if (lu->options.useQR){
    facops = 0.0 ; 
    FrontMtx_QR_factor(lu->frontmtx, lu->mtxA, chvmanager, 
                   lu->cpus, &facops, lu->options.msglvl, lu->options.msgFile);
    if ( lu->options.msglvl > 1 ) {
      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n factor matrix");CHKERRQ(ierr);
      ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n facops = %9.2f", facops);CHKERRQ(ierr);
    }
  } else {
    IVfill(20, lu->stats, 0);
    rootchv = FrontMtx_factorInpMtx(lu->frontmtx, lu->mtxA, lu->options.tau, 0.0, 
            chvmanager, &fierr, lu->cpus,lu->stats,lu->options.msglvl,lu->options.msgFile); 
    if (rootchv) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"\n matrix found to be singular");    
    if (fierr >= 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"\n error encountered at front %D", fierr);
    
    if(lu->options.FrontMtxInfo){
      ierr = PetscPrintf(PETSC_COMM_SELF,"\n %8d pivots, %8d pivot tests, %8d delayed rows and columns\n",lu->stats[0], lu->stats[1], lu->stats[2]);CHKERRQ(ierr);
      cputotal = lu->cpus[8] ;
      if ( cputotal > 0.0 ) {
        ierr = PetscPrintf(PETSC_COMM_SELF,
           "\n                               cpus   cpus/totaltime"
           "\n    initialize fronts       %8.3f %6.2f"
           "\n    load original entries   %8.3f %6.2f"
           "\n    update fronts           %8.3f %6.2f"
           "\n    assemble postponed data %8.3f %6.2f"
           "\n    factor fronts           %8.3f %6.2f"
           "\n    extract postponed data  %8.3f %6.2f"
           "\n    store factor entries    %8.3f %6.2f"
           "\n    miscellaneous           %8.3f %6.2f"
           "\n    total time              %8.3f \n",
           lu->cpus[0], 100.*lu->cpus[0]/cputotal,
           lu->cpus[1], 100.*lu->cpus[1]/cputotal,
           lu->cpus[2], 100.*lu->cpus[2]/cputotal,
           lu->cpus[3], 100.*lu->cpus[3]/cputotal,
           lu->cpus[4], 100.*lu->cpus[4]/cputotal,
           lu->cpus[5], 100.*lu->cpus[5]/cputotal,
           lu->cpus[6], 100.*lu->cpus[6]/cputotal,
	   lu->cpus[7], 100.*lu->cpus[7]/cputotal, cputotal);CHKERRQ(ierr);
      }
    }
  }
  ChvManager_free(chvmanager);

  if ( lu->options.msglvl > 0 ) {
    int err;

    ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n factor matrix");CHKERRQ(ierr);
    FrontMtx_writeForHumanEye(lu->frontmtx, lu->options.msgFile);
    err = fflush(lu->options.msgFile);
    if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");    
  }

  if ( lu->options.symflag == SPOOLES_SYMMETRIC ) { /* || SPOOLES_HERMITIAN ? */
    if ( lu->options.patchAndGoFlag == 1 ) {
      if ( lu->frontmtx->patchinfo->fudgeIV != NULL ) {
        if (lu->options.msglvl > 0 ){
          ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n small pivots found at these locations");CHKERRQ(ierr);
          IV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeIV, lu->options.msgFile);
        }
      }
      PatchAndGoInfo_free(lu->frontmtx->patchinfo);
    } else if ( lu->options.patchAndGoFlag == 2 ) {
      if (lu->options.msglvl > 0 ){
        if ( lu->frontmtx->patchinfo->fudgeIV != NULL ) {
          ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n small pivots found at these locations");CHKERRQ(ierr);
          IV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeIV, lu->options.msgFile);
        }
        if ( lu->frontmtx->patchinfo->fudgeDV != NULL ) {
          ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n perturbations");CHKERRQ(ierr);
          DV_writeForHumanEye(lu->frontmtx->patchinfo->fudgeDV, lu->options.msgFile);
        }
      }
      PatchAndGoInfo_free(lu->frontmtx->patchinfo);
    }
  }

  /* post-process the factorization */
  FrontMtx_postProcess(lu->frontmtx, lu->options.msglvl, lu->options.msgFile);
  if ( lu->options.msglvl > 2 ) {
    int err;

    ierr = PetscFPrintf(PETSC_COMM_SELF,lu->options.msgFile, "\n\n factor matrix after post-processing");CHKERRQ(ierr);
    FrontMtx_writeForHumanEye(lu->frontmtx, lu->options.msgFile);
    err = fflush(lu->options.msgFile);
    if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");    
  }

  lu->flg = SAME_NONZERO_PATTERN;
  lu->CleanUpSpooles = PETSC_TRUE;
  PetscFunctionReturn(0);
}
Esempio n. 7
0
/*
   --------------------------------------------------------------------
   purpose -- 
      this method is used to determine the support of this matrix
      for a matrix-vector multiply y[] = A * x[] when A is a 
      symmetric matrix.

      supIV -- filled with row indices of y[] which will be updated
               and row indices of x[] which will be used.

   created -- 98aug01, cca
   --------------------------------------------------------------------
*/
void
InpMtx_supportSym (
   InpMtx   *A,
   IV       *supIV
) {
char   *mark ;
int    chev, col, count, ii, loc, maxcol, maxrow, maxv, nent, off, row ;
int    *ivec1, *ivec2, *sup ;
/*
   ---------------
   check the input
   ---------------
*/
if ( A == NULL || supIV == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_supportSym(%p,%p)"
           "\n bad input\n", A, supIV) ;
   exit(-1) ;
}
if (  !INPMTX_IS_BY_ROWS(A) 
   && !INPMTX_IS_BY_COLUMNS(A) 
   && !INPMTX_IS_BY_CHEVRONS(A) ) {
   fprintf(stderr, "\n fatal error in InpMtx_supportSym(%p,%p)"
           "\n coordinate type\n", A, supIV) ;
   exit(-1) ;
}
ivec1 = InpMtx_ivec1(A) ;
ivec2 = InpMtx_ivec2(A) ;
nent  = A->nent ;
/*
   -----------------------------------------------------------------
   (1) determine the maximum row and column numbers in these entries
   (2) allocate marking vectors for rows and columns
   (3) fill marking vectors for rows and columns
   (4) fill support vectors 
   -----------------------------------------------------------------
*/
if ( INPMTX_IS_BY_ROWS(A) ) {
   maxrow = IVmax(nent, ivec1, &loc) ;
   maxcol = IVmax(nent, ivec2, &loc) ;
   maxv   = (maxrow >= maxcol) ? maxrow : maxcol ;
   mark   = CVinit(1+maxv, 'O') ;
   count  = 0 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      row = ivec1[ii] ; col = ivec2[ii] ;
      if ( mark[row] == 'O' ) {
         count++ ;
      }
      mark[row] = 'X' ;
      if ( mark[col] == 'O' ) {
         count++ ;
      }
      mark[col] = 'X' ;
   }
} else if ( INPMTX_IS_BY_COLUMNS(A) ) {
   maxrow = IVmax(nent, ivec2, &loc) ;
   maxcol = IVmax(nent, ivec1, &loc) ;
   maxv   = (maxrow >= maxcol) ? maxrow : maxcol ;
   mark   = CVinit(1+maxv, 'O') ;
   count  = 0 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      row = ivec2[ii] ; col = ivec1[ii] ;
      if ( mark[row] == 'O' ) {
         count++ ;
      }
      mark[row] = 'X' ;
      if ( mark[col] == 'O' ) {
         count++ ;
      }
      mark[col] = 'X' ;
   }
} else if ( INPMTX_IS_BY_CHEVRONS(A) ) {
   maxv = -1 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      chev = ivec1[ii] ; off = ivec2[ii] ;
      if ( off >= 0 ) {
         row = chev ; col = chev + off ;
         if ( maxv < col ) {
            maxv = col ;
         }
      } else {
         col = chev ; row = chev - off ;
         if ( maxv < row ) {
            maxv = row ;
         }
      }
   }
   mark = CVinit(1+maxv, 'O') ;
   count = 0 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      chev = ivec1[ii] ; off = ivec2[ii] ;
      if ( off >= 0 ) {
         row = chev ; col = chev + off ;
      } else {
         col = chev ; row = chev - off ;
      }
      if ( mark[row] == 'O' ) {
         count++ ;
      }
      mark[row] = 'X' ;
      if ( mark[col] == 'O' ) {
         count++ ;
      }
      mark[col] = 'X' ;
   }
}
IV_setSize(supIV, count) ;
sup = IV_entries(supIV) ;
for ( row = count = 0 ; row <= maxv ; row++ ) {
   if ( mark[row] == 'X' ) {
      sup[count++] = row ;
   }
}
CVfree(mark) ;

return ; }
Esempio n. 8
0
File: map.c Progetto: bialk/SPOOLES
/*
   --------------------------------------------------------------------
   purpose -- to map the coordinates of the entries of the matrix 
      into new coordinates. this method is used during the distributed
      matrix-vector multiply where a matrix local to a processor is
      mapped into a local coordinate system.

   (row,col) --> (rowmap[row],colmap[col])

   we check that row is in [0,nrow) and col is in [0,ncol),
   where nrow is the size of rowmapIV and ncol is the size of colmapIV.

   note, the storage mode is not changed. i.e., if the data is
   stored by vectors, it may be invalid after the indices have 
   been mapped. on the other hand, it may not, so it is the user's
   responsibility to reset the storage mode if necessary.

   created -- 98aug02, cca
   --------------------------------------------------------------------
*/
void
InpMtx_mapEntries (
   InpMtx   *inpmtx,
   IV       *rowmapIV,
   IV       *colmapIV
) {
int   chv, col, ii, ncol, nent, nrow, off, row ;
int   *colmap, *ivec1, *ivec2, *rowmap ;
/*
   ---------------
   check the input
   ---------------
*/
if ( inpmtx == NULL || rowmapIV == NULL || colmapIV == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
           "\n bad input\n") ;
   exit(-1) ;
}
if ( !(INPMTX_IS_BY_ROWS(inpmtx)
   ||  INPMTX_IS_BY_COLUMNS(inpmtx)
   ||  INPMTX_IS_BY_CHEVRONS(inpmtx)) ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
           "\n bad coordinate type\n") ;
   exit(-1) ;
}
IV_sizeAndEntries(rowmapIV, &nrow, &rowmap) ;
if ( rowmap == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
           "\n rowmap is NULL\n") ;
   exit(-1) ;
}
IV_sizeAndEntries(colmapIV, &ncol, &colmap) ;
if ( colmap == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
           "\n colmap is NULL\n") ;
   exit(-1) ;
}
nent  = inpmtx->nent ;
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      row = ivec1[ii] ; col = ivec2[ii] ;
      if ( row < 0 || row >= nrow ) {
         fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
                 "\n entry (%d,%d), nrow = %d\n", row, col, nrow) ;
         exit(-1) ;
      }
      ivec1[ii] = rowmap[row] ;
      if ( col < 0 || col >= ncol ) {
         fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
                 "\n entry (%d,%d), ncol = %d\n", row, col, ncol) ;
         exit(-1) ;
      }
      ivec2[ii] = colmap[col] ;
   }
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      row = ivec2[ii] ; col = ivec1[ii] ;
      if ( row < 0 || row >= nrow ) {
         fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
                 "\n entry (%d,%d), nrow = %d\n", row, col, nrow) ;
         exit(-1) ;
      }
      ivec2[ii] = rowmap[row] ;
      if ( col < 0 || col >= ncol ) {
         fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
                 "\n entry (%d,%d), ncol = %d\n", row, col, ncol) ;
         exit(-1) ;
      }
      ivec1[ii] = colmap[col] ;
   }
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      chv = ivec1[ii] ; off = ivec2[ii] ;
      if ( off >= 0 ) {
         row = chv ; col = chv + off ;
      } else {
         row = chv - off ; col = chv ;
      }
      if ( row < 0 || row >= nrow ) {
         fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
                 "\n entry (%d,%d), nrow = %d\n", row, col, nrow) ;
         exit(-1) ;
      }
      row = rowmap[row] ;
      if ( col < 0 || col >= ncol ) {
         fprintf(stderr, "\n fatal error in InpMtx_mapEntries()"
                 "\n entry (%d,%d), ncol = %d\n", row, col, ncol) ;
         exit(-1) ;
      }
      col = colmap[col] ;
      ivec1[ii] = (row >= col) ? col : row ;
      ivec2[ii] = col - row ;
   }
}
return ; }
Esempio n. 9
0
/*
   --------------------------------------------------------------------
   purpose -- 
      this method is used to determine the support of this matrix
      for a matrix-vector multiply y[] = A * x[] when A is a
      nonsymmetric matrix.

      rowsupIV -- filled with row indices of y[] which will be updated.
      colsupIV -- filled with row indices of x[] which will be used.

   created -- 98aug01, cca
   --------------------------------------------------------------------
*/
void
InpMtx_supportNonsymT (
   InpMtx   *A,
   IV       *rowsupIV,
   IV       *colsupIV
) {
char   *colmark, *rowmark ;
int    chev, col, colcount, ii, loc, maxcol, maxrow, nent, off, row,
       rowcount ;
int    *colsup, *ivec1, *ivec2, *rowsup ;
/*
   ---------------
   check the input
   ---------------
*/
if ( A == NULL || rowsupIV == NULL || colsupIV == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_supportNonsymT(%p,%p,%p)"
           "\n bad input\n", A, rowsupIV, colsupIV) ;
   spoolesFatal();
}
if (  !INPMTX_IS_BY_ROWS(A) 
   && !INPMTX_IS_BY_COLUMNS(A) 
   && !INPMTX_IS_BY_CHEVRONS(A) ) {
   fprintf(stderr, "\n fatal error in InpMtx_supportNonsymT(%p,%p,%p)"
           "\n coordinate type\n", A, rowsupIV, colsupIV) ;
   spoolesFatal();
}
ivec1 = InpMtx_ivec1(A) ;
ivec2 = InpMtx_ivec2(A) ;
nent  = A->nent ;
/*
   -----------------------------------------------------------------
   (1) determine the maximum row and column numbers in these entries
   (2) allocate marking vectors for rows and columns
   (3) fill marking vectors for rows and columns
   (4) fill support vectors 
   -----------------------------------------------------------------
*/
if ( INPMTX_IS_BY_ROWS(A) ) {
   maxrow   = IVmax(nent, ivec1, &loc) ;
   maxcol   = IVmax(nent, ivec2, &loc) ;
   rowmark  = CVinit(1+maxcol, 'O') ;
   colmark  = CVinit(1+maxrow, 'O') ;
   rowcount = colcount = 0 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      row = ivec1[ii] ; col = ivec2[ii] ;
      if ( colmark[row] == 'O' ) {
         colcount++ ;
      }
      colmark[row] = 'X' ;
      if ( rowmark[col] == 'O' ) {
         rowcount++ ;
      }
      rowmark[col] = 'X' ;
   }
} else if ( INPMTX_IS_BY_COLUMNS(A) ) {
   maxrow   = IVmax(nent, ivec2, &loc) ;
   maxcol   = IVmax(nent, ivec1, &loc) ;
   rowmark  = CVinit(1+maxcol, 'O') ;
   colmark  = CVinit(1+maxrow, 'O') ;
   rowcount = colcount = 0 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      row = ivec2[ii] ; col = ivec1[ii] ;
      if ( colmark[row] == 'O' ) {
         colcount++ ;
      }
      colmark[row] = 'X' ;
      if ( rowmark[col] == 'O' ) {
         rowcount++ ;
      }
      rowmark[col] = 'X' ;
   }
} else if ( INPMTX_IS_BY_CHEVRONS(A) ) {
   maxrow = maxcol = -1 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      chev = ivec1[ii] ; off = ivec2[ii] ;
      if ( off >= 0 ) {
         row = chev ; col = chev + off ;
      } else {
         col = chev ; row = chev - off ;
      }
      if ( maxrow < row ) {
         maxrow = row ;
      }
      if ( maxcol < col ) {
         maxcol = col ;
      }
   }
   rowmark  = CVinit(1+maxcol, 'O') ;
   colmark  = CVinit(1+maxrow, 'O') ;
   rowcount = colcount = 0 ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      chev = ivec1[ii] ; off = ivec2[ii] ;
      if ( off >= 0 ) {
         row = chev ; col = chev + off ;
      } else {
         col = chev ; row = chev - off ;
      }
      if ( colmark[row] == 'O' ) {
         colcount++ ;
      }
      colmark[row] = 'X' ;
      if ( rowmark[col] == 'O' ) {
         rowcount++ ;
      }
      rowmark[col] = 'X' ;
   }
}
IV_setSize(rowsupIV, rowcount) ;
rowsup = IV_entries(rowsupIV) ;
for ( col = rowcount = 0 ; col <= maxcol ; col++ ) {
   if ( rowmark[col] == 'X' ) {
      rowsup[rowcount++] = col ;
   }
}
IV_setSize(colsupIV, colcount) ;
colsup = IV_entries(colsupIV) ;
for ( row = colcount = 0 ; row <= maxrow ; row++ ) {
   if ( colmark[row] == 'X' ) {
      colsup[colcount++] = row ;
   }
}
CVfree(colmark) ;
CVfree(rowmark) ;

return ; }
Esempio n. 10
0
/*
   ----------------------------------
   return an IVL object that contains 
   the adjacency structure of A^TA.

   created -- 98jan28, cca
   ----------------------------------
*/
IVL *
InpMtx_adjForATA (
   InpMtx   *inpmtxA
) {
InpMtx   *inpmtxATA ;
int      firstcol, firstrow, irow, jvtx, lastcol, lastrow,
         loc, ncol, nent, nrow, size ;
int      *ind, *ivec1, *ivec2 ;
IVL      *adjIVL ;
/*
   ---------------
   check the input
   ---------------
*/
if ( inpmtxA == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_adjForATA(%p)"
           "\n NULL input\n", inpmtxA) ;
   exit(-1) ;
}
/*
   ----------------------------------------------------------
   change the coordinate type and storage mode to row vectors
   ----------------------------------------------------------
*/
InpMtx_changeCoordType(inpmtxA, INPMTX_BY_ROWS) ;
InpMtx_changeStorageMode(inpmtxA, INPMTX_BY_VECTORS) ;
nent     = InpMtx_nent(inpmtxA) ;
ivec1    = InpMtx_ivec1(inpmtxA) ;
ivec2    = InpMtx_ivec2(inpmtxA) ;
firstrow = IVmin(nent, ivec1, &loc) ;
lastrow  = IVmax(nent, ivec1, &loc) ;
firstcol = IVmin(nent, ivec2, &loc) ;
lastcol  = IVmax(nent, ivec2, &loc) ;
if ( firstrow < 0 || firstcol < 0 ) {
   fprintf(stderr, "\n fatal error"
           "\n firstrow = %d, firstcol = %d"
           "\n lastrow  = %d, lastcol  = %d",
           firstrow, firstcol, lastrow, lastcol) ;
   exit(-1) ;
}
nrow = 1 + lastrow ;
ncol = 1 + lastcol ;
/*
   -----------------------------------------------------------
   create the new InpMtx object to hold the structure of A^TA
   -----------------------------------------------------------
*/
inpmtxATA = InpMtx_new() ;
InpMtx_init(inpmtxATA, INPMTX_BY_ROWS, INPMTX_INDICES_ONLY, 0, 0) ;
for ( irow = 0 ; irow < nrow ; irow++ ) {
   InpMtx_vector(inpmtxA, irow, &size, &ind) ;
   InpMtx_inputMatrix(inpmtxATA, size, size, 1, size, ind, ind) ;
}
for ( jvtx = 0 ; jvtx < nrow ; jvtx++ ) {
   InpMtx_inputEntry(inpmtxATA, jvtx, jvtx) ;
}
InpMtx_changeStorageMode(inpmtxATA, INPMTX_BY_VECTORS) ;
/*
   -------------------
   fill the IVL object
   -------------------
*/
adjIVL = IVL_new() ;
IVL_init1(adjIVL, IVL_CHUNKED, nrow) ;
for ( jvtx = 0 ; jvtx < ncol ; jvtx++ ) {
   InpMtx_vector(inpmtxATA, jvtx, &size, &ind) ;
   IVL_setList(adjIVL, jvtx, size, ind) ;
}
/*
   ------------------------------
   free the working InpMtx object
   ------------------------------
*/
InpMtx_free(inpmtxATA) ;

return(adjIVL) ; }
Esempio n. 11
0
/*
   -------------------------------------------
   set up the nthread MTmvmObj data structures
   -------------------------------------------
*/
static MTmvmObj *
setup (
   InpMtx     *A,
   DenseMtx   *Y,
   double     alpha[],
   DenseMtx   *X,
   int        nthread
) {
double     *dvec ;
int        ithread, nentA, nextra, nlocal, offset ;
int        *ivec1, *ivec2 ;
MTmvmObj   *MTmvmObjs, *obj ;
/*
   ---------------------------------
   allocate nthread MTmvmObj objects
   ---------------------------------
*/
ALLOCATE(MTmvmObjs, struct _MTmvmObj, nthread) ;
for ( ithread = 0, obj = MTmvmObjs ; 
      ithread < nthread ;
      ithread++, obj++ ) {
   obj->A = InpMtx_new() ;
   if ( ithread == 0 ) {
      obj->Y = Y ;
   } else {
      obj->Y = DenseMtx_new() ;
   }
   obj->alpha[0] = alpha[0] ;
   obj->alpha[1] = alpha[1] ;
   obj->X = X ;
}
/*
   ----------------------------------------
   set up and zero the replicated Y objects
   ----------------------------------------
*/
for ( ithread = 0, obj = MTmvmObjs ; 
      ithread < nthread ;
      ithread++, obj++ ) {
   if ( ithread > 0 ) {
      DenseMtx_init(obj->Y, Y->type, Y->rowid, Y->colid, 
                    Y->nrow, Y->ncol, Y->inc1, Y->inc2) ;
      DenseMtx_zero(obj->Y) ;
   }
}
/*
   -------------------------------------
   set up the partitioned InpMtx objects
   -------------------------------------
*/
nentA  = InpMtx_nent(A)  ;
nlocal = nentA / nthread ;
nextra = nentA % nthread ;
ivec1  = InpMtx_ivec1(A) ;
ivec2  = InpMtx_ivec2(A) ;
if ( INPMTX_IS_REAL_ENTRIES(A) || INPMTX_IS_COMPLEX_ENTRIES(A) ) {
   dvec = InpMtx_dvec(A) ;
} else {
   dvec = NULL ;
}
offset = 0 ;
for ( ithread = 0, obj = MTmvmObjs ; 
      ithread < nthread ;
      ithread++, obj++ ) {
   InpMtx_init(obj->A, A->coordType, A->inputMode, 0, 0) ;
   obj->A->storageMode = A->storageMode ;
   if ( ithread < nextra ) {
      obj->A->nent = nlocal + 1 ;
   } else {
      obj->A->nent = nlocal ;
   }
   IV_init(&(obj->A->ivec1IV), obj->A->nent, ivec1 + offset) ;
   IV_init(&(obj->A->ivec2IV), obj->A->nent, ivec2 + offset) ;
   if ( INPMTX_IS_REAL_ENTRIES(A) ) {
      DV_init(&(obj->A->dvecDV), obj->A->nent, dvec + offset) ;
   } else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
      DV_init(&(obj->A->dvecDV), obj->A->nent, dvec + 2*offset) ;
   }
   offset += obj->A->nent ;
}
return(MTmvmObjs) ; }
Esempio n. 12
0
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
   ---------------------------------------------------
   read in (i, j, a(i,j)) triples, 
   construct a InpMtx object and
   write it out to a file

   created -- 97oct17, cca
   ---------------------------------------------------
*/
{
char     *inFileName, *outFileName ;
InpMtx   *inpmtx ;
FILE      *inputFile, *msgFile ;
int       dataType, flag, ient, msglvl, 
          ncol, nent, nrow, rc ;
int       *ivec1, *ivec2 ;

if ( argc != 7 ) {
   fprintf(stdout, 
   "\n\n usage : readAIJ msglvl msgFile dataType inputFile outFile flag"
   "\n    msglvl    -- message level"
   "\n    msgFile   -- message file"
   "\n    dataType  -- 0 for indices only, 1 for double, 2 for complex"
   "\n    inputFile -- input file for a(i,j) entries"
   "\n       the first line must be \"nrow ncol nentries\""
   "\n       if dataType == 0 then"
   "\n          next lines are \"irow jcol\""
   "\n       else if dataType == 1 then"
   "\n          next lines are \"irow jcol entry\""
   "\n       else if dataType == 2 then"
   "\n          next lines are \"irow jcol realEntry imagEntry\""
   "\n       endif"
   "\n    outFile -- output file, must be *.inpmtxf or *.inpmtxb"
   "\n    flag    -- flag for 0-based or 1-based addressing"
   "\n") ;
   return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
   msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
   fprintf(stderr, "\n fatal error in %s"
           "\n unable to open file %s\n",
           argv[0], argv[2]) ;
   return(-1) ;
}
dataType    = atoi(argv[3]) ;
inFileName  = argv[4] ;
outFileName = argv[5] ;
flag        = atoi(argv[6]) ;
fprintf(msgFile, 
        "\n readAIJ "
        "\n msglvl    -- %d" 
        "\n msgFile   -- %s" 
        "\n dataType  -- %d" 
        "\n inputFile -- %s" 
        "\n outFile   -- %s" 
        "\n flag      -- %d" 
        "\n",
        msglvl, argv[2], dataType, inFileName, outFileName, flag) ;
fflush(msgFile) ;
/*
   ----------------------------
   open the input file and read
   #rows #columns #entries
   ----------------------------
*/
if ( (inputFile = fopen(inFileName, "r")) == NULL ) {
   fprintf(stderr, "\n fatal error in %s"
           "\n unable to open file %s\n",
           argv[0], inFileName) ;
   return(-1) ;
}
rc = fscanf(inputFile, "%d %d %d", &nrow, &ncol, &nent) ;
if ( rc != 3 ) {
   fprintf(stderr, "\n fatal error in %s"
           "\n %d of 3 fields read on first line of file %s",
           argv[0], rc, inFileName) ;
   return(-1) ;
}
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n read in nrow = %d, ncol = %d, nent = %d",
           nrow, ncol, nent) ;
   fflush(msgFile) ;
}
/*
   --------------------------------------------------
   initialize the object
   set coordType = INPMTX_BY_ROWS --> row coordinates
   set inputMode = dataType 
   --------------------------------------------------
*/
inpmtx = InpMtx_new() ;
InpMtx_init(inpmtx, INPMTX_BY_ROWS, dataType, nent, 0) ;
/*
   -------------------------------------------------
   read in the entries and load them into the object
   -------------------------------------------------
*/
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
if ( INPMTX_IS_INDICES_ONLY(inpmtx) ) {
   for ( ient = 0 ; ient < nent ; ient++ ) {
      rc = fscanf(inputFile, "%d %d", ivec1 + ient, ivec2 + ient) ;
      if ( rc != 2 ) {
         fprintf(stderr, "\n fatal error in %s"
                 "\n %d of 2 fields read on entry %d of file %s",
                 argv[0], rc, ient, inFileName) ;
         return(-1) ;
      }
      if ( msglvl > 1 ) {
         fprintf(msgFile, "\n entry %d, row %d, column %d",
                 ient, ivec1[ient], ivec2[ient]) ;
         fflush(msgFile) ;
      }
   }
} else if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
   double   *dvec = InpMtx_dvec(inpmtx) ;
   for ( ient = 0 ; ient < nent ; ient++ ) {
      rc = fscanf(inputFile, "%d %d %le", 
                  ivec1 + ient, ivec2 + ient, dvec + ient) ;
      if ( rc != 3 ) {
         fprintf(stderr, "\n fatal error in %s"
                 "\n %d of 3 fields read on entry %d of file %s",
                 argv[0], rc, ient, argv[3]) ;
         return(-1) ;
      }
      if ( msglvl > 1 ) {
         fprintf(msgFile, "\n entry %d, row %d, column %d, value %e",
                 ient, ivec1[ient], ivec2[ient], dvec[ient]) ;
         fflush(msgFile) ;
      }
   }
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   double   *dvec = InpMtx_dvec(inpmtx) ;
   for ( ient = 0 ; ient < nent ; ient++ ) {
      rc = fscanf(inputFile, "%d %d %le %le", 
                  ivec1 + ient, ivec2 + ient, 
                  dvec + 2*ient, dvec + 2*ient+1) ;
      if ( rc != 4 ) {
         fprintf(stderr, "\n fatal error in %s"
                 "\n %d of 4 fields read on entry %d of file %s",
                 argv[0], rc, ient, argv[3]) ;
         return(-1) ;
      }
      if ( msglvl > 1 ) {
         fprintf(msgFile, 
              "\n entry %d, row %d, column %d, value %12.4e + %12.4e*i",
              ient, ivec1[ient], ivec2[ient], 
              dvec[2*ient], dvec[2*ient+1]) ;
         fflush(msgFile) ;
      }
   }
}
inpmtx->nent = nent ;
if ( flag == 1 ) {
/*
   --------------------------------------------------
   indices were in FORTRAN mode, decrement for C mode
   --------------------------------------------------
*/
   for ( ient = 0 ; ient < nent ; ient++ ) {
      ivec1[ient]-- ; ivec2[ient]-- ;
   }
}
/*
   -----------------------------
   sort and compress the entries
   -----------------------------
*/
InpMtx_changeStorageMode(inpmtx, 3) ;
if ( msglvl > 1 ) {
   fprintf(msgFile, "\n\n sorted, compressed and vector form") ;
   InpMtx_writeForHumanEye(inpmtx, msgFile) ;
   fflush(msgFile) ;
}
/*
   ---------------------------
   write out the InpMtx object
   ---------------------------
*/
if ( strcmp(outFileName, "none") != 0 ) {
   rc = InpMtx_writeToFile(inpmtx, outFileName) ;
   fprintf(msgFile, 
           "\n return value %d from InpMtx_writeToFile(%p,%s)",
           rc, inpmtx, outFileName) ;
}
/*
   ---------------------
   free the working data
   ---------------------
*/
InpMtx_free(inpmtx) ;

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

return(1) ; }
Esempio n. 13
0
File: util.c Progetto: bialk/SPOOLES
/*
   ----------------------------------------------------
   determine the range of the matrix, 
   i.e., the minimum and maximum rows and columns

   if pmincol != NULL then *pmincol = minimum column id
   if pmaxcol != NULL then *pmaxcol = maximum column id
   if pminrow != NULL then *pminrow = minimum row id
   if pmaxrow != NULL then *pmaxrow = maximum row id

   return value ---
      1 -- normal return
     -1 -- mtx is NULL
     -2 -- no entries in the matrix
     -3 -- invalid coordinate type
   
   created -- 98oct15, cca
   ----------------------------------------------------
*/
int
InpMtx_range (
   InpMtx   *mtx,
   int      *pmincol,
   int      *pmaxcol,
   int      *pminrow,
   int      *pmaxrow
) {
int   maxcol, maxrow, mincol, minrow, nent ;
/*
   ---------------
   check the input
   ---------------
*/
if ( mtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_range()"
           "\n mtx is NULL\n") ;
   return(-1) ;
}
if ( (nent = mtx->nent) <= 0 ) {
   fprintf(stderr, "\n fatal error in InpMtx_range()"
           "\n %d entries\n", nent) ;
   return(-2) ;
}
if ( INPMTX_IS_BY_ROWS(mtx) ) {
   int   *rowind = InpMtx_ivec1(mtx) ;
   int   *colind = InpMtx_ivec2(mtx) ;
   int   col, ii, row ;

   minrow = maxrow = rowind[0] ;
   mincol = maxcol = colind[0] ;
   for ( ii = 1 ; ii < nent ; ii++ ) {
      row = rowind[ii] ;
      col = colind[ii] ;
      if ( minrow > row ) {
         minrow = row ;
      } else if ( maxrow < row ) {
         maxrow = row ;
      }
      if ( mincol > col ) {
         mincol = col ;
      } else if ( maxcol < col ) {
         maxcol = col ;
      }
   }
 } else if ( INPMTX_IS_BY_COLUMNS(mtx) ) {
   int   *rowind = InpMtx_ivec2(mtx) ;
   int   *colind = InpMtx_ivec1(mtx) ;
   int   col, ii, row ;

   minrow = maxrow = rowind[0] ;
   mincol = maxcol = colind[0] ;
   for ( ii = 1 ; ii < nent ; ii++ ) {
      row = rowind[ii] ;
      col = colind[ii] ;
      if ( minrow > row ) {
         minrow = row ;
      } else if ( maxrow < row ) {
         maxrow = row ;
      }
      if ( mincol > col ) {
         mincol = col ;
      } else if ( maxcol < col ) {
         maxcol = col ;
      }
   }
 } else if ( INPMTX_IS_BY_CHEVRONS(mtx) ) {
   int   *chvind  = InpMtx_ivec1(mtx) ;
   int   *offsets = InpMtx_ivec2(mtx) ;
   int   col, ii, off, row ;

   if ( (off = offsets[0]) >= 0 ) {
      row = chvind[0], col = row + off ;
   } else {
      col = chvind[0], row = col - off ;
   }
   minrow = maxrow = row ;
   mincol = maxcol = col ;
   for ( ii = 1 ; ii < nent ; ii++ ) {
      if ( (off = offsets[ii]) >= 0 ) {
         row = chvind[ii], col = row + off ;
      } else {
         col = chvind[ii], row = col - off ;
      }
      if ( minrow > row ) {
         minrow = row ;
      } else if ( maxrow < row ) {
         maxrow = row ;
      }
      if ( mincol > col ) {
         mincol = col ;
      } else if ( maxcol < col ) {
         maxcol = col ;
      }
   }
} else {
   fprintf(stderr, "\n fatal error in InpMtx_range()"
           "\n invalid coordType %d\n", mtx->coordType) ;
   return(-3) ;
}
if ( pmincol != NULL ) { *pmincol = mincol ; }
if ( pmaxcol != NULL ) { *pmaxcol = maxcol ; }
if ( pminrow != NULL ) { *pminrow = minrow ; }
if ( pmaxrow != NULL ) { *pmaxrow = maxrow ; }

return(1) ; }
Esempio n. 14
0
File: util.c Progetto: bialk/SPOOLES
/*
   ----------------------------------------------------
   convert from sorted and compressed triples to vector

   created -- 98jan28, cca
   ----------------------------------------------------
*/
void
InpMtx_convertToVectors (
   InpMtx   *inpmtx 
) {
int      *ivec1, *ivec2, *offsets, *sizes, *vecids ;
int      first, id, ient, jj, nent, nvector, value ;
/*
   ---------------
   check the input
   ---------------
*/
if ( inpmtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_convertToVectors(%p)"
           "\n bad input\n", inpmtx) ;
   exit(-1) ;
}
if ( INPMTX_IS_BY_VECTORS(inpmtx) || (nent = inpmtx->nent) == 0 ) {
   inpmtx->storageMode = INPMTX_BY_VECTORS ;
   return ;
}
if ( INPMTX_IS_RAW_DATA(inpmtx) ) {
   InpMtx_sortAndCompress(inpmtx) ;
}
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
/*
   -----------------------------------
   find the number of distinct vectors
   -----------------------------------
*/
value = -1 ;
nvector = 0 ;
for ( ient = 0 ; ient < nent ; ient++ ) {
   if ( ivec1[ient] >= 0 && value != ivec1[ient] ) {
      value = ivec1[ient] ;
      nvector++ ;
#if MYDEBUG > 0
      fprintf(stdout, "\n ient %d, value %d, nvector %d", 
              ient, value, nvector) ;
      fflush(stdout) ;
#endif
   }
}
#if MYDEBUG > 0
fprintf(stdout, "\n %d vectors", nvector) ;
fflush(stdout) ;
#endif
/*
   -----------------------------------------------------------------
   adjust the sizes of the sizes[] and offsets[] arrays if necessary
   -----------------------------------------------------------------
*/
InpMtx_setNvector(inpmtx, nvector) ;
if ( nvector <= 0 ) {
/*
   -----------------------------
   matrix has no entries, return
   -----------------------------
*/
   inpmtx->storageMode = INPMTX_RAW_DATA ;
   InpMtx_setNent(inpmtx, 0) ;
   return ;
}
vecids  = InpMtx_vecids(inpmtx)  ;
sizes   = InpMtx_sizes(inpmtx)   ;
offsets = InpMtx_offsets(inpmtx) ;
/*
   ------------------------------------------------------------
   set the vector sizes and offsets
   note: we skip all entries whose first coordinate is negative
   ------------------------------------------------------------
*/
for ( first = 0 ; first < nent ; first++ ) {
   if ( ivec1[first] >= 0 ) {
      break ;
   }
}
id = 0 ;
if ( first < nent ) {
   value = ivec1[first] ;
   for ( jj = first + 1 ; jj < nent ; jj++ ) {
      if ( ivec1[jj] != value ) {
         vecids[id]  = value      ;
         sizes[id]   = jj - first ;
         offsets[id] = first      ;
#if MYDEBUG > 0
         fprintf(stdout, 
                 "\n vecids[%d] = %d, sizes[%d] = %d, offsets[%d] = %d",
                 id, vecids[id], id, sizes[id], id, offsets[id]) ;
         fflush(stdout) ;
#endif
         first       = jj         ;
         value       = ivec1[jj]  ;
         id++ ;
      }
   }
   vecids[id]  = value      ;
   sizes[id]   = jj - first ;
   offsets[id] = first      ;
#if MYDEBUG > 0
   fprintf(stdout, 
           "\n vecids[%d] = %d, sizes[%d] = %d, offsets[%d] = %d",
           id, vecids[id], id, sizes[id], id, offsets[id]) ;
   fflush(stdout) ;
#endif
}
inpmtx->storageMode = INPMTX_BY_VECTORS ;
#if MYDEBUG > 0
fprintf(stdout, "\n vecidsIV") ;
IV_writeForHumanEye(&inpmtx->vecidsIV, stdout) ;
fprintf(stdout, "\n sizesIV") ;
IV_writeForHumanEye(&inpmtx->sizesIV, stdout) ;
fprintf(stdout, "\n offsetsIV") ;
IV_writeForHumanEye(&inpmtx->offsetsIV, stdout) ;
fflush(stdout) ;
#endif

return ; }
Esempio n. 15
0
File: util.c Progetto: bialk/SPOOLES
/*
   ----------------------------------
   drop entries in the upper triangle

   created -- 98jan28, cca
   ----------------------------------
*/
void
InpMtx_dropUpperTriangle (
   InpMtx   *inpmtx
) {
double   *dvec ;
int      count, ii, nent ;
int      *ivec1, *ivec2 ;
/*
   ---------------
   check the input
   ---------------
*/
if ( inpmtx == NULL ) {
   fprintf(stderr, "\n fatal error in InpMtx_dropUpperTriangle(%p)"
           "\n bad input\n", inpmtx) ;
   exit(-1) ;
}
if ( !(   INPMTX_IS_BY_ROWS(inpmtx)
       || INPMTX_IS_BY_COLUMNS(inpmtx)
       || INPMTX_IS_BY_CHEVRONS(inpmtx) ) ) {
   fprintf(stderr, "\n fatal error in InpMtx_dropUpperTriangle(%p)"
           "\n bad coordType \n", inpmtx) ;
   exit(-1) ;
}
nent  = inpmtx->nent ;
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
count = 0 ;
if (  INPMTX_IS_REAL_ENTRIES(inpmtx)
   || INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   dvec = InpMtx_dvec(inpmtx) ;
}
if ( INPMTX_IS_BY_ROWS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( ivec1[ii] >= ivec2[ii] ) {
         ivec1[count] = ivec1[ii] ;
         ivec2[count] = ivec2[ii] ;
         if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
            dvec[count] = dvec[ii]   ;
         } else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
            dvec[2*count]   = dvec[2*ii]   ;
            dvec[2*count+1] = dvec[2*ii+1] ;
         }
         count++ ;
      }
   }
} else if ( INPMTX_IS_BY_COLUMNS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( ivec1[ii] <= ivec2[ii] ) {
         ivec1[count] = ivec1[ii] ;
         ivec2[count] = ivec2[ii] ;
         if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
            dvec[count] = dvec[ii]   ;
         } else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
            dvec[2*count]   = dvec[2*ii]   ;
            dvec[2*count+1] = dvec[2*ii+1] ;
         }
         count++ ;
      }
   }
} else if ( INPMTX_IS_BY_CHEVRONS(inpmtx) ) {
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( ivec2[ii] <= 0 ) {
         ivec1[count] = ivec1[ii] ;
         ivec2[count] = ivec2[ii] ;
         if ( INPMTX_IS_REAL_ENTRIES(inpmtx) ) {
            dvec[count] = dvec[ii]   ;
         } else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
            dvec[2*count]   = dvec[2*ii]   ;
            dvec[2*count+1] = dvec[2*ii+1] ;
         }
         count++ ;
      }
   }
}
inpmtx->nent = count ;
IV_setSize(&inpmtx->ivec1IV, count) ;
IV_setSize(&inpmtx->ivec2IV, count) ;
if (  INPMTX_IS_REAL_ENTRIES(inpmtx)
   || INPMTX_IS_COMPLEX_ENTRIES(inpmtx) ) {
   DV_setSize(&inpmtx->dvecDV, count) ;
}

return ; }