Beispiel #1
0
void PrintMatUsingGetRow(void* A, HYPRE_Int beg_row, HYPRE_Int m,
                          HYPRE_Int *n2o_row, HYPRE_Int *n2o_col, char *filename)
{
  START_FUNC_DH
  FILE *fp;
  HYPRE_Int *o2n_col = NULL, pe, i, j, *cval, len;
  HYPRE_Int newCol, newRow;
  double *aval;

  /* form inverse column permutation */
  if (n2o_col != NULL) {
    o2n_col = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
    for (i=0; i<m; ++i) o2n_col[n2o_col[i]] = i;
  }

  for (pe=0; pe<np_dh; ++pe) {

    hypre_MPI_Barrier(comm_dh);

    if (myid_dh == pe) {
      if (pe == 0) {
        fp=fopen(filename, "w");
      } else {
        fp=fopen(filename, "a");
      }
      if (fp == NULL) {
        hypre_sprintf(msgBuf_dh, "can't open %s for writing\n", filename);
        SET_V_ERROR(msgBuf_dh);
      }

      for (i=0; i<m; ++i) {

        if (n2o_row == NULL) {
          EuclidGetRow(A, i+beg_row, &len, &cval, &aval); CHECK_V_ERROR;
          for (j=0; j<len; ++j) {
            hypre_fprintf(fp, "%i %i %g\n", i+1, cval[j], aval[j]);
          }
          EuclidRestoreRow(A, i, &len, &cval, &aval); CHECK_V_ERROR;
        } else {
          newRow = n2o_row[i] + beg_row;
          EuclidGetRow(A, newRow, &len, &cval, &aval); CHECK_V_ERROR;
          for (j=0; j<len; ++j) {
            newCol = o2n_col[cval[j]-beg_row] + beg_row; 
            hypre_fprintf(fp, "%i %i %g\n", i+1, newCol, aval[j]);
          }
          EuclidRestoreRow(A, i, &len, &cval, &aval); CHECK_V_ERROR;
        }
      }
      fclose(fp);
    }
  }

  if (n2o_col != NULL) {
    FREE_DH(o2n_col); CHECK_V_ERROR;
  }
  END_FUNC_DH
}
Beispiel #2
0
void iluk_seq(Euclid_dh ctx)
{
  START_FUNC_DH
  HYPRE_Int      *rp, *cval, *diag;
  HYPRE_Int      *CVAL;
  HYPRE_Int      i, j, len, count, col, idx = 0;
  HYPRE_Int      *list, *marker, *fill, *tmpFill;
  HYPRE_Int      temp, m, from = ctx->from, to = ctx->to;
  HYPRE_Int      *n2o_row, *o2n_col, beg_row, beg_rowP;
  double   *AVAL;
  REAL_DH  *work, *aval;
  Factor_dh F = ctx->F;
  SubdomainGraph_dh sg = ctx->sg;
  bool debug = false;

  if (logFile != NULL  &&  Parser_dhHasSwitch(parser_dh, "-debug_ilu")) debug = true;

  m = F->m;
  rp = F->rp;
  cval = F->cval;
  fill = F->fill;
  diag = F->diag;
  aval = F->aval;
  work = ctx->work;
  count = rp[from];

  if (sg == NULL) {
    SET_V_ERROR("subdomain graph is NULL");
  }

  n2o_row = ctx->sg->n2o_row;
  o2n_col = ctx->sg->o2n_col;
  beg_row  = ctx->sg->beg_row[myid_dh];
  beg_rowP  = ctx->sg->beg_rowP[myid_dh];

  /* allocate and initialize working space */
  list   = (HYPRE_Int*)MALLOC_DH((m+1)*sizeof(HYPRE_Int)); CHECK_V_ERROR;
  marker = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
  tmpFill = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
  for (i=0; i<m; ++i) marker[i] = -1;

  /* working space for values */
  for (i=0; i<m; ++i) work[i] = 0.0; 

/*    printf_dh("====================== starting iluk_seq; level= %i\n\n", ctx->level); 
*/


  /*---------- main loop ----------*/

  for (i=from; i<to; ++i) {
    HYPRE_Int row = n2o_row[i];             /* local row number */
    HYPRE_Int globalRow = row+beg_row;      /* global row number */

/*hypre_fprintf(logFile, "--------------------------------- localRow= %i\n", 1+i);
*/

    if (debug) {
	hypre_fprintf(logFile, "ILU_seq ================================= starting local row: %i, (global= %i) level= %i\n", i+1, i+1+sg->beg_rowP[myid_dh], ctx->level);
    }

    EuclidGetRow(ctx->A, globalRow, &len, &CVAL, &AVAL); CHECK_V_ERROR;

    /* compute scaling value for row(i) */
    if (ctx->isScaled) { 
      compute_scaling_private(i, len, AVAL, ctx); CHECK_V_ERROR; 
    }

    /* Compute symbolic factor for row(i);
       this also performs sparsification
     */
    count = symbolic_row_private(i, list, marker, tmpFill, 
                                 len, CVAL, AVAL,
                                 o2n_col, ctx, debug); CHECK_V_ERROR;

    /* Ensure adequate storage; reallocate, if necessary. */
    if (idx + count > F->alloc) {
      Factor_dhReallocate(F, idx, count); CHECK_V_ERROR;
      SET_INFO("REALLOCATED from ilu_seq");
      cval = F->cval;
      fill = F->fill;
      aval = F->aval;
    }

    /* Copy factored symbolic row to permanent storage */
    col = list[m];
    while (count--) {
      cval[idx] = col;  
      fill[idx] = tmpFill[col];
      ++idx;
/*hypre_fprintf(logFile, "  col= %i\n", 1+col);
*/
      col = list[col];
    }

    /* add row-pointer to start of next row. */
    rp[i+1] = idx;

    /* Insert pointer to diagonal */
    temp = rp[i]; 
    while (cval[temp] != i) ++temp; 
    diag[i] = temp;

/*hypre_fprintf(logFile, "  diag[i]= %i\n", diag);
*/

    /* compute numeric factor for current row */
     numeric_row_private(i, len, CVAL, AVAL, 
                          work, o2n_col, ctx, debug); CHECK_V_ERROR
    EuclidRestoreRow(ctx->A, globalRow, &len, &CVAL, &AVAL); CHECK_V_ERROR;

    /* Copy factored numeric row to permanent storage,
       and re-zero work vector
     */
    if (debug) {
      hypre_fprintf(logFile, "ILU_seq:  ");
      for (j=rp[i]; j<rp[i+1]; ++j) {
        col = cval[j];  
        aval[j] = work[col];  
        work[col] = 0.0;
        hypre_fprintf(logFile, "%i,%i,%g ; ", 1+cval[j], fill[j], aval[j]);
        fflush(logFile);
      }
      hypre_fprintf(logFile, "\n");
    } else {
      for (j=rp[i]; j<rp[i+1]; ++j) {
        col = cval[j];  
        aval[j] = work[col];  
        work[col] = 0.0;
      }
    }

    /* check for zero diagonal */
    if (! aval[diag[i]]) {
      hypre_sprintf(msgBuf_dh, "zero diagonal in local row %i", i+1);
      SET_V_ERROR(msgBuf_dh);
    }
  }

  FREE_DH(list); CHECK_V_ERROR;
  FREE_DH(tmpFill); CHECK_V_ERROR;
  FREE_DH(marker); CHECK_V_ERROR;

  /* adjust column indices back to global */
  if (beg_rowP) {
    HYPRE_Int start = rp[from];
    HYPRE_Int stop = rp[to];
    for (i=start; i<stop; ++i) cval[i] += beg_rowP;
  }

  /* for debugging: this is so the Print methods will work, even if
     F hasn't been fully factored
  */
  for (i=to+1; i<m; ++i) rp[i] = 0;

  END_FUNC_DH
}
Beispiel #3
0
void ilut_seq(Euclid_dh ctx)
{
  START_FUNC_DH
  HYPRE_Int      *rp, *cval, *diag, *CVAL;
  HYPRE_Int      i, len, count, col, idx = 0;
  HYPRE_Int      *list, *marker;
  HYPRE_Int      temp, m, from, to;
  HYPRE_Int      *n2o_row, *o2n_col, beg_row, beg_rowP;
  double   *AVAL, droptol; 
  REAL_DH *work, *aval, val;
  Factor_dh F = ctx->F;
  SubdomainGraph_dh sg = ctx->sg;
  bool debug = false;

  if (logFile != NULL  &&  Parser_dhHasSwitch(parser_dh, "-debug_ilu")) debug = true;

  m = F->m;
  rp = F->rp;
  cval = F->cval;
  diag = F->diag;
  aval = F->aval;
  work = ctx->work;
  from = ctx->from;
  to = ctx->to;
  count = rp[from];
  droptol = ctx->droptol;

  if (sg == NULL) {
    SET_V_ERROR("subdomain graph is NULL");
  }

  n2o_row = ctx->sg->n2o_row;
  o2n_col = ctx->sg->o2n_col;
  beg_row  = ctx->sg->beg_row[myid_dh];
  beg_rowP  = ctx->sg->beg_rowP[myid_dh];


  /* allocate and initialize working space */
  list   = (HYPRE_Int*)MALLOC_DH((m+1)*sizeof(HYPRE_Int)); CHECK_V_ERROR;
  marker = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
  for (i=0; i<m; ++i) marker[i] = -1;
  rp[0] = 0;

  /* working space for values */
  for (i=0; i<m; ++i) work[i] = 0.0; 

  /* ----- main loop start ----- */
  for (i=from; i<to; ++i) {
    HYPRE_Int row = n2o_row[i];             /* local row number */
    HYPRE_Int globalRow = row + beg_row;    /* global row number */
    EuclidGetRow(ctx->A, globalRow, &len, &CVAL, &AVAL); CHECK_V_ERROR;

    /* compute scaling value for row(i) */
    compute_scaling_private(i, len, AVAL, ctx); CHECK_V_ERROR; 

    /* compute factor for row i */
    count = ilut_row_private(i, list, o2n_col, marker,
                         len, CVAL, AVAL, work, ctx, debug); CHECK_V_ERROR;

    EuclidRestoreRow(ctx->A, globalRow, &len, &CVAL, &AVAL); CHECK_V_ERROR;

    /* Ensure adequate storage; reallocate, if necessary. */
    if (idx + count > F->alloc) {
      Factor_dhReallocate(F, idx, count); CHECK_V_ERROR;
      SET_INFO("REALLOCATED from ilu_seq");
      cval = F->cval;
      aval = F->aval;
    }

    /* Copy factored row to permanent storage,
       apply 2nd drop test,
       and re-zero work vector
     */
    col = list[m];
    while (count--) {
      val = work[col];
      if (col == i || fabs(val) > droptol) {
        cval[idx] = col;   
        aval[idx++] = val;
        work[col] = 0.0;
      }
      col = list[col];
    }

    /* add row-pointer to start of next row. */
    rp[i+1] = idx;

    /* Insert pointer to diagonal */
    temp = rp[i]; 
    while (cval[temp] != i) ++temp;
    diag[i] = temp;

    /* check for zero diagonal */
    if (! aval[diag[i]]) {
      hypre_sprintf(msgBuf_dh, "zero diagonal in local row %i", i+1);
      SET_V_ERROR(msgBuf_dh);
    }
  } /* --------- main loop end --------- */

  /* adjust column indices back to global */
  if (beg_rowP) {
    HYPRE_Int start = rp[from];
    HYPRE_Int stop = rp[to];
    for (i=start; i<stop; ++i) cval[i] += beg_rowP;
  }

  FREE_DH(list);
  FREE_DH(marker);
  END_FUNC_DH
}
Beispiel #4
0
void iluk_seq_block(Euclid_dh ctx)
{
  START_FUNC_DH
  HYPRE_Int      *rp, *cval, *diag;
  HYPRE_Int      *CVAL;
  HYPRE_Int      h, i, j, len, count, col, idx = 0;
  HYPRE_Int      *list, *marker, *fill, *tmpFill;
  HYPRE_Int      temp, m;
  HYPRE_Int      *n2o_row, *o2n_col, *beg_rowP, *n2o_sub, blocks;
  HYPRE_Int      *row_count, *dummy = NULL, dummy2[1];
  double   *AVAL;
  REAL_DH  *work, *aval;
  Factor_dh F = ctx->F;
  SubdomainGraph_dh sg = ctx->sg;
  bool bj = false, constrained = false;
  HYPRE_Int discard = 0;
  HYPRE_Int gr = -1;  /* globalRow */
  bool debug = false;

  if (logFile != NULL  &&  Parser_dhHasSwitch(parser_dh, "-debug_ilu")) debug = true;

/*hypre_fprintf(stderr, "====================== starting iluk_seq_block; level= %i\n\n", ctx->level); 
*/

  if (!strcmp(ctx->algo_par, "bj")) bj = true;
  constrained = ! Parser_dhHasSwitch(parser_dh, "-unconstrained");

  m    = F->m;
  rp   = F->rp;
  cval = F->cval;
  fill = F->fill;
  diag = F->diag;
  aval = F->aval;
  work = ctx->work;

  if (sg != NULL) {
    n2o_row   = sg->n2o_row;
    o2n_col   = sg->o2n_col;
    row_count = sg->row_count;
    /* beg_row   = sg->beg_row ; */
    beg_rowP  = sg->beg_rowP;
    n2o_sub   = sg->n2o_sub;
    blocks    = sg->blocks;
  }

  else {
    dummy = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
    for (i=0; i<m; ++i) dummy[i] = i;
    n2o_row   = dummy;
    o2n_col   = dummy;
    dummy2[0] = m; row_count = dummy2;
    /* beg_row   = 0; */
    beg_rowP  = dummy;
    n2o_sub   = dummy;
    blocks    = 1;
  }

  /* allocate and initialize working space */
  list   = (HYPRE_Int*)MALLOC_DH((m+1)*sizeof(HYPRE_Int)); CHECK_V_ERROR;
  marker = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
  tmpFill = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
  for (i=0; i<m; ++i) marker[i] = -1;

  /* working space for values */
  for (i=0; i<m; ++i) work[i] = 0.0; 

  /*---------- main loop ----------*/

 for (h=0; h<blocks; ++h) {
  /* 1st and last row in current block, with respect to A */
  HYPRE_Int curBlock = n2o_sub[h];
  HYPRE_Int first_row = beg_rowP[curBlock];
  HYPRE_Int end_row   = first_row + row_count[curBlock];

    if (debug) {
        hypre_fprintf(logFile, "\n\nILU_seq BLOCK: %i @@@@@@@@@@@@@@@ \n", curBlock);
    }

  for (i=first_row; i<end_row; ++i) {
    HYPRE_Int row = n2o_row[i];  
    ++gr;

    if (debug) {
      hypre_fprintf(logFile, "ILU_seq  global: %i  local: %i =================================\n", 1+gr, 1+i-first_row);
    }

/*prinft("first_row= %i  end_row= %i\n", first_row, end_row);
*/

    EuclidGetRow(ctx->A, row, &len, &CVAL, &AVAL); CHECK_V_ERROR;

    /* compute scaling value for row(i) */
    if (ctx->isScaled) { 
      compute_scaling_private(i, len, AVAL, ctx); CHECK_V_ERROR; 
    }

    /* Compute symbolic factor for row(i);
       this also performs sparsification
     */
    count = symbolic_row_private(i, list, marker, tmpFill, 
                                 len, CVAL, AVAL,
                                 o2n_col, ctx, debug); CHECK_V_ERROR;

    /* Ensure adequate storage; reallocate, if necessary. */
    if (idx + count > F->alloc) {
      Factor_dhReallocate(F, idx, count); CHECK_V_ERROR;
      SET_INFO("REALLOCATED from ilu_seq");
      cval = F->cval;
      fill = F->fill;
      aval = F->aval;
    }

    /* Copy factored symbolic row to permanent storage */
    col = list[m];
    while (count--) {

      /* constrained pilu */
      if (constrained && !bj) {
        if (col >= first_row && col < end_row) {
          cval[idx] = col;  
          fill[idx] = tmpFill[col];
          ++idx;
        } else { 
          if (check_constraint_private(ctx, curBlock, col)) {
            cval[idx] = col;  
            fill[idx] = tmpFill[col];
            ++idx;
          } else {
            ++discard; 
          }
        }
        col = list[col];
      }

      /* block jacobi case */
      else if (bj) {
        if (col >= first_row && col < end_row) {
          cval[idx] = col;  
          fill[idx] = tmpFill[col];
          ++idx;
        } else { 
          ++discard; 
        }
        col = list[col];
      }

      /* general case */
      else {
        cval[idx] = col;  
        fill[idx] = tmpFill[col];
        ++idx;
        col = list[col];
      }
    }

    /* add row-pointer to start of next row. */
    rp[i+1] = idx;

    /* Insert pointer to diagonal */
    temp = rp[i]; 
    while (cval[temp] != i) ++temp; 
    diag[i] = temp;

    /* compute numeric factor for current row */
    numeric_row_private(i, len, CVAL, AVAL, 
                          work, o2n_col, ctx, debug); CHECK_V_ERROR
    EuclidRestoreRow(ctx->A, row, &len, &CVAL, &AVAL); CHECK_V_ERROR;

    /* Copy factored numeric row to permanent storage,
       and re-zero work vector
     */
    if (debug) {
      hypre_fprintf(logFile, "ILU_seq: ");
      for (j=rp[i]; j<rp[i+1]; ++j) {
        col = cval[j];  
        aval[j] = work[col];  
        work[col] = 0.0;
        hypre_fprintf(logFile, "%i,%i,%g ; ", 1+cval[j], fill[j], aval[j]);
      }
      hypre_fprintf(logFile, "\n");
     } 

     /* normal operation */
     else {
      for (j=rp[i]; j<rp[i+1]; ++j) {
        col = cval[j];  
        aval[j] = work[col];  
        work[col] = 0.0;
      } 
    }

    /* check for zero diagonal */
    if (! aval[diag[i]]) {
      hypre_sprintf(msgBuf_dh, "zero diagonal in local row %i", i+1);
      SET_V_ERROR(msgBuf_dh);
    }
  }
 }

/*  hypre_printf("bj= %i  constrained= %i  discarded= %i\n", bj, constrained, discard); */

  if (dummy != NULL) { FREE_DH(dummy); CHECK_V_ERROR; }
  FREE_DH(list); CHECK_V_ERROR;
  FREE_DH(tmpFill); CHECK_V_ERROR;
  FREE_DH(marker); CHECK_V_ERROR;

  END_FUNC_DH
}
Beispiel #5
0
void iluk_mpi_bj(Euclid_dh ctx)
{
  START_FUNC_DH
  HYPRE_Int      *rp, *cval, *diag;
  HYPRE_Int      *CVAL;
  HYPRE_Int      i, j, len, count, col, idx = 0;
  HYPRE_Int      *list, *marker, *fill, *tmpFill;
  HYPRE_Int      temp, m, from = ctx->from, to = ctx->to;
  HYPRE_Int      *n2o_row, *o2n_col;
  HYPRE_Int      first_row, last_row;
  double   *AVAL;
  REAL_DH  *work, *aval;
  Factor_dh F = ctx->F;
  SubdomainGraph_dh sg = ctx->sg;

if (ctx->F == NULL) {
  SET_V_ERROR("ctx->F is NULL");
}
if (ctx->F->rp == NULL) {
  SET_V_ERROR("ctx->F->rp is NULL");
}

/*  printf_dh("====================== starting iluk_mpi_bj; level= %i\n\n", ctx->level);
*/

  m    = F->m;
  rp   = F->rp;
  cval = F->cval;
  fill = F->fill;
  diag = F->diag;
  aval = F->aval;
  work = ctx->work;

  n2o_row = sg->n2o_row;
  o2n_col = sg->o2n_col;

  /* allocate and initialize working space */
  list   = (HYPRE_Int*)MALLOC_DH((m+1)*sizeof(HYPRE_Int)); CHECK_V_ERROR;
  marker = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
  tmpFill = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
  for (i=0; i<m; ++i) {
    marker[i] = -1;
    work[i] = 0.0; 
  }

  /*---------- main loop ----------*/

  /* global numbers of first and last locally owned rows,
     with respect to A 
   */
  first_row = sg->beg_row[myid_dh];
  last_row  = first_row + sg->row_count[myid_dh];
  for (i=from; i<to; ++i) {

    HYPRE_Int row = n2o_row[i];            /* local row number */
    HYPRE_Int globalRow = row + first_row; /* global row number */

    EuclidGetRow(ctx->A, globalRow, &len, &CVAL, &AVAL); CHECK_V_ERROR;

    /* compute scaling value for row(i) */
    if (ctx->isScaled) { 
      compute_scaling_private(i, len, AVAL, ctx); CHECK_V_ERROR; 
    }

    /* Compute symbolic factor for row(i);
       this also performs sparsification
     */
    count = symbolic_row_private(i, first_row, last_row,
                                 list, marker, tmpFill, 
                                 len, CVAL, AVAL,
                                 o2n_col, ctx); CHECK_V_ERROR;

    /* Ensure adequate storage; reallocate, if necessary. */
    if (idx + count > F->alloc) {
      Factor_dhReallocate(F, idx, count); CHECK_V_ERROR;
      SET_INFO("REALLOCATED from lu_mpi_bj");
      cval = F->cval;
      fill = F->fill;
      aval = F->aval;
    }

    /* Copy factored symbolic row to permanent storage */
    col = list[m];
    while (count--) {
      cval[idx] = col;  
      fill[idx] = tmpFill[col];
      ++idx;
      col = list[col];
    }

    /* add row-pointer to start of next row. */
    rp[i+1] = idx;

    /* Insert pointer to diagonal */
    temp = rp[i]; 
    while (cval[temp] != i) ++temp; 
    diag[i] = temp;

    /* compute numeric factor for current row */
     numeric_row_private(i, first_row, last_row,
                          len, CVAL, AVAL, 
                          work, o2n_col, ctx); CHECK_V_ERROR
    EuclidRestoreRow(ctx->A, globalRow, &len, &CVAL, &AVAL); CHECK_V_ERROR;

    /* Copy factored numeric row to permanent storage,
       and re-zero work vector
     */
    for (j=rp[i]; j<rp[i+1]; ++j) {
      col = cval[j];  
      aval[j] = work[col];  
      work[col] = 0.0;
    } 

    /* check for zero diagonal */
    if (! aval[diag[i]]) {
      hypre_sprintf(msgBuf_dh, "zero diagonal in local row %i", i+1);
      SET_V_ERROR(msgBuf_dh);
    }
  }

  FREE_DH(list); CHECK_V_ERROR;
  FREE_DH(tmpFill); CHECK_V_ERROR;
  FREE_DH(marker); CHECK_V_ERROR;

  END_FUNC_DH
}