/* Print final statistics contained in iopt */
static void PrintFinalStats(void *arkode_mem)
{
  long int lenrw, leniw ;
  long int lenrwLS, leniwLS;
  long int lenrwBBDP, leniwBBDP, ngevalsBBDP;
  long int nst, nfe, nfi, nsetups, nni, ncfn, netf;
  long int nli, npe, nps, ncfl, nfeLS;
  int flag;

  flag = ARKodeGetWorkSpace(arkode_mem, &lenrw, &leniw);
  check_flag(&flag, "ARKodeGetWorkSpace", 1, 0);
  flag = ARKodeGetNumSteps(arkode_mem, &nst);
  check_flag(&flag, "ARKodeGetNumSteps", 1, 0);
  flag = ARKodeGetNumRhsEvals(arkode_mem, &nfe, &nfi);
  check_flag(&flag, "ARKodeGetNumRhsEvals", 1, 0);
  flag = ARKodeGetNumLinSolvSetups(arkode_mem, &nsetups);
  check_flag(&flag, "ARKodeGetNumLinSolvSetups", 1, 0);
  flag = ARKodeGetNumErrTestFails(arkode_mem, &netf);
  check_flag(&flag, "ARKodeGetNumErrTestFails", 1, 0);
  flag = ARKodeGetNumNonlinSolvIters(arkode_mem, &nni);
  check_flag(&flag, "ARKodeGetNumNonlinSolvIters", 1, 0);
  flag = ARKodeGetNumNonlinSolvConvFails(arkode_mem, &ncfn);
  check_flag(&flag, "ARKodeGetNumNonlinSolvConvFails", 1, 0);

  flag = ARKSpilsGetWorkSpace(arkode_mem, &lenrwLS, &leniwLS);
  check_flag(&flag, "ARKSpilsGetWorkSpace", 1, 0);
  flag = ARKSpilsGetNumLinIters(arkode_mem, &nli);
  check_flag(&flag, "ARKSpilsGetNumLinIters", 1, 0);
  flag = ARKSpilsGetNumPrecEvals(arkode_mem, &npe);
  check_flag(&flag, "ARKSpilsGetNumPrecEvals", 1, 0);
  flag = ARKSpilsGetNumPrecSolves(arkode_mem, &nps);
  check_flag(&flag, "ARKSpilsGetNumPrecSolves", 1, 0);
  flag = ARKSpilsGetNumConvFails(arkode_mem, &ncfl);
  check_flag(&flag, "ARKSpilsGetNumConvFails", 1, 0);
  flag = ARKSpilsGetNumRhsEvals(arkode_mem, &nfeLS);
  check_flag(&flag, "ARKSpilsGetNumRhsEvals", 1, 0);

  printf("\nFinal Statistics: \n\n");
  printf("lenrw   = %5ld     leniw   = %5ld\n", lenrw, leniw);
  printf("lenrwls = %5ld     leniwls = %5ld\n", lenrwLS, leniwLS);
  printf("nst     = %5ld     nfe     = %5ld\n", nst, nfe);
  printf("nfe     = %5ld     nfels   = %5ld\n", nfi, nfeLS);
  printf("nni     = %5ld     nli     = %5ld\n", nni, nli);
  printf("nsetups = %5ld     netf    = %5ld\n", nsetups, netf);
  printf("npe     = %5ld     nps     = %5ld\n", npe, nps);
  printf("ncfn    = %5ld     ncfl    = %5ld\n\n", ncfn, ncfl);

  flag = ARKBBDPrecGetWorkSpace(arkode_mem, &lenrwBBDP, &leniwBBDP);
  check_flag(&flag, "ARKBBDPrecGetWorkSpace", 1, 0);
  flag = ARKBBDPrecGetNumGfnEvals(arkode_mem, &ngevalsBBDP);
  check_flag(&flag, "ARKBBDPrecGetNumGfnEvals", 1, 0);
  printf("In ARKBBDPRE: real/integer local work space sizes = %ld, %ld\n",
	 lenrwBBDP, leniwBBDP);  
  printf("             no. flocal evals. = %ld\n",ngevalsBBDP);
}
Beispiel #2
0
/* Fortran interface to C routine ARKode (the main integrator); 
   see farkode.h for further details */
