Пример #1
0
/***************************** Main Program ******************************/
int main(int argc, char *argv[])
{
  realtype abstol, reltol, t, tout;
  N_Vector u;
  UserData data;
  void *arkode_mem;
  int iout, flag;
  MPI_Comm comm;
  
  HYPRE_Int local_N, npes, my_pe;
  HYPRE_ParVector Upar; /* Declare HYPRE parallel vector */
  HYPRE_IJVector  Uij;  /* Declare "IJ" interface to HYPRE vector */

  u = NULL;
  data = NULL;
  arkode_mem = NULL;

  /* Set problem size neq */
  /* neq = NVARS*MX*MY;   */

  /* 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, &my_pe);

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

  /* Set local length */
  local_N = NVARS*MXSUB*MYSUB;

  /* Allocate hypre vector */
  HYPRE_IJVectorCreate(comm, my_pe*local_N, (my_pe + 1)*local_N - 1, &Uij);
  HYPRE_IJVectorSetObjectType(Uij, HYPRE_PARCSR);
  HYPRE_IJVectorInitialize(Uij);

  /* Allocate and load user data block; allocate preconditioner block */
  data = (UserData) malloc(sizeof *data);
  if (check_flag((void *)data, "malloc", 2, my_pe)) MPI_Abort(comm, 1);
  InitUserData(my_pe, comm, data);

  /* Set initial values and allocate u */ 
  SetInitialProfiles(Uij, data, local_N, my_pe*local_N);
  HYPRE_IJVectorAssemble(Uij);
  HYPRE_IJVectorGetObject(Uij, (void**) &Upar);

  u = N_VMake_ParHyp(Upar);  /* Create wrapper u around hypre vector */
  if (check_flag((void *)u, "N_VNew", 0, my_pe)) MPI_Abort(comm, 1);

  /* Set tolerances */
  abstol = ATOL; reltol = RTOL;

  /* Call ARKodeCreate to create the solver memory */
  arkode_mem = ARKodeCreate();
  if (check_flag((void *)arkode_mem, "ARKodeCreate", 0, my_pe)) MPI_Abort(comm, 1);

  /* Set the pointer to user-defined data */
  flag = ARKodeSetUserData(arkode_mem, data);
  if (check_flag(&flag, "ARKodeSetUserData", 1, my_pe)) MPI_Abort(comm, 1);

  /* Call ARKodeInit to initialize the integrator memory and specify the
     user's right hand side functions in u'=fe(t,u)+fi(t,u) [here fe is NULL], 
     the inital time T0, and the initial dependent variable vector u. */
  flag = ARKodeInit(arkode_mem, NULL, f, T0, u);
  if(check_flag(&flag, "ARKodeInit", 1, my_pe)) return(1);

  /* Call ARKodeSetMaxNumSteps to increase default */
  flag = ARKodeSetMaxNumSteps(arkode_mem, 1000000);
  if (check_flag(&flag, "ARKodeSetMaxNumSteps", 1, my_pe)) return(1);

  /* Call ARKodeSStolerances to specify the scalar relative tolerance
     and scalar absolute tolerances */
  flag = ARKodeSStolerances(arkode_mem, reltol, abstol);
  if (check_flag(&flag, "ARKodeSStolerances", 1, my_pe)) return(1);

  /* Call ARKSpgmr to specify the linear solver ARKSPGMR 
     with left preconditioning and the default Krylov dimension maxl */
  flag = ARKSpgmr(arkode_mem, PREC_LEFT, 0);
  if (check_flag(&flag, "ARKSpgmr", 1, my_pe)) MPI_Abort(comm, 1);

  /* Set preconditioner setup and solve routines Precond and PSolve, 
     and the pointer to the user-defined block data */
  flag = ARKSpilsSetPreconditioner(arkode_mem, Precond, PSolve);
  if (check_flag(&flag, "ARKSpilsSetPreconditioner", 1, my_pe)) MPI_Abort(comm, 1);

  if (my_pe == 0)
    printf("\n2-species diurnal advection-diffusion problem\n\n");

  /* In loop over output points, call ARKode, print results, test for error */
  for (iout=1, tout=TWOHR; iout<=NOUT; iout++, tout+=TWOHR) {
    flag = ARKode(arkode_mem, tout, u, &t, ARK_NORMAL);
    if (check_flag(&flag, "ARKode", 1, my_pe)) break;
    PrintOutput(arkode_mem, my_pe, comm, u, t);
  }

  /* Print final statistics */  
  if (my_pe == 0) PrintFinalStats(arkode_mem);

  /* Free memory */
  N_VDestroy(u);              /* Free hypre vector wrapper */
  HYPRE_IJVectorDestroy(Uij); /* Free the underlying hypre vector */
  FreeUserData(data);
  ARKodeFree(&arkode_mem);
  MPI_Finalize();
  return(0);
}
Пример #2
0
/*---------------------------------------------------------------
 Initialization, Free, and Get Functions
 NOTE: The band linear solver assumes a serial implementation
       of the NVECTOR package. Therefore, ARKBandPrecInit will
       first test for a compatible N_Vector internal 
       representation by checking that the function 
       N_VGetArrayPointer exists.
---------------------------------------------------------------*/
int ARKBandPrecInit(void *arkode_mem, long int N, 
		    long int mu, long int ml)
{
  ARKodeMem ark_mem;
  ARKSpilsMem arkspils_mem;
  ARKBandPrecData pdata;
  long int mup, mlp, storagemu;
  int flag;

  if (arkode_mem == NULL) {
    arkProcessError(NULL, ARKSPILS_MEM_NULL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_NULL);
    return(ARKSPILS_MEM_NULL);
  }
  ark_mem = (ARKodeMem) arkode_mem;

  /* Test if one of the SPILS linear solvers has been attached */
  if (ark_mem->ark_lmem == NULL) {
    arkProcessError(ark_mem, ARKSPILS_LMEM_NULL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_LMEM_NULL);
    return(ARKSPILS_LMEM_NULL);
  }
  arkspils_mem = (ARKSpilsMem) ark_mem->ark_lmem;

  /* Test if the NVECTOR package is compatible with the BAND preconditioner */
  if(ark_mem->ark_tempv->ops->nvgetarraypointer == NULL) {
    arkProcessError(ark_mem, ARKSPILS_ILL_INPUT, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_BAD_NVECTOR);
    return(ARKSPILS_ILL_INPUT);
  }

  pdata = NULL;
  pdata = (ARKBandPrecData) malloc(sizeof *pdata);  /* Allocate data memory */
  if (pdata == NULL) {
    arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_FAIL);
    return(ARKSPILS_MEM_FAIL);
  }

  /* Load pointers and bandwidths into pdata block. */
  pdata->arkode_mem = arkode_mem;
  pdata->N = N;
  pdata->mu = mup = SUNMIN(N-1, SUNMAX(0,mu));
  pdata->ml = mlp = SUNMIN(N-1, SUNMAX(0,ml));

  /* Initialize nfeBP counter */
  pdata->nfeBP = 0;

  /* Allocate memory for saved banded Jacobian approximation. */
  pdata->savedJ = NULL;
  pdata->savedJ = NewBandMat(N, mup, mlp, mup);
  if (pdata->savedJ == NULL) {
    free(pdata); pdata = NULL;
    arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_FAIL);
    return(ARKSPILS_MEM_FAIL);
  }

  /* Allocate memory for banded preconditioner. */
  storagemu = SUNMIN(N-1, mup+mlp);
  pdata->savedP = NULL;
  pdata->savedP = NewBandMat(N, mup, mlp, storagemu);
  if (pdata->savedP == NULL) {
    DestroyMat(pdata->savedJ);
    free(pdata); pdata = NULL;
    arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_FAIL);
    return(ARKSPILS_MEM_FAIL);
  }

  /* Allocate memory for pivot array. */
  pdata->lpivots = NULL;
  pdata->lpivots = NewLintArray(N);
  if (pdata->lpivots == NULL) {
    DestroyMat(pdata->savedP);
    DestroyMat(pdata->savedJ);
    free(pdata); pdata = NULL;
    arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_FAIL);
    return(ARKSPILS_MEM_FAIL);
  }
  
  /* make sure s_P_data is free from any previous allocations */
  if (arkspils_mem->s_pfree != NULL) {
    arkspils_mem->s_pfree(ark_mem);
  }

  /* Point to the new P_data field in the SPILS memory */
  arkspils_mem->s_P_data = pdata;

  /* Attach the pfree function */
  arkspils_mem->s_pfree = ARKBandPrecFree;

  /* Attach preconditioner solve and setup functions */
  flag = ARKSpilsSetPreconditioner(arkode_mem, ARKBandPrecSetup, ARKBandPrecSolve);

  return(flag);
}
Пример #3
0
int main()
{
  realtype abstol=ATOL, reltol=RTOL, t, tout;
  N_Vector c;
  WebData wdata;
  void *arkode_mem;
  booleantype firstrun;
  int jpre, gstype, flag;
  int ns, mxns, iout;

  c = NULL;
  wdata = NULL;
  arkode_mem = NULL;

  /* Initializations */
  c = N_VNew_Serial(NEQ);
  if(check_flag((void *)c, "N_VNew_Serial", 0)) return(1);
  wdata = AllocUserData();
  if(check_flag((void *)wdata, "AllocUserData", 2)) return(1);
  InitUserData(wdata);
  ns = wdata->ns;
  mxns = wdata->mxns;

  /* Print problem description */
  PrintIntro();

  /* Loop over jpre and gstype (four cases) */
  for (jpre = PREC_LEFT; jpre <= PREC_RIGHT; jpre++) {
    for (gstype = MODIFIED_GS; gstype <= CLASSICAL_GS; gstype++) {
      
      /* Initialize c and print heading */
      CInit(c, wdata);
      PrintHeader(jpre, gstype);

      /* Call ARKodeInit or ARKodeReInit, then ARKSpgmr to set up problem */
      
      firstrun = (jpre == PREC_LEFT) && (gstype == MODIFIED_GS);
      if (firstrun) {
        arkode_mem = ARKodeCreate();
        if(check_flag((void *)arkode_mem, "ARKodeCreate", 0)) return(1);

        wdata->arkode_mem = arkode_mem;

        flag = ARKodeSetUserData(arkode_mem, wdata);
        if(check_flag(&flag, "ARKodeSetUserData", 1)) return(1);

        flag = ARKodeInit(arkode_mem, NULL, f, T0, c);
        if(check_flag(&flag, "ARKodeInit", 1)) return(1);

        flag = ARKodeSStolerances(arkode_mem, reltol, abstol);
        if (check_flag(&flag, "ARKodeSStolerances", 1)) return(1);

	flag = ARKodeSetMaxNumSteps(arkode_mem, 1000);
	if (check_flag(&flag, "ARKodeSetMaxNumSteps", 1)) return(1);

	flag = ARKodeSetNonlinConvCoef(arkode_mem, 1.e-3);
	if (check_flag(&flag, "ARKodeSetNonlinConvCoef", 1)) return(1);

        flag = ARKSpgmr(arkode_mem, jpre, MAXL);
        if(check_flag(&flag, "ARKSpgmr", 1)) return(1);

        flag = ARKSpilsSetGSType(arkode_mem, gstype);
        if(check_flag(&flag, "ARKSpilsSetGSType", 1)) return(1);

        flag = ARKSpilsSetEpsLin(arkode_mem, DELT);
        if(check_flag(&flag, "ARKSpilsSetEpsLin", 1)) return(1);

        flag = ARKSpilsSetPreconditioner(arkode_mem, Precond, PSolve);
        if(check_flag(&flag, "ARKSpilsSetPreconditioner", 1)) return(1);

      } else {

        flag = ARKodeReInit(arkode_mem, NULL, f, T0, c);
        if(check_flag(&flag, "ARKodeReInit", 1)) return(1);

        flag = ARKSpilsSetPrecType(arkode_mem, jpre);
        check_flag(&flag, "ARKSpilsSetPrecType", 1);
        flag = ARKSpilsSetGSType(arkode_mem, gstype);
        if(check_flag(&flag, "ARKSpilsSetGSType", 1)) return(1);

      }
      
      /* Print initial values */
      if (firstrun) PrintAllSpecies(c, ns, mxns, T0);
      
      /* Loop over output points, call ARKode, print sample solution values. */
      tout = T1;
      for (iout = 1; iout <= NOUT; iout++) {
        flag = ARKode(arkode_mem, tout, c, &t, ARK_NORMAL);
        PrintOutput(arkode_mem, t);
        if (firstrun && (iout % 3 == 0)) PrintAllSpecies(c, ns, mxns, t);
        if(check_flag(&flag, "ARKode", 1)) break;
        if (tout > RCONST(0.9)) tout += DTOUT; else tout *= TOUT_MULT; 
      }
      
      /* Print final statistics, and loop for next case */
      PrintFinalStats(arkode_mem);
      
    }
  }

  /* Free all memory */
  ARKodeFree(&arkode_mem);
  N_VDestroy_Serial(c);
  FreeUserData(wdata);

  return(0);
}