Пример #1
0
void FIDA_SPGMR(int *maxl, int *gstype, int *maxrs,
		realtype *eplifac, realtype *dqincfac, int *ier)
{

  *ier = 0;

  *ier = IDASpgmr(IDA_idamem, *maxl);
  if (*ier != IDASPILS_SUCCESS) return;

  if (*gstype != 0) {
    *ier = IDASpilsSetGSType(IDA_idamem, *gstype);
    if (*ier != IDASPILS_SUCCESS) return;
  }

  if (*maxrs != 0) {
    *ier = IDASpilsSetMaxRestarts(IDA_idamem, *maxrs);
    if (*ier != IDASPILS_SUCCESS) return;
  }

  if (*eplifac != ZERO) {
    *ier = IDASpilsSetEpsLin(IDA_idamem, *eplifac);
    if (*ier != IDASPILS_SUCCESS) return;
  }

  if (*dqincfac != ZERO) {
    *ier = IDASpilsSetIncrementFactor(IDA_idamem, *dqincfac);
    if (*ier != IDASPILS_SUCCESS) return;
  }

  IDA_ls = IDA_LS_SPGMR;

  return;
}
int IDABBDSpgmr(void *ida_mem, int maxl, void *bbd_data)
{
  IDAMem IDA_mem;
  int flag;

  flag = IDASpgmr(ida_mem, maxl);
  if(flag != IDASPILS_SUCCESS) return(flag);

  IDA_mem = (IDAMem) ida_mem;

  if (bbd_data == NULL) {
    IDAProcessError(IDA_mem, IDABBDPRE_PDATA_NULL, "IDABBDPRE", "IDABBDSpgmr", MSGBBD_PDATA_NULL);
    return(IDABBDPRE_PDATA_NULL);
  }

  flag = IDASpilsSetPreconditioner(ida_mem, IDABBDPrecSetup,
                                   IDABBDPrecSolve, bbd_data);
  if(flag != IDASPILS_SUCCESS) return(flag);

  return(IDASPILS_SUCCESS);
}
Пример #3
0
int main()
{
  void *mem;
  UserData data;
  N_Vector uu, up, constraints, res;
  int ier, iout;
  realtype rtol, atol, t0, t1, tout, tret;
  long int netf, ncfn, ncfl;

  mem = NULL;
  data = NULL;
  uu = up = constraints = res = NULL;

  /* Allocate N-vectors and the user data structure. */

  uu = N_VNew_Serial(NEQ);
  if(check_flag((void *)uu, "N_VNew_Serial", 0)) return(1);

  up = N_VNew_Serial(NEQ);
  if(check_flag((void *)up, "N_VNew_Serial", 0)) return(1);

  res = N_VNew_Serial(NEQ);
  if(check_flag((void *)res, "N_VNew_Serial", 0)) return(1);

  constraints = N_VNew_Serial(NEQ);
  if(check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1);

  data = (UserData) malloc(sizeof *data);
  data->pp = NULL;
  if(check_flag((void *)data, "malloc", 2)) return(1);

  /* Assign parameters in the user data structure. */

  data->mm  = MGRID;
  data->dx = ONE/(MGRID-ONE);
  data->coeff = ONE/(data->dx * data->dx);
  data->pp = N_VNew_Serial(NEQ);
  if(check_flag((void *)data->pp, "N_VNew_Serial", 0)) return(1);

  /* Initialize uu, up. */

  SetInitialProfile(data, uu, up, res);

  /* Set constraints to all 1's for nonnegative solution values. */

  N_VConst(ONE, constraints);

  /* Assign various parameters. */

  t0   = ZERO;
  t1   = RCONST(0.01);
  rtol = ZERO;
  atol = RCONST(1.0e-3); 

  /* Call IDACreate and IDAMalloc to initialize solution */

  mem = IDACreate();
  if(check_flag((void *)mem, "IDACreate", 0)) return(1);

  ier = IDASetUserData(mem, data);
  if(check_flag(&ier, "IDASetUserData", 1)) return(1);

  ier = IDASetConstraints(mem, constraints);
  if(check_flag(&ier, "IDASetConstraints", 1)) return(1);
  N_VDestroy_Serial(constraints);

  ier = IDAInit(mem, resHeat, t0, uu, up);
  if(check_flag(&ier, "IDAInit", 1)) return(1);

  ier = IDASStolerances(mem, rtol, atol);
  if(check_flag(&ier, "IDASStolerances", 1)) return(1);

  /* Call IDASpgmr to specify the linear solver. */

  ier = IDASpgmr(mem, 0);
  if(check_flag(&ier, "IDASpgmr", 1)) return(1);

  ier = IDASpilsSetPreconditioner(mem, PsetupHeat, PsolveHeat);
  if(check_flag(&ier, "IDASpilsSetPreconditioner", 1)) return(1);

  /* Print output heading. */
  PrintHeader(rtol, atol);
  
  /* 
   * -------------------------------------------------------------------------
   * CASE I 
   * -------------------------------------------------------------------------
   */
  
  /* Print case number, output table heading, and initial line of table. */

  printf("\n\nCase 1: gsytpe = MODIFIED_GS\n");
  printf("\n   Output Summary (umax = max-norm of solution) \n\n");
  printf("  time     umax       k  nst  nni  nje   nre   nreLS    h      npe nps\n" );
  printf("----------------------------------------------------------------------\n");

  /* Loop over output times, call IDASolve, and print results. */

  for (tout = t1,iout = 1; iout <= NOUT ; iout++, tout *= TWO) {
    ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL);
    if(check_flag(&ier, "IDASolve", 1)) return(1);
    PrintOutput(mem, tret, uu);
  }

  /* Print remaining counters. */

  ier = IDAGetNumErrTestFails(mem, &netf);
  check_flag(&ier, "IDAGetNumErrTestFails", 1);

  ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn);
  check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1);

  ier = IDASpilsGetNumConvFails(mem, &ncfl);
  check_flag(&ier, "IDASpilsGetNumConvFails", 1);

  printf("\nError test failures            = %ld\n", netf);
  printf("Nonlinear convergence failures = %ld\n", ncfn);
  printf("Linear convergence failures    = %ld\n", ncfl);

  /* 
   * -------------------------------------------------------------------------
   * CASE II
   * -------------------------------------------------------------------------
   */
  
  /* Re-initialize uu, up. */

  SetInitialProfile(data, uu, up, res);
  
  /* Re-initialize IDA and IDASPGMR */

  ier = IDAReInit(mem, t0, uu, up);
  if(check_flag(&ier, "IDAReInit", 1)) return(1);
  
  ier = IDASpilsSetGSType(mem, CLASSICAL_GS);
  if(check_flag(&ier, "IDASpilsSetGSType",1)) return(1); 
  
  /* Print case number, output table heading, and initial line of table. */

  printf("\n\nCase 2: gstype = CLASSICAL_GS\n");
  printf("\n   Output Summary (umax = max-norm of solution) \n\n");
  printf("  time     umax       k  nst  nni  nje   nre   nreLS    h      npe nps\n" );
  printf("----------------------------------------------------------------------\n");

  /* Loop over output times, call IDASolve, and print results. */

  for (tout = t1,iout = 1; iout <= NOUT ; iout++, tout *= TWO) {
    ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL);
    if(check_flag(&ier, "IDASolve", 1)) return(1);
    PrintOutput(mem, tret, uu);
  }

  /* Print remaining counters. */

  ier = IDAGetNumErrTestFails(mem, &netf);
  check_flag(&ier, "IDAGetNumErrTestFails", 1);

  ier = IDAGetNumNonlinSolvConvFails(mem, &ncfn);
  check_flag(&ier, "IDAGetNumNonlinSolvConvFails", 1);

  ier = IDASpilsGetNumConvFails(mem, &ncfl);
  check_flag(&ier, "IDASpilsGetNumConvFails", 1);

  printf("\nError test failures            = %ld\n", netf);
  printf("Nonlinear convergence failures = %ld\n", ncfn);
  printf("Linear convergence failures    = %ld\n", ncfl);

  /* Free Memory */

  IDAFree(&mem);

  N_VDestroy_Serial(uu);
  N_VDestroy_Serial(up);
  N_VDestroy_Serial(res);

  N_VDestroy_Serial(data->pp);
  free(data);

  return(0);
}
Пример #4
0
int main(int argc, char *argv[])
{
  MPI_Comm comm;
  void *mem;
  UserData data;
  int thispe, iout, ier, npes;
  long int Neq, local_N, mudq, mldq, mukeep, mlkeep;
  realtype rtol, atol, t0, t1, tout, tret;
  N_Vector uu, up, constraints, id, res;

  mem = NULL;
  data = NULL;
  uu = up = constraints = id = res = NULL;

  /* Get processor number and total number of pe's. */

  MPI_Init(&argc, &argv);
  comm = MPI_COMM_WORLD;
  MPI_Comm_size(comm, &npes);
  MPI_Comm_rank(comm, &thispe);
  
  if (npes != NPEX*NPEY) {
    if (thispe == 0)
      fprintf(stderr, 
              "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n", 
              npes,NPEX*NPEY);
    MPI_Finalize();
    return(1);
  }
  
  /* Set local length local_N and global length Neq. */

  local_N = MXSUB*MYSUB;
  Neq     = MX * MY;

  /* Allocate N-vectors. */

  uu = N_VNew_Parallel(comm, local_N, Neq);
  if(check_flag((void *)uu, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  up = N_VNew_Parallel(comm, local_N, Neq);
  if(check_flag((void *)up, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  res = N_VNew_Parallel(comm, local_N, Neq);
  if(check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  constraints = N_VNew_Parallel(comm, local_N, Neq);
  if(check_flag((void *)constraints, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  id = N_VNew_Parallel(comm, local_N, Neq);
  if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  /* Allocate and initialize the data structure. */

  data = (UserData) malloc(sizeof *data);
  if(check_flag((void *)data, "malloc", 2, thispe)) MPI_Abort(comm, 1);

  InitUserData(thispe, comm, data);

  /* Initialize the uu, up, id, and constraints profiles. */

  SetInitialProfile(uu, up, id, res, data);
  N_VConst(ONE, constraints);

  t0 = ZERO; t1 = RCONST(0.01);

  /* Scalar relative and absolute tolerance. */

  rtol = ZERO;
  atol = RCONST(1.0e-3);

  /* Call IDACreate and IDAMalloc to initialize solution */

  mem = IDACreate();
  if(check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1);

  ier = IDASetUserData(mem, data);
  if(check_flag(&ier, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1);

  ier = IDASetSuppressAlg(mem, TRUE);
  if(check_flag(&ier, "IDASetSuppressAlg", 1, thispe)) MPI_Abort(comm, 1);

  ier = IDASetId(mem, id);
  if(check_flag(&ier, "IDASetId", 1, thispe)) MPI_Abort(comm, 1);

  ier = IDASetConstraints(mem, constraints);
  if(check_flag(&ier, "IDASetConstraints", 1, thispe)) MPI_Abort(comm, 1);
  N_VDestroy_Parallel(constraints);

  ier = IDAInit(mem, heatres, t0, uu, up);
  if(check_flag(&ier, "IDAInit", 1, thispe)) MPI_Abort(comm, 1);

  ier = IDASStolerances(mem, rtol, atol);
  if(check_flag(&ier, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1);

  mudq = MXSUB;
  mldq = MXSUB;
  mukeep = 1;
  mlkeep = 1;

  /* Print problem description */

  if (thispe == 0 ) PrintHeader(Neq, rtol, atol);
  
  /* 
   * ----------------------------- 
   * Case 1 -- mldq = mudq = MXSUB 
   * ----------------------------- 
   */

  /* Call IDASpgmr to specify the linear solver. */
  ier = IDASpgmr(mem, 0);
  if(check_flag(&ier, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1);
  
  /* Call IDABBDPrecInit to initialize BBD preconditioner. */
  ier = IDABBDPrecInit(mem, local_N, mudq, mldq, mukeep, mlkeep, 
                       ZERO, reslocal, NULL);
  if(check_flag(&ier, "IDABBDPrecAlloc", 1, thispe)) MPI_Abort(comm, 1);

  /* Print output heading (on processor 0 only) and initial solution. */
  if (thispe == 0) PrintCase(1, mudq, mukeep);

  /* Loop over tout, call IDASolve, print output. */
  for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) { 
    
    ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL);
    if(check_flag(&ier, "IDASolve", 1, thispe)) MPI_Abort(comm, 1);

    PrintOutput(thispe, mem, tret, uu);
    
  }

  /* Print final statistics */
  if (thispe == 0) PrintFinalStats(mem);
  
  /*
   * ----------------------------- 
   * Case 2 -- mldq = mudq = 1
   * ----------------------------- 
   */
  
  mudq = 1;
  mldq = 1;

  /* Re-initialize the uu and up profiles. */
  SetInitialProfile(uu, up, id, res, data);

  /* Call IDAReInit to re-initialize IDA. */
  ier = IDAReInit(mem, t0, uu, up);
  if(check_flag(&ier, "IDAReInit", 1, thispe)) MPI_Abort(comm, 1);

  /* Call IDABBDPrecReInit to re-initialize BBD preconditioner. */
  ier = IDABBDPrecReInit(mem, mudq, mldq, ZERO);
  if(check_flag(&ier, "IDABBDPrecReInit", 1, thispe)) MPI_Abort(comm, 1);

  /* Print output heading (on processor 0 only). */
  if (thispe == 0) PrintCase(2, mudq, mukeep);

  /* Loop over tout, call IDASolve, print output. */
  for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) { 
    
    ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL);
    if(check_flag(&ier, "IDASolve", 1, thispe)) MPI_Abort(comm, 1);

    PrintOutput(thispe, mem, tret, uu);
    
  }
  
  /* Print final statistics */
  if (thispe == 0) PrintFinalStats(mem);

  /* Free Memory */
  IDAFree(&mem);
  free(data);
  N_VDestroy_Parallel(id);
  N_VDestroy_Parallel(res);
  N_VDestroy_Parallel(up);
  N_VDestroy_Parallel(uu);

  MPI_Finalize();

  return(0);

}
Пример #5
0
int main(int argc, char *argv[])
{
  MPI_Comm comm;
  void *mem;
  UserData webdata;
  long int SystemSize, local_N, mudq, mldq, mukeep, mlkeep;
  realtype rtol, atol, t0, tout, tret;
  N_Vector cc, cp, res, id;
  int thispe, npes, maxl, iout, retval;

  cc = cp = res = id = NULL;
  webdata = NULL;
  mem = NULL;

  /* Set communicator, and get processor number and total number of PE's. */

  MPI_Init(&argc, &argv);
  comm = MPI_COMM_WORLD;
  MPI_Comm_rank(comm, &thispe);
  MPI_Comm_size(comm, &npes);

  if (npes != NPEX*NPEY) {
    if (thispe == 0)
      fprintf(stderr, 
              "\nMPI_ERROR(0): npes = %d not equal to NPEX*NPEY = %d\n", 
              npes, NPEX*NPEY);
    MPI_Finalize();
    return(1); 
  }
  
  /* Set local length (local_N) and global length (SystemSize). */

  local_N = MXSUB*MYSUB*NUM_SPECIES;
  SystemSize = NEQ;

  /* Set up user data block webdata. */

  webdata = (UserData) malloc(sizeof *webdata);
  webdata->rates = N_VNew_Parallel(comm, local_N, SystemSize);
  webdata->acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES);

  InitUserData(webdata, thispe, npes, comm);
  
  /* Create needed vectors, and load initial values.
     The vector res is used temporarily only.        */
  
  cc  = N_VNew_Parallel(comm, local_N, SystemSize);
  if(check_flag((void *)cc, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  cp  = N_VNew_Parallel(comm, local_N, SystemSize);
  if(check_flag((void *)cp, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  res = N_VNew_Parallel(comm, local_N, SystemSize);
  if(check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  id  = N_VNew_Parallel(comm, local_N, SystemSize);
  if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);
  
  SetInitialProfiles(cc, cp, id, res, webdata);
  
  N_VDestroy_Parallel(res);
  
  /* Set remaining inputs to IDAMalloc. */
  
  t0 = ZERO;
  rtol = RTOL; 
  atol = ATOL;
  
  /* Call IDACreate and IDAMalloc to initialize solution */

  mem = IDACreate();
  if(check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1);

  retval = IDASetUserData(mem, webdata);
  if(check_flag(&retval, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1);

  retval = IDASetId(mem, id);
  if(check_flag(&retval, "IDASetId", 1, thispe)) MPI_Abort(comm, 1);

  retval = IDAInit(mem, resweb, t0, cc, cp);
  if(check_flag(&retval, "IDAInit", 1, thispe)) MPI_Abort(comm, 1);
  
  retval = IDASStolerances(mem, rtol, atol);
  if(check_flag(&retval, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1);

  /* Call IDASpgmr to specify the IDA linear solver IDASPGMR */

  maxl = 16;
  retval = IDASpgmr(mem, maxl);
  if(check_flag(&retval, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1);

  /* Call IDABBDPrecInit to initialize the band-block-diagonal preconditioner.
     The half-bandwidths for the difference quotient evaluation are exact
     for the system Jacobian, but only a 5-diagonal band matrix is retained. */
  
  mudq = mldq = NSMXSUB;
  mukeep = mlkeep = 2;
  retval = IDABBDPrecInit(mem, local_N, mudq, mldq, mukeep, mlkeep, 
                          ZERO, reslocal, NULL);
  if(check_flag(&retval, "IDABBDPrecInit", 1, thispe)) MPI_Abort(comm, 1);
  
  /* Call IDACalcIC (with default options) to correct the initial values. */
  
  tout = RCONST(0.001);
  retval = IDACalcIC(mem, IDA_YA_YDP_INIT, tout);
  if(check_flag(&retval, "IDACalcIC", 1, thispe)) MPI_Abort(comm, 1);
  
  /* On PE 0, print heading, basic parameters, initial values. */
 
  if (thispe == 0) PrintHeader(SystemSize, maxl, 
                               mudq, mldq, mukeep, mlkeep,
                               rtol, atol);
  PrintOutput(mem, cc, t0, webdata, comm);

  /* Call IDA in tout loop, normal mode, and print selected output. */
  
  for (iout = 1; iout <= NOUT; iout++) {
    
    retval = IDASolve(mem, tout, &tret, cc, cp, IDA_NORMAL);
    if(check_flag(&retval, "IDASolve", 1, thispe)) MPI_Abort(comm, 1);
    
    PrintOutput(mem, cc, tret, webdata, comm);
    
    if (iout < 3) tout *= TMULT; 
    else          tout += TADD;

  }
  
  /* On PE 0, print final set of statistics. */
  
  if (thispe == 0)  PrintFinalStats(mem);

  /* Free memory. */

  N_VDestroy_Parallel(cc);
  N_VDestroy_Parallel(cp);
  N_VDestroy_Parallel(id);

  IDAFree(&mem);

  destroyMat(webdata->acoef);
  N_VDestroy_Parallel(webdata->rates);
  free(webdata);

  MPI_Finalize();

  return(0);
}
Пример #6
0
int main(int argc, char *argv[])
{
  MPI_Comm comm;
  void *mem;
  UserData webdata;
  long int SystemSize, local_N;
  realtype rtol, atol, t0, tout, tret;
  N_Vector cc, cp, res, id;
  int thispe, npes, maxl, iout, flag;

  cc = cp = res = id = NULL;
  webdata = NULL;
  mem = NULL;

  /* Set communicator, and get processor number and total number of PE's. */

  MPI_Init(&argc, &argv);
  comm = MPI_COMM_WORLD;
  MPI_Comm_rank(comm, &thispe);
  MPI_Comm_size(comm, &npes);

  if (npes != NPEX*NPEY) {
    if (thispe == 0)
      fprintf(stderr, 
              "\nMPI_ERROR(0): npes = %d not equal to NPEX*NPEY = %d\n",
	      npes, NPEX*NPEY);
    MPI_Finalize();
    return(1); 
  }

  /* Set local length (local_N) and global length (SystemSize). */

  local_N = MXSUB*MYSUB*NUM_SPECIES;
  SystemSize = NEQ;

  /* Set up user data block webdata. */

  webdata = AllocUserData(comm, local_N, SystemSize);
  if (check_flag((void *)webdata, "AllocUserData", 0, thispe)) MPI_Abort(comm, 1);

  InitUserData(webdata, thispe, npes, comm);
  
  /* Create needed vectors, and load initial values.
     The vector res is used temporarily only.        */

  cc  = N_VNew_Parallel(comm, local_N, SystemSize);
  if (check_flag((void *)cc, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  cp  = N_VNew_Parallel(comm, local_N, SystemSize);
  if (check_flag((void *)cp, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  res = N_VNew_Parallel(comm, local_N, SystemSize);
  if (check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  id  = N_VNew_Parallel(comm, local_N, SystemSize);
  if (check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);
  
  SetInitialProfiles(cc, cp, id, res, webdata);
  
  N_VDestroy(res);

  /* Set remaining inputs to IDAMalloc. */

  t0 = ZERO;
  rtol = RTOL; 
  atol = ATOL;
  
  /* Call IDACreate and IDAMalloc to initialize IDA.
     A pointer to IDA problem memory is returned and stored in idamem. */

  mem = IDACreate();
  if (check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1);

  flag = IDASetUserData(mem, webdata);
  if (check_flag(&flag, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1);

  flag = IDASetId(mem, id);
  if (check_flag(&flag, "IDASetId", 1, thispe)) MPI_Abort(comm, 1);

  flag = IDAInit(mem, resweb, t0, cc, cp);
  if (check_flag(&flag, "IDAinit", 1, thispe)) MPI_Abort(comm, 1);

  flag = IDASStolerances(mem, rtol, atol);
  if (check_flag(&flag, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1);

  webdata->ida_mem = mem;

  /* Call IDASpgmr to specify the IDA linear solver IDASPGMR and specify
     the preconditioner routines supplied (Precondbd and PSolvebd).
     maxl (max. Krylov subspace dim.) is set to 16. */

  maxl = 16;
  flag = IDASpgmr(mem, maxl);
  if (check_flag(&flag, "IDASpgmr", 1, thispe)) 
    MPI_Abort(comm, 1);

  flag = IDASpilsSetPreconditioner(mem, Precondbd, PSolvebd);
  if (check_flag(&flag, "IDASpilsSetPreconditioner", 1, thispe)) 
    MPI_Abort(comm, 1);
  
  /* Call IDACalcIC (with default options) to correct the initial values. */

  tout = RCONST(0.001);
  flag = IDACalcIC(mem, IDA_YA_YDP_INIT, tout);
  if (check_flag(&flag, "IDACalcIC", 1, thispe)) 
    MPI_Abort(comm, 1);

  /* On PE 0, print heading, basic parameters, initial values. */

  if (thispe == 0) PrintHeader(SystemSize, maxl, rtol, atol);
  PrintOutput(mem, cc, t0, webdata, comm);
  
  /* Loop over iout, call IDASolve (normal mode), print selected output. */

  for (iout = 1; iout <= NOUT; iout++) {
    
    flag = IDASolve(mem, tout, &tret, cc, cp, IDA_NORMAL);
    if (check_flag(&flag, "IDASolve", 1, thispe)) MPI_Abort(comm, 1);

    PrintOutput(mem, cc, tret, webdata, comm);
    
    if (iout < 3) tout *= TMULT; 
    else          tout += TADD;
    
  }
  
  /* On PE 0, print final set of statistics. */
  if (thispe == 0) PrintFinalStats(mem);

  /* Free memory. */

  N_VDestroy_Parallel(cc);
  N_VDestroy_Parallel(cp);
  N_VDestroy_Parallel(id);

  IDAFree(&mem);

  FreeUserData(webdata);

  MPI_Finalize();

  return(0);

}
Пример #7
0
int main(int argc, char *argv[])
{
  MPI_Comm comm;
  void *mem;
  UserData data;
  int thispe, iout, ier, npes;
  int Neq, local_N, mudq, mldq, mukeep, mlkeep;
  realtype rtol, atol, t0, t1, tout, tret;
  N_Vector uu, up, constraints, id, res;

  realtype *pbar;
  int is;
  N_Vector *uuS, *upS;
  booleantype sensi, err_con;
  int sensi_meth;

  mem = NULL;
  data = NULL;
  uu = up = constraints = id = res = NULL;
  uuS = upS = NULL;

  /* Get processor number and total number of pe's. */

  MPI_Init(&argc, &argv);
  comm = MPI_COMM_WORLD;
  MPI_Comm_size(comm, &npes);
  MPI_Comm_rank(comm, &thispe);
  
  if (npes != NPEX*NPEY) {
    if (thispe == 0)
      fprintf(stderr, 
              "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n", 
              npes,NPEX*NPEY);
    MPI_Finalize();
    return(1);
  }
  
  /* Process arguments */

  ProcessArgs(argc, argv, thispe, &sensi, &sensi_meth, &err_con);

  /* Set local length local_N and global length Neq. */

  local_N = MXSUB*MYSUB;
  Neq     = MX * MY;

  /* Allocate N-vectors. */

  uu = N_VNew_Parallel(comm, local_N, Neq);
  if(check_flag((void *)uu, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  up = N_VNew_Parallel(comm, local_N, Neq);
  if(check_flag((void *)up, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  res = N_VNew_Parallel(comm, local_N, Neq);
  if(check_flag((void *)res, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  constraints = N_VNew_Parallel(comm, local_N, Neq);
  if(check_flag((void *)constraints, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  id = N_VNew_Parallel(comm, local_N, Neq);
  if(check_flag((void *)id, "N_VNew_Parallel", 0, thispe)) MPI_Abort(comm, 1);

  /* Allocate and initialize the data structure. */

  data = (UserData) malloc(sizeof *data);
  if(check_flag((void *)data, "malloc", 2, thispe)) MPI_Abort(comm, 1);

  InitUserData(thispe, comm, data);

  /* Initialize the uu, up, id, and constraints profiles. */

  SetInitialProfile(uu, up, id, res, data);
  N_VConst(ONE, constraints);

  t0 = ZERO; t1 = RCONST(0.01);

  /* Scalar relative and absolute tolerance. */

  rtol = ZERO;
  atol = RCONST(1.0e-3);

  /* Call IDACreate and IDAInit to initialize solution and various
     IDASet*** functions to specify optional inputs:
     - indicate which variables are differential and which are algebraic
     - exclude algebraic variables from error test
     - specify additional constraints on solution components */

  mem = IDACreate();
  if(check_flag((void *)mem, "IDACreate", 0, thispe)) MPI_Abort(comm, 1);

  ier = IDASetUserData(mem, data);
  if(check_flag(&ier, "IDASetUserData", 1, thispe)) MPI_Abort(comm, 1);

  ier = IDASetSuppressAlg(mem, TRUE);
  if(check_flag(&ier, "IDASetSuppressAlg", 1, thispe)) MPI_Abort(comm, 1);

  ier = IDASetId(mem, id);
  if(check_flag(&ier, "IDASetId", 1, thispe)) MPI_Abort(comm, 1);

  ier = IDASetConstraints(mem, constraints);
  if(check_flag(&ier, "IDASetConstraints", 1, thispe)) MPI_Abort(comm, 1);
  N_VDestroy_Parallel(constraints);

  ier = IDAInit(mem, heatres, t0, uu, up);
  if(check_flag(&ier, "IDAInit", 1, thispe)) MPI_Abort(comm, 1);

  /* Specify state tolerances (scalar relative and absolute tolerances) */

  ier = IDASStolerances(mem, rtol, atol);
  if(check_flag(&ier, "IDASStolerances", 1, thispe)) MPI_Abort(comm, 1);

  /* Call IDASpgmr to specify the linear solver. */

  ier = IDASpgmr(mem, 12);
  if(check_flag(&ier, "IDASpgmr", 1, thispe)) MPI_Abort(comm, 1);
  
  /* Call IDABBDPrecInit to initialize BBD preconditioner. */

  mudq = MXSUB;
  mldq = MXSUB;
  mukeep = 1;
  mlkeep = 1;
  ier = IDABBDPrecInit(mem, local_N, mudq, mldq, mukeep, mlkeep, 
                       ZERO, reslocal, NULL);
  if(check_flag(&ier, "IDABBDPrecInit", 1, thispe)) MPI_Abort(comm, 1);

  /* Sensitivity-related settings */

  if( sensi) {

    /* Allocate and set pbar, the vector with order of magnitude
       information for the problem parameters. (Note: this is 
       done here as an illustration only, as the default values
       for pbar, if pbar is not supplied, are anyway 1.0) */

    pbar = (realtype *) malloc(NS*sizeof(realtype));
    if (check_flag((void *)pbar, "malloc", 2, thispe)) MPI_Abort(comm, 1);
    for (is=0; is<NS; is++) pbar[is] = data->p[is]; 

    /* Allocate sensitivity solution vectors uuS and upS and set them
       to an initial guess for the sensitivity ICs (the IC for uuS are
       0.0 since the state IC do not depend on the porblem parameters;
       however, the derivatives upS may not and therefore we will have
       to call IDACalcIC to find them) */

    uuS = N_VCloneVectorArray_Parallel(NS, uu);
    if (check_flag((void *)uuS, "N_VCloneVectorArray_Parallel", 0, thispe)) MPI_Abort(comm, 1);
    for (is = 0; is < NS; is++)  N_VConst(ZERO,uuS[is]);

    upS = N_VCloneVectorArray_Parallel(NS, uu);
    if (check_flag((void *)upS, "N_VCloneVectorArray_Parallel", 0, thispe)) MPI_Abort(comm, 1);
    for (is = 0; is < NS; is++)  N_VConst(ZERO,upS[is]);

    /* Initialize FSA using the default internal sensitivity residual function
       (Note that this requires specifying the problem parameters -- see below) */

    ier = IDASensInit(mem, NS, sensi_meth, NULL, uuS, upS);
    if(check_flag(&ier, "IDASensInit", 1, thispe)) MPI_Abort(comm, 1);

    /* Indicate the use of internally estimated tolerances for the sensitivity
       variables (based on the tolerances provided for the states and the 
       pbar values) */

    ier = IDASensEEtolerances(mem);
    if(check_flag(&ier, "IDASensEEtolerances", 1, thispe)) MPI_Abort(comm, 1);

    /* Specify whether the sensitivity variables are included in the error
       test or not */

    ier = IDASetSensErrCon(mem, err_con);
    if(check_flag(&ier, "IDASetSensErrCon", 1, thispe)) MPI_Abort(comm, 1);

    /* Specify the problem parameters and their order of magnitude
       (Note that we do not specify the index array plist and therefore
       IDAS will compute sensitivities w.r.t. the first NS parameters) */

    ier = IDASetSensParams(mem, data->p, pbar, NULL);
    if(check_flag(&ier, "IDASetSensParams", 1, thispe)) MPI_Abort(comm, 1);

    /* Compute consistent initial conditions (Note that this is required
       only if performing SA since uu and up already contain consistent 
       initial conditions for the states) */
  
    ier = IDACalcIC(mem, IDA_YA_YDP_INIT, t1);
    if(check_flag(&ier, "IDACalcIC", 1, thispe)) MPI_Abort(comm, 1);

  }

  /* Print problem description */

  if (thispe == 0 ) PrintHeader(Neq, rtol, atol, mudq, mukeep, 
                                sensi, sensi_meth, err_con);

  /* Loop over tout, call IDASolve, print output. */
  for (tout = t1, iout = 1; iout <= NOUT; iout++, tout *= TWO) { 
    
    ier = IDASolve(mem, tout, &tret, uu, up, IDA_NORMAL);
    if(check_flag(&ier, "IDASolve", 1, thispe)) MPI_Abort(comm, 1);

    if (sensi) {
      ier = IDAGetSens(mem, &tret, uuS);
      if(check_flag(&ier, "IDAGetSens", 1, thispe)) MPI_Abort(comm, 1);
    }

    PrintOutput(thispe, mem, tret, uu, sensi, uuS);
    
  }

  /* Print final statistics */

  if (thispe == 0) PrintFinalStats(mem);
  
  /* Free Memory */
  IDAFree(&mem);
  free(data);
  N_VDestroy_Parallel(id);
  N_VDestroy_Parallel(res);
  N_VDestroy_Parallel(up);
  N_VDestroy_Parallel(uu);

  MPI_Finalize();

  return(0);

}
Пример #8
0
CAMLprim value sundials_ml_ida_spmgr(value ida_solver, value maxl) {
  CAMLparam2(ida_solver, maxl);
  const int ret = IDASpgmr(IDA_MEM(ida_solver), Int_val(maxl));
  CAMLreturn(Val_int(ret));
}
Пример #9
0
int main()
{ 
  void *mem;
  UserData webdata;
  N_Vector cc, cp, id;
  int iout, jx, jy, flag;
  long int maxl;
  realtype rtol, atol, t0, tout, tret;

  mem = NULL;
  webdata = NULL;
  cc = cp = id = NULL;

  /* Allocate and initialize user data block webdata. */

  webdata = (UserData) malloc(sizeof *webdata);
  webdata->rates = N_VNew_Serial(NEQ);
  webdata->acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES);
  webdata->ewt = N_VNew_Serial(NEQ);
  for (jx = 0; jx < MX; jx++) {
    for (jy = 0; jy < MY; jy++) {
      (webdata->pivot)[jx][jy] = newLintArray(NUM_SPECIES);
      (webdata->PP)[jx][jy] = newDenseMat(NUM_SPECIES, NUM_SPECIES);
    }
  }

  InitUserData(webdata);

  /* Allocate N-vectors and initialize cc, cp, and id. */

  cc  = N_VNew_Serial(NEQ);
  if(check_flag((void *)cc, "N_VNew_Serial", 0)) return(1);

  cp  = N_VNew_Serial(NEQ);
  if(check_flag((void *)cp, "N_VNew_Serial", 0)) return(1);

  id  = N_VNew_Serial(NEQ);
  if(check_flag((void *)id, "N_VNew_Serial", 0)) return(1);
  
  SetInitialProfiles(cc, cp, id, webdata);
  
  /* Set remaining inputs to IDAMalloc. */
  
  t0 = ZERO;
  rtol = RTOL; 
  atol = ATOL;

  /* Call IDACreate and IDAMalloc to initialize IDA. */
  
  mem = IDACreate();
  if(check_flag((void *)mem, "IDACreate", 0)) return(1);

  flag = IDASetUserData(mem, webdata);
  if(check_flag(&flag, "IDASetUserData", 1)) return(1);

  flag = IDASetId(mem, id);
  if(check_flag(&flag, "IDASetId", 1)) return(1);

  flag = IDAInit(mem, resweb, t0, cc, cp);
  if(check_flag(&flag, "IDAInit", 1)) return(1);

  flag = IDASStolerances(mem, rtol, atol);
  if(check_flag(&flag, "IDASStolerances", 1)) return(1);

  webdata->ida_mem = mem;

  /* Call IDASpgmr to specify the IDA linear solver. */

  maxl = 16;                    /* max dimension of the Krylov subspace */
  flag = IDASpgmr(mem, maxl);
  if(check_flag(&flag, "IDASpgmr", 1)) return(1);

  flag = IDASpilsSetPreconditioner(mem, Precond, PSolve);
  if(check_flag(&flag, "IDASpilsSetPreconditioner", 1)) return(1);

  /* Call IDACalcIC (with default options) to correct the initial values. */

  tout = RCONST(0.001);
  flag = IDACalcIC(mem, IDA_YA_YDP_INIT, tout);
  if(check_flag(&flag, "IDACalcIC", 1)) return(1);
  
  /* Print heading, basic parameters, and initial values. */

  PrintHeader(maxl, rtol, atol);
  PrintOutput(mem, cc, ZERO);
  
  /* Loop over iout, call IDASolve (normal mode), print selected output. */
  
  for (iout = 1; iout <= NOUT; iout++) {
    
    flag = IDASolve(mem, tout, &tret, cc, cp, IDA_NORMAL);
    if(check_flag(&flag, "IDASolve", 1)) return(flag);
    
    PrintOutput(mem, cc, tret);
    
    if (iout < 3) tout *= TMULT; else tout += TADD;
    
  }
  
  /* Print final statistics and free memory. */  
  
  PrintFinalStats(mem);

  /* Free memory */

  IDAFree(&mem);

  N_VDestroy_Serial(cc);
  N_VDestroy_Serial(cp);
  N_VDestroy_Serial(id);


  destroyMat(webdata->acoef);
  N_VDestroy_Serial(webdata->rates);
  N_VDestroy_Serial(webdata->ewt);
  for (jx = 0; jx < MX; jx++) {
    for (jy = 0; jy < MY; jy ++) {
      destroyArray((webdata->pivot)[jx][jy]);
      destroyMat((webdata->PP)[jx][jy]);
    }
  }
  free(webdata);

  return(0);
}