void FARK_ARKODE(realtype *tout, realtype *t, realtype *y, 
		 int *itask, int *ier) {

  /* attach user solution array to solver memory */
  N_VSetArrayPointer(y, F2C_ARKODE_vec);

  /* call ARKode solver */
  *ier = ARKode(ARK_arkodemem, *tout, F2C_ARKODE_vec, t, *itask);

  /* detach user solution array from solver memory */
  N_VSetArrayPointer(NULL, F2C_ARKODE_vec);

  /* Load optional outputs in iout & rout */
  ARKodeGetWorkSpace(ARK_arkodemem,
		     &ARK_iout[0],          /* LENRW   */
		     &ARK_iout[1]);         /* LENIW   */
  ARKodeGetIntegratorStats(ARK_arkodemem, 
			   &ARK_iout[2],    /* NST     */
			   &ARK_iout[3],    /* NST_STB */
			   &ARK_iout[4],    /* NST_ACC */ 
			   &ARK_iout[5],    /* NST_ATT */ 
			   &ARK_iout[6],    /* NFE     */ 
			   &ARK_iout[7],    /* NFI     */ 
			   &ARK_iout[8],    /* NSETUPS */ 
			   &ARK_iout[9],    /* NETF    */ 
			   &ARK_rout[0],    /* H0U     */
			   &ARK_rout[1],    /* HU      */ 
			   &ARK_rout[2],    /* HCUR    */ 
			   &ARK_rout[3]);   /* TCUR    */ 
  ARKodeGetTolScaleFactor(ARK_arkodemem, 
			  &ARK_rout[4]);    /* TOLSFAC */
  ARKodeGetNonlinSolvStats(ARK_arkodemem,
                          &ARK_iout[10],    /* NNI     */
                          &ARK_iout[11]);   /* NCFN    */
  
  /* If root finding is on, load those outputs as well */
  if (ARK_nrtfn != 0)
    ARKodeGetNumGEvals(ARK_arkodemem, &ARK_iout[12]);  /* NGE */

  /* Attach linear solver outputs */
  switch(ARK_ls) {
  case ARK_LS_DENSE:
  case ARK_LS_BAND:
  case ARK_LS_LAPACKDENSE:
  case ARK_LS_LAPACKBAND:
    ARKDlsGetWorkSpace(ARK_arkodemem, &ARK_iout[13], &ARK_iout[14]);  /* LENRWLS, LENIWLS */
    ARKDlsGetLastFlag(ARK_arkodemem, &ARK_iout[15]);                  /* LSTF  */
    ARKDlsGetNumRhsEvals(ARK_arkodemem, &ARK_iout[16]);               /* NFELS */
    ARKDlsGetNumJacEvals(ARK_arkodemem, &ARK_iout[17]);               /* NJE   */
    break;
  case ARK_LS_KLU:
  case ARK_LS_SUPERLUMT:
    ARKSlsGetLastFlag(ARK_arkodemem, &ARK_iout[15]);                  /* LSTF  */
    ARKSlsGetNumJacEvals(ARK_arkodemem, &ARK_iout[17]);               /* NJE   */
    break;
  case ARK_LS_SPGMR:
  case ARK_LS_SPBCG:
  case ARK_LS_SPTFQMR:
  case ARK_LS_SPFGMR:
  case ARK_LS_PCG:
    ARKSpilsGetWorkSpace(ARK_arkodemem, &ARK_iout[13], &ARK_iout[14]); /* LENRWLS, LENIWLS */
    ARKSpilsGetLastFlag(ARK_arkodemem, &ARK_iout[15]);                 /* LSTF  */
    ARKSpilsGetNumRhsEvals(ARK_arkodemem, &ARK_iout[16]);              /* NFELS */
    ARKSpilsGetNumJtimesEvals(ARK_arkodemem, &ARK_iout[17]);           /* NJTV  */
    ARKSpilsGetNumPrecEvals(ARK_arkodemem, &ARK_iout[18]);             /* NPE   */
    ARKSpilsGetNumPrecSolves(ARK_arkodemem, &ARK_iout[19]);            /* NPS   */
    ARKSpilsGetNumLinIters(ARK_arkodemem, &ARK_iout[20]);              /* NLI   */
    ARKSpilsGetNumConvFails(ARK_arkodemem, &ARK_iout[21]);             /* NCFL  */
  }

  /* Attach mass matrix linear solver outputs */
  switch(ARK_mass_ls) {
  case ARK_LS_DENSE:
  case ARK_LS_BAND:
  case ARK_LS_LAPACKDENSE:
  case ARK_LS_LAPACKBAND:
    ARKDlsGetMassWorkSpace(ARK_arkodemem, &ARK_iout[22], &ARK_iout[23]);  /* LENRWMS, LENIWMS */
    ARKDlsGetLastMassFlag(ARK_arkodemem, &ARK_iout[24]);                  /* LSTMF */
    ARKDlsGetNumMassEvals(ARK_arkodemem, &ARK_iout[25]);                  /* NME   */
    break;
  case ARK_LS_KLU:
  case ARK_LS_SUPERLUMT:
    ARKSlsGetLastMassFlag(ARK_arkodemem, &ARK_iout[24]);                  /* LSTMF */
    ARKSlsGetNumMassEvals(ARK_arkodemem, &ARK_iout[25]);                  /* NME   */
    break;
  case ARK_LS_SPGMR:
  case ARK_LS_SPBCG:
  case ARK_LS_SPTFQMR:
  case ARK_LS_SPFGMR:
  case ARK_LS_PCG:
    ARKSpilsGetMassWorkSpace(ARK_arkodemem, &ARK_iout[22], &ARK_iout[23]); /* LENRWMS, LENIWMS */
    ARKSpilsGetLastMassFlag(ARK_arkodemem, &ARK_iout[24]);                 /* LSTMF */
    ARKSpilsGetNumMassPrecEvals(ARK_arkodemem, &ARK_iout[25]);             /* NMPE  */
    ARKSpilsGetNumMassPrecSolves(ARK_arkodemem, &ARK_iout[26]);            /* NMPS  */
    ARKSpilsGetNumMassIters(ARK_arkodemem, &ARK_iout[27]);                 /* NMLI  */
    ARKSpilsGetNumMassConvFails(ARK_arkodemem, &ARK_iout[28]);             /* NMCFL */
  }
  return;
}
static void PrintFinalStats(void *arkode_mem)
{
  long int lenrw, leniw ;
  long int lenrwLS, leniwLS;
  long int nst, nfe, nfi, nsetups, nni, ncfn, netf;
  long int nli, npe, nps, ncfl, nfeLS;
  int flag;
  realtype avdim;
  
  flag = ARKodeGetWorkSpace(arkode_mem, &lenrw, &leniw);
  check_flag(&flag, "ARKodeGetWorkSpace", 1);
  flag = ARKodeGetNumSteps(arkode_mem, &nst);
  check_flag(&flag, "ARKodeGetNumSteps", 1);
  flag = ARKodeGetNumRhsEvals(arkode_mem, &nfe, &nfi);
  check_flag(&flag, "ARKodeGetNumRhsEvals", 1);
  flag = ARKodeGetNumLinSolvSetups(arkode_mem, &nsetups);
  check_flag(&flag, "ARKodeGetNumLinSolvSetups", 1);
  flag = ARKodeGetNumErrTestFails(arkode_mem, &netf);
  check_flag(&flag, "ARKodeGetNumErrTestFails", 1);
  flag = ARKodeGetNumNonlinSolvIters(arkode_mem, &nni);
  check_flag(&flag, "ARKodeGetNumNonlinSolvIters", 1);
  flag = ARKodeGetNumNonlinSolvConvFails(arkode_mem, &ncfn);
  check_flag(&flag, "ARKodeGetNumNonlinSolvConvFails", 1);

  flag = ARKSpilsGetWorkSpace(arkode_mem, &lenrwLS, &leniwLS);
  check_flag(&flag, "ARKSpilsGetWorkSpace", 1);
  flag = ARKSpilsGetNumLinIters(arkode_mem, &nli);
  check_flag(&flag, "ARKSpilsGetNumLinIters", 1);
  flag = ARKSpilsGetNumPrecEvals(arkode_mem, &npe);
  check_flag(&flag, "ARKSpilsGetNumPrecEvals", 1);
  flag = ARKSpilsGetNumPrecSolves(arkode_mem, &nps);
  check_flag(&flag, "ARKSpilsGetNumPrecSolves", 1);
  flag = ARKSpilsGetNumConvFails(arkode_mem, &ncfl);
  check_flag(&flag, "ARKSpilsGetNumConvFails", 1);
  flag = ARKSpilsGetNumRhsEvals(arkode_mem, &nfeLS);
  check_flag(&flag, "ARKSpilsGetNumRhsEvals", 1);

  printf("\n\n Final statistics for this run:\n\n");
  printf(" ARKode real workspace length           = %4ld \n", lenrw);
  printf(" ARKode integer workspace length        = %4ld \n", leniw);
  printf(" ARKSPGMR real workspace length         = %4ld \n", lenrwLS);
  printf(" ARKSPGMR integer workspace length      = %4ld \n", leniwLS);
  printf(" Number of steps                       = %4ld \n", nst);
  printf(" Number of f-s (explicit)              = %4ld \n", nfe);
  printf(" Number of f-s (implicit)              = %4ld \n", nfi);
  printf(" Number of f-s (SPGMR)                 = %4ld \n", nfeLS);
  printf(" Number of f-s (TOTAL)                 = %4ld \n", nfe + nfeLS);
  printf(" Number of setups                      = %4ld \n", nsetups);
  printf(" Number of nonlinear iterations        = %4ld \n", nni);
  printf(" Number of linear iterations           = %4ld \n", nli);
  printf(" Number of preconditioner evaluations  = %4ld \n", npe);
  printf(" Number of preconditioner solves       = %4ld \n", nps);
  printf(" Number of error test failures         = %4ld \n", netf);
  printf(" Number of nonlinear conv. failures    = %4ld \n", ncfn);
  printf(" Number of linear convergence failures = %4ld \n", ncfl);
  avdim = (nni > 0) ? ((realtype)nli)/((realtype)nni) : ZERO;
#if defined(SUNDIALS_EXTENDED_PRECISION)
  printf(" Average Krylov subspace dimension     = %.3Lf \n", avdim);
#else
  printf(" Average Krylov subspace dimension     = %.3f \n", avdim);
#endif
  printf("\n\n--------------------------------------------------------------");
  printf("--------------\n");
  printf(    "--------------------------------------------------------------");
  printf("--------------\n");
}
Beispiel #4
0
/* Main Program */
int main() {

  /* general problem parameters */
  realtype T0 = RCONST(0.0);   /* initial time */
  realtype Tf = RCONST(1.0);   /* final time */
  realtype rtol = 1.e-3;       /* relative tolerance */
  realtype atol = 1.e-10;      /* absolute tolerance */
  realtype hscale = 1.0;       /* time step change factor on resizes */
  UserData udata = NULL;
  realtype *data;
  long int N = 21;             /* initial spatial mesh size */
  realtype refine = 3.e-3;     /* adaptivity refinement tolerance */
  realtype k = 0.5;            /* heat conductivity */
  long int i, nni, nni_cur=0, nni_tot=0, nli, nli_tot=0;
  int iout=0;

  /* general problem variables */
  int flag;                    /* reusable error-checking flag */
  N_Vector y  = NULL;          /* empty vector for storing solution */
  N_Vector y2 = NULL;          /* empty vector for storing solution */
  N_Vector yt = NULL;          /* empty vector for swapping */
  void *arkode_mem = NULL;     /* empty ARKode memory structure */
  FILE *XFID, *UFID;
  realtype t, olddt, newdt;
  realtype *xnew = NULL;
  long int Nnew;

  /* allocate and fill initial udata structure */
  udata = (UserData) malloc(sizeof(*udata));
  udata->N = N;
  udata->k = k;
  udata->refine_tol = refine;
  udata->x = malloc(N * sizeof(realtype));
  for (i=0; i<N; i++)  udata->x[i] = 1.0*i/(N-1);

  /* Initial problem output */
  printf("\n1D adaptive Heat PDE test problem:\n");
  printf("  diffusion coefficient:  k = %g\n", udata->k);
  printf("  initial N = %li\n", udata->N);

  /* Initialize data structures */
  y = N_VNew_Serial(N);       /* Create initial serial vector for solution */
  if (check_flag((void *) y, "N_VNew_Serial", 0)) return 1;
  N_VConst(0.0, y);           /* Set initial conditions */

  /* output mesh to disk */
  XFID=fopen("heat_mesh.txt","w");

  /* output initial mesh to disk */
  for (i=0; i<udata->N; i++)  fprintf(XFID," %.16e", udata->x[i]);
  fprintf(XFID,"\n");

  /* Open output stream for results, access data array */
  UFID=fopen("heat1D.txt","w");

  /* output initial condition to disk */
  data = N_VGetArrayPointer(y);
  for (i=0; i<udata->N; i++)  fprintf(UFID," %.16e", data[i]);
  fprintf(UFID,"\n");


  /* Create the solver memory */
  arkode_mem = ARKodeCreate();
  if (check_flag((void *) arkode_mem, "ARKodeCreate", 0)) return 1;

  /* Initialize the integrator memory */
  flag = ARKodeInit(arkode_mem, NULL, f, T0, y);
  if (check_flag(&flag, "ARKodeInit", 1)) return 1;

  /* Set routines */
  flag = ARKodeSetUserData(arkode_mem, (void *) udata);   /* Pass udata to user functions */
  if (check_flag(&flag, "ARKodeSetUserData", 1)) return 1;
  flag = ARKodeSetMaxNumSteps(arkode_mem, 10000);         /* Increase max num steps  */
  if (check_flag(&flag, "ARKodeSetMaxNumSteps", 1)) return 1;
  flag = ARKodeSStolerances(arkode_mem, rtol, atol);      /* Specify tolerances */
  if (check_flag(&flag, "ARKodeSStolerances", 1)) return 1;
  flag = ARKodeSetAdaptivityMethod(arkode_mem, 2, 1, 0, NULL);  /* Set adaptivity method */
  if (check_flag(&flag, "ARKodeSetAdaptivityMethod", 1)) return 1;
  flag = ARKodeSetPredictorMethod(arkode_mem, 0);     /* Set predictor method */
  if (check_flag(&flag, "ARKodeSetPredictorMethod", 1)) return 1;

  /* Linear solver specification */
  flag = ARKPcg(arkode_mem, 0, N);
  if (check_flag(&flag, "ARKPcg", 1)) return 1;
  flag = ARKSpilsSetJacTimesVecFn(arkode_mem, Jac);
  if (check_flag(&flag, "ARKSpilsSetJacTimesVecFn", 1)) return 1;

  /* Main time-stepping loop: calls ARKode to perform the integration, then
     prints results.  Stops when the final time has been reached */
  t = T0;
  olddt = 0.0;
  newdt = 0.0;
  printf("  iout          dt_old                 dt_new               ||u||_rms       N   NNI  NLI\n");
  printf(" ----------------------------------------------------------------------------------------\n");
  printf(" %4i  %19.15e  %19.15e  %19.15e  %li   %2i  %3i\n", 
	 iout, olddt, newdt, sqrt(N_VDotProd(y,y)/udata->N), udata->N, 0, 0);
  while (t < Tf) {

    /* "set" routines */
    flag = ARKodeSetStopTime(arkode_mem, Tf);
    if (check_flag(&flag, "ARKodeSetStopTime", 1)) return 1;
    flag = ARKodeSetInitStep(arkode_mem, newdt);
    if (check_flag(&flag, "ARKodeSetInitStep", 1)) return 1;

    /* call integrator */
    flag = ARKode(arkode_mem, Tf, y, &t, ARK_ONE_STEP);
    if (check_flag(&flag, "ARKode", 1)) return 1;

    /* "get" routines */
    flag = ARKodeGetLastStep(arkode_mem, &olddt);
    if (check_flag(&flag, "ARKodeGetLastStep", 1)) return 1;
    flag = ARKodeGetCurrentStep(arkode_mem, &newdt);
    if (check_flag(&flag, "ARKodeGetCurrentStep", 1)) return 1;
    flag = ARKodeGetNumNonlinSolvIters(arkode_mem, &nni);
    if (check_flag(&flag, "ARKodeGetNumNonlinSolvIters", 1)) return 1;
    flag = ARKSpilsGetNumLinIters(arkode_mem, &nli);
    if (check_flag(&flag, "ARKSpilsGetNumLinIters", 1)) return 1;

    /* print current solution stats */
    iout++;
    printf(" %4i  %19.15e  %19.15e  %19.15e  %li   %2li  %3li\n", 
	   iout, olddt, newdt, sqrt(N_VDotProd(y,y)/udata->N), udata->N, nni-nni_cur, nli);
    nni_cur = nni;
    nni_tot = nni;
    nli_tot += nli;

    /* output results and current mesh to disk */
    data = N_VGetArrayPointer(y);
    for (i=0; i<udata->N; i++)  fprintf(UFID," %.16e", data[i]);
    fprintf(UFID,"\n");
    for (i=0; i<udata->N; i++)  fprintf(XFID," %.16e", udata->x[i]);
    fprintf(XFID,"\n");

    /* adapt the spatial mesh */
    xnew = adapt_mesh(y, &Nnew, udata);
    if (check_flag(xnew, "ark_adapt", 0)) return 1;

    /* create N_Vector of new length */
    y2 = N_VNew_Serial(Nnew);
    if (check_flag((void *) y2, "N_VNew_Serial", 0)) return 1;
    
    /* project solution onto new mesh */
    flag = project(udata->N, udata->x, y, Nnew, xnew, y2);
    if (check_flag(&flag, "project", 1)) return 1;

    /* delete old vector, old mesh */
    N_VDestroy_Serial(y);
    free(udata->x);
    
    /* swap x and xnew so that new mesh is stored in udata structure */
    udata->x = xnew;
    xnew = NULL;
    udata->N = Nnew;   /* store size of new mesh */
    
    /* swap y and y2 so that y holds new solution */
    yt = y;
    y  = y2;
    y2 = yt;

    /* call ARKodeResize to notify integrator of change in mesh */
    flag = ARKodeResize(arkode_mem, y, hscale, t, NULL, NULL);
    if (check_flag(&flag, "ARKodeResize", 1)) return 1;

    /* destroy and re-allocate linear solver memory */
    flag = ARKPcg(arkode_mem, 0, udata->N);
    if (check_flag(&flag, "ARKPcg", 1)) return 1;
    flag = ARKSpilsSetJacTimesVecFn(arkode_mem, Jac);
    if (check_flag(&flag, "ARKSpilsSetJacTimesVecFn", 1)) return 1;

  }
  printf(" ----------------------------------------------------------------------------------------\n");

  /* Free integrator memory */
  ARKodeFree(&arkode_mem);

  /* print some final statistics */
  printf(" Final solver statistics:\n");
  printf("   Total number of time steps = %i\n", iout);
  printf("   Total nonlinear iterations = %li\n", nni_tot);
  printf("   Total linear iterations    = %li\n\n", nli_tot);

  /* Clean up and return with successful completion */
  fclose(UFID);
  fclose(XFID);
  N_VDestroy_Serial(y);        /* Free vectors */
  free(udata->x);              /* Free user data */
  free(udata);   

  return 0;
}