CAMP 1.0.0
Chemistry Across Multiple Phases
camp_solver.c
Go to the documentation of this file.
1/* Copyright (C) 2021 Barcelona Supercomputing Center and University of
2 * Illinois at Urbana-Champaign
3 * SPDX-License-Identifier: MIT
4 *
5 * This is the c ODE solver for the chemistry module
6 * It is currently set up to use the SUNDIALS BDF method, Newton
7 * iteration with the KLU sparse linear solver.
8 *
9 * It uses a scalar relative tolerance and a vector absolute tolerance.
10 *
11 */
12/** \file
13 * \brief Interface to c solvers for chemistry
14 */
15#include "camp_solver.h"
16#include <math.h>
17#include <stdio.h>
18#include <stdlib.h>
19#include <time.h>
20#include "aero_rep_solver.h"
21#include "rxn_solver.h"
22#include "sub_model_solver.h"
23#ifdef CAMP_USE_GPU
24#include "cuda/camp_gpu_solver.h"
25#endif
26#include "camp_debug.h"
27
28// Default solver initial time step relative to total integration time
29#define DEFAULT_TIME_STEP 1.0
30// State advancement factor for Jacobian element evaluation
31#define JAC_CHECK_ADV_MAX 1.0E-00
32#define JAC_CHECK_ADV_MIN 1.0E-12
33// Set MAX_TIMESTEP_WARNINGS to a negative number to prevent output
34#define MAX_TIMESTEP_WARNINGS -1
35// Maximum number of steps in discreet addition guess helper
36#define GUESS_MAX_ITER 5
37
38// Status codes for calls to camp_solver functions
39#define CAMP_SOLVER_SUCCESS 0
40#define CAMP_SOLVER_FAIL 1
41
42/** \brief Get a new solver object
43 *
44 * Return a pointer to a new SolverData object
45 *
46 * \param n_state_var Number of variables on the state array per grid cell
47 * \param n_cells Number of grid cells to solve simultaneously
48 * \param var_type Pointer to array of state variable types (solver, constant,
49 * PSSA)
50 * \param n_rxn Number of reactions to include
51 * \param n_rxn_int_param Total number of integer reaction parameters
52 * \param n_rxn_float_param Total number of floating-point reaction parameters
53 * \param n_rxn_env_param Total number of environment-dependent reaction
54 * parameters \param n_aero_phase Number of aerosol phases \param
55 * n_aero_phase_int_param Total number of integer aerosol phase parameters
56 * \param n_aero_phase_float_param Total number of floating-point aerosol phase
57 * parameters
58 * \param n_aero_rep Number of aerosol representations
59 * \param n_aero_rep_int_param Total number of integer aerosol representation
60 * parameters
61 * \param n_aero_rep_float_param Total number of floating-point aerosol
62 * representation parameters
63 * \param n_aero_rep_env_param Total number of environment-dependent aerosol
64 * representation parameters
65 * \param n_sub_model Number of sub models
66 * \param n_sub_model_int_param Total number of integer sub model parameters
67 * \param n_sub_model_float_param Total number of floating-point sub model
68 * parameters
69 * \param n_sub_model_env_param Total number of environment-dependent sub model
70 * parameters
71 * \return Pointer to the new SolverData object
72 */
73void *solver_new(int n_state_var, int n_cells, int *var_type, int n_rxn,
74 int n_rxn_int_param, int n_rxn_float_param,
75 int n_rxn_env_param, int n_aero_phase,
76 int n_aero_phase_int_param, int n_aero_phase_float_param,
77 int n_aero_rep, int n_aero_rep_int_param,
78 int n_aero_rep_float_param, int n_aero_rep_env_param,
79 int n_sub_model, int n_sub_model_int_param,
80 int n_sub_model_float_param, int n_sub_model_env_param) {
81 // Create the SolverData object
82 SolverData *sd = (SolverData *)malloc(sizeof(SolverData));
83 if (sd == NULL) {
84 printf("\n\nERROR allocating space for SolverData\n\n");
85 exit(EXIT_FAILURE);
86 }
87
88#ifdef CAMP_USE_SUNDIALS
89#ifdef CAMP_DEBUG
90 // Default to no debugging output
91 sd->debug_out = SUNFALSE;
92
93 // Initialize the Jac solver flag
94 sd->eval_Jac = SUNFALSE;
95#endif
96#endif
97
98 // Do not output precision loss by default
99 sd->output_precision = 0;
100
101 // Use the Jacobian estimated derivative in f() by default
102 sd->use_deriv_est = 1;
103
104 // Save the number of state variables per grid cell
105 sd->model_data.n_per_cell_state_var = n_state_var;
106
107 // Set number of cells to compute simultaneously
108 sd->model_data.n_cells = n_cells;
109
110 // Add the variable types to the solver data
111 sd->model_data.var_type = (int *)malloc(n_state_var * sizeof(int));
112 if (sd->model_data.var_type == NULL) {
113 printf("\n\nERROR allocating space for variable types\n\n");
114 exit(EXIT_FAILURE);
115 }
116 for (int i = 0; i < n_state_var; i++)
117 sd->model_data.var_type[i] = var_type[i];
118
119 // Get the number of solver variables per grid cell
120 int n_dep_var = 0;
121 for (int i = 0; i < n_state_var; i++)
122 if (var_type[i] == CHEM_SPEC_VARIABLE) n_dep_var++;
123
124 // Save the number of solver variables per grid cell
125 sd->model_data.n_per_cell_dep_var = n_dep_var;
126
127#ifdef CAMP_USE_SUNDIALS
128 // Set up a TimeDerivative object to use during solving
129 if (time_derivative_initialize(&(sd->time_deriv), n_dep_var) != 1) {
130 printf("\n\nERROR initializing the TimeDerivative\n\n");
131 exit(EXIT_FAILURE);
132 }
133
134 // Set up the solver variable array and helper derivative array
135 sd->y = N_VNew_Serial(n_dep_var * n_cells);
136 sd->deriv = N_VNew_Serial(n_dep_var * n_cells);
137#endif
138
139 // Allocate space for the reaction data and set the number
140 // of reactions (including one int for the number of reactions
141 // and one int per reaction to store the reaction type)
143 (int *)malloc((n_rxn_int_param + n_rxn) * sizeof(int));
144 if (sd->model_data.rxn_int_data == NULL) {
145 printf("\n\nERROR allocating space for reaction integer data\n\n");
146 exit(EXIT_FAILURE);
147 }
149 (double *)malloc(n_rxn_float_param * sizeof(double));
150 if (sd->model_data.rxn_float_data == NULL) {
151 printf("\n\nERROR allocating space for reaction float data\n\n");
152 exit(EXIT_FAILURE);
153 }
155 (double *)calloc(n_cells * n_rxn_env_param, sizeof(double));
156 if (sd->model_data.rxn_env_data == NULL) {
157 printf(
158 "\n\nERROR allocating space for environment-dependent "
159 "data\n\n");
160 exit(EXIT_FAILURE);
161 }
162
163 // Allocate space for the reaction data pointers
164 sd->model_data.rxn_int_indices = (int *)malloc((n_rxn + 1) * sizeof(int *));
165 if (sd->model_data.rxn_int_indices == NULL) {
166 printf("\n\nERROR allocating space for reaction integer indices\n\n");
167 exit(EXIT_FAILURE);
168 }
169 sd->model_data.rxn_float_indices = (int *)malloc((n_rxn + 1) * sizeof(int *));
170 if (sd->model_data.rxn_float_indices == NULL) {
171 printf("\n\nERROR allocating space for reaction float indices\n\n");
172 exit(EXIT_FAILURE);
173 }
174 sd->model_data.rxn_env_idx = (int *)malloc((n_rxn + 1) * sizeof(int));
175 if (sd->model_data.rxn_env_idx == NULL) {
176 printf(
177 "\n\nERROR allocating space for reaction environment-dependent "
178 "data pointers\n\n");
179 exit(EXIT_FAILURE);
180 }
181
182 sd->model_data.n_rxn = n_rxn;
183 sd->model_data.n_added_rxns = 0;
185 sd->model_data.rxn_int_indices[0] = 0;
186 sd->model_data.rxn_float_indices[0] = 0;
187 sd->model_data.rxn_env_idx[0] = 0;
188
189 // If there are no reactions, flag the solver not to run
190 sd->no_solve = (n_rxn == 0);
191
192 // Allocate space for the aerosol phase data and st the number
193 // of aerosol phases (including one int for the number of
194 // phases)
196 (int *)malloc(n_aero_phase_int_param * sizeof(int));
197 if (sd->model_data.aero_phase_int_data == NULL) {
198 printf("\n\nERROR allocating space for aerosol phase integer data\n\n");
199 exit(EXIT_FAILURE);
200 }
202 (double *)malloc(n_aero_phase_float_param * sizeof(double));
203 if (sd->model_data.aero_phase_float_data == NULL) {
204 printf(
205 "\n\nERROR allocating space for aerosol phase floating-point "
206 "data\n\n");
207 exit(EXIT_FAILURE);
208 }
209
210 // Allocate space for the aerosol phase data pointers
212 (int *)malloc((n_aero_phase + 1) * sizeof(int *));
213 if (sd->model_data.aero_phase_int_indices == NULL) {
214 printf("\n\nERROR allocating space for reaction integer indices\n\n");
215 exit(EXIT_FAILURE);
216 }
218 (int *)malloc((n_aero_phase + 1) * sizeof(int *));
219 if (sd->model_data.aero_phase_float_indices == NULL) {
220 printf("\n\nERROR allocating space for reaction float indices\n\n");
221 exit(EXIT_FAILURE);
222 }
223
224 sd->model_data.n_aero_phase = n_aero_phase;
228
229 // Allocate space for the aerosol representation data and set
230 // the number of aerosol representations (including one int
231 // for the number of aerosol representations and one int per
232 // aerosol representation to store the aerosol representation
233 // type)
235 (int *)malloc((n_aero_rep_int_param + n_aero_rep) * sizeof(int));
236 if (sd->model_data.aero_rep_int_data == NULL) {
237 printf(
238 "\n\nERROR allocating space for aerosol representation integer "
239 "data\n\n");
240 exit(EXIT_FAILURE);
241 }
243 (double *)malloc(n_aero_rep_float_param * sizeof(double));
244 if (sd->model_data.aero_rep_float_data == NULL) {
245 printf(
246 "\n\nERROR allocating space for aerosol representation "
247 "floating-point data\n\n");
248 exit(EXIT_FAILURE);
249 }
251 (double *)calloc(n_cells * n_aero_rep_env_param, sizeof(double));
252 if (sd->model_data.aero_rep_env_data == NULL) {
253 printf(
254 "\n\nERROR allocating space for aerosol representation "
255 "environmental parameters\n\n");
256 exit(EXIT_FAILURE);
257 }
258
259 // Allocate space for the aerosol representation data pointers
261 (int *)malloc((n_aero_rep + 1) * sizeof(int *));
262 if (sd->model_data.aero_rep_int_indices == NULL) {
263 printf("\n\nERROR allocating space for reaction integer indices\n\n");
264 exit(EXIT_FAILURE);
265 }
267 (int *)malloc((n_aero_rep + 1) * sizeof(int *));
268 if (sd->model_data.aero_rep_float_indices == NULL) {
269 printf("\n\nERROR allocating space for reaction float indices\n\n");
270 exit(EXIT_FAILURE);
271 }
273 (int *)malloc((n_aero_rep + 1) * sizeof(int));
274 if (sd->model_data.aero_rep_env_idx == NULL) {
275 printf(
276 "\n\nERROR allocating space for aerosol representation "
277 "environment-dependent data pointers\n\n");
278 exit(EXIT_FAILURE);
279 }
280
281 sd->model_data.n_aero_rep = n_aero_rep;
286 sd->model_data.aero_rep_env_idx[0] = 0;
287
288 // Allocate space for the sub model data and set the number of sub models
289 // (including one int for the number of sub models and one int per sub
290 // model to store the sub model type)
292 (int *)malloc((n_sub_model_int_param + n_sub_model) * sizeof(int));
293 if (sd->model_data.sub_model_int_data == NULL) {
294 printf("\n\nERROR allocating space for sub model integer data\n\n");
295 exit(EXIT_FAILURE);
296 }
298 (double *)malloc(n_sub_model_float_param * sizeof(double));
299 if (sd->model_data.sub_model_float_data == NULL) {
300 printf("\n\nERROR allocating space for sub model floating-point data\n\n");
301 exit(EXIT_FAILURE);
302 }
304 (double *)calloc(n_cells * n_sub_model_env_param, sizeof(double));
305 if (sd->model_data.sub_model_env_data == NULL) {
306 printf(
307 "\n\nERROR allocating space for sub model environment-dependent "
308 "data\n\n");
309 exit(EXIT_FAILURE);
310 }
311
312 // Allocate space for the sub-model data pointers
314 (int *)malloc((n_sub_model + 1) * sizeof(int *));
315 if (sd->model_data.sub_model_int_indices == NULL) {
316 printf("\n\nERROR allocating space for reaction integer indices\n\n");
317 exit(EXIT_FAILURE);
318 }
320 (int *)malloc((n_sub_model + 1) * sizeof(int *));
321 if (sd->model_data.sub_model_float_indices == NULL) {
322 printf("\n\nERROR allocating space for reaction float indices\n\n");
323 exit(EXIT_FAILURE);
324 }
326 (int *)malloc((n_sub_model + 1) * sizeof(int));
327 if (sd->model_data.sub_model_env_idx == NULL) {
328 printf(
329 "\n\nERROR allocating space for sub model environment-dependent "
330 "data pointers\n\n");
331 exit(EXIT_FAILURE);
332 }
333
334 sd->model_data.n_sub_model = n_sub_model;
339 sd->model_data.sub_model_env_idx[0] = 0;
340
341#ifdef CAMP_USE_GPU
342 solver_new_gpu_cu(n_dep_var, n_state_var, n_rxn, n_rxn_int_param,
343 n_rxn_float_param, n_rxn_env_param, n_cells);
344#endif
345
346#ifdef CAMP_DEBUG
347 if (sd->debug_out) print_data_sizes(&(sd->model_data));
348#endif
349
350 // Return a pointer to the new SolverData object
351 return (void *)sd;
352}
353
354/** \brief Solver initialization
355 *
356 * Allocate and initialize solver objects
357 *
358 * \param solver_data Pointer to a SolverData object
359 * \param abs_tol Pointer to array of absolute tolerances
360 * \param rel_tol Relative integration tolerance
361 * \param max_steps Maximum number of internal integration steps
362 * \param max_conv_fails Maximum number of convergence failures
363 */
364void solver_initialize(void *solver_data, double *abs_tol, double rel_tol,
365 int max_steps, int max_conv_fails) {
366#ifdef CAMP_USE_SUNDIALS
367 SolverData *sd; // SolverData object
368 int flag; // return code from SUNDIALS functions
369 int n_dep_var; // number of dependent variables per grid cell
370 int i_dep_var; // index of dependent variables in loops
371 int n_state_var; // number of variables on the state array per
372 // grid cell
373 int n_cells; // number of cells to solve simultaneously
374 int *var_type; // state variable types
375
376 // Seed the random number generator
377 srand((unsigned int)100);
378
379 // Get a pointer to the SolverData
380 sd = (SolverData *)solver_data;
381
382 // Create a new solver object
383 sd->cvode_mem = CVodeCreate(CV_BDF
384#ifndef SUNDIALS_VERSION_MAJOR
385# error SUNDIALS_VERSION_MAJOR not defined
386#elif SUNDIALS_VERSION_MAJOR < 4
387 , CV_NEWTON
388#endif
389 );
390 check_flag_fail((void *)sd->cvode_mem, "CVodeCreate", 0);
391
392 // Get the number of total and dependent variables on the state array,
393 // and the type of each state variable. All values are per-grid-cell.
394 n_state_var = sd->model_data.n_per_cell_state_var;
395 n_dep_var = sd->model_data.n_per_cell_dep_var;
396 var_type = sd->model_data.var_type;
397 n_cells = sd->model_data.n_cells;
398
399 // Set the solver data
400 flag = CVodeSetUserData(sd->cvode_mem, sd);
401 check_flag_fail(&flag, "CVodeSetUserData", 1);
402
403 /* Call CVodeInit to initialize the integrator memory and specify the
404 * right-hand side function in y'=f(t,y), the initial time t0, and
405 * the initial dependent variable vector y. */
406 flag = CVodeInit(sd->cvode_mem, f, (realtype)0.0, sd->y);
407 check_flag_fail(&flag, "CVodeInit", 1);
408
409 // Set the relative and absolute tolerances
410 sd->abs_tol_nv = N_VNew_Serial(n_dep_var * n_cells);
411 i_dep_var = 0;
412 for (int i_cell = 0; i_cell < n_cells; ++i_cell)
413 for (int i_spec = 0; i_spec < n_state_var; ++i_spec)
414 if (var_type[i_spec] == CHEM_SPEC_VARIABLE)
415 NV_Ith_S(sd->abs_tol_nv, i_dep_var++) = (realtype)abs_tol[i_spec];
416 flag = CVodeSVtolerances(sd->cvode_mem, (realtype)rel_tol, sd->abs_tol_nv);
417 check_flag_fail(&flag, "CVodeSVtolerances", 1);
418
419 // Add a pointer in the model data to the absolute tolerances for use during
420 // solving. TODO find a better way to do this
421 sd->model_data.abs_tol = abs_tol;
422
423 // Set the maximum number of iterations
424 flag = CVodeSetMaxNumSteps(sd->cvode_mem, max_steps);
425 check_flag_fail(&flag, "CVodeSetMaxNumSteps", 1);
426
427 // Set the maximum number of convergence failures
428 flag = CVodeSetMaxConvFails(sd->cvode_mem, max_conv_fails);
429 check_flag_fail(&flag, "CVodeSetMaxConvFails", 1);
430
431 // Set the maximum number of error test failures (TODO make separate input?)
432 flag = CVodeSetMaxErrTestFails(sd->cvode_mem, max_conv_fails);
433 check_flag_fail(&flag, "CVodeSetMaxErrTestFails", 1);
434
435 // Set the maximum number of warnings about a too-small time step
436 flag = CVodeSetMaxHnilWarns(sd->cvode_mem, MAX_TIMESTEP_WARNINGS);
437 check_flag_fail(&flag, "CVodeSetMaxHnilWarns", 1);
438
439 // Get the structure of the Jacobian matrix
440 sd->J = get_jac_init(sd);
441 sd->model_data.J_init = SUNMatClone(sd->J);
442 SUNMatCopy(sd->J, sd->model_data.J_init);
443
444 // Create a Jacobian matrix for correcting negative predicted concentrations
445 // during solving
446 sd->J_guess = SUNMatClone(sd->J);
447 SUNMatCopy(sd->J, sd->J_guess);
448
449 // Create a KLU SUNLinearSolver
450 sd->ls = SUNKLU(sd->y, sd->J);
451 check_flag_fail((void *)sd->ls, "SUNKLU", 0);
452
453 // Attach the linear solver and Jacobian to the CVodeMem object
454 flag = CVDlsSetLinearSolver(sd->cvode_mem, sd->ls, sd->J);
455 check_flag_fail(&flag, "CVDlsSetLinearSolver", 1);
456
457 // Set the Jacobian function to Jac
458 flag = CVDlsSetJacFn(sd->cvode_mem, Jac);
459 check_flag_fail(&flag, "CVDlsSetJacFn", 1);
460
461#ifdef CAMP_CUSTOM_CVODE
462 // Set a function to improve guesses for y sent to the linear solver
463 flag = CVodeSetDlsGuessHelper(sd->cvode_mem, guess_helper);
464 check_flag_fail(&flag, "CVodeSetDlsGuessHelper", 1);
465#endif
466
467// Allocate Jacobian on GPU
468#ifdef CAMP_USE_GPU
469 allocate_jac_gpu(sd->model_data.n_per_cell_solver_jac_elem, n_cells);
470#endif
471
472// Set gpu rxn values
473#ifdef CAMP_USE_GPU
474 solver_set_rxn_data_gpu(&(sd->model_data));
475#endif
476
477#ifndef FAILURE_DETAIL
478 // Set a custom error handling function
479 flag = CVodeSetErrHandlerFn(sd->cvode_mem, error_handler, (void *)sd);
480 check_flag_fail(&flag, "CVodeSetErrHandlerFn", 0);
481#endif
482
483#endif
484}
485
486#ifdef CAMP_DEBUG
487/** \brief Set the flag indicating whether to output debugging information
488 *
489 * \param solver_data A pointer to the solver data
490 * \param do_output Whether to output debugging information during solving
491 */
492int solver_set_debug_out(void *solver_data, bool do_output) {
493#ifdef CAMP_USE_SUNDIALS
494 SolverData *sd = (SolverData *)solver_data;
495
496 sd->debug_out = do_output == true ? SUNTRUE : SUNFALSE;
497 return CAMP_SOLVER_SUCCESS;
498#else
499 return 0;
500#endif
501}
502#endif
503
504#ifdef CAMP_DEBUG
505/** \brief Set the flag indicating whether to evalute the Jacobian during
506 ** solving
507 *
508 * \param solver_data A pointer to the solver data
509 * \param eval_Jac Flag indicating whether to evaluate the Jacobian during
510 * solving
511 */
512int solver_set_eval_jac(void *solver_data, bool eval_Jac) {
513#ifdef CAMP_USE_SUNDIALS
514 SolverData *sd = (SolverData *)solver_data;
515
516 sd->eval_Jac = eval_Jac == true ? SUNTRUE : SUNFALSE;
517 return CAMP_SOLVER_SUCCESS;
518#else
519 return 0;
520#endif
521}
522#endif
523
524/** \brief Solve for a given timestep
525 *
526 * \param solver_data A pointer to the initialized solver data
527 * \param state A pointer to the full state array (all grid cells)
528 * \param env A pointer to the full array of environmental conditions
529 * (all grid cells)
530 * \param t_initial Initial time (s)
531 * \param t_final (s)
532 * \return Flag indicating CAMP_SOLVER_SUCCESS or CAMP_SOLVER_FAIL
533 */
534int solver_run(void *solver_data, double *state, double *env, double t_initial,
535 double t_final) {
536#ifdef CAMP_USE_SUNDIALS
537 SolverData *sd = (SolverData *)solver_data;
538 ModelData *md = &(sd->model_data);
539 int n_state_var = sd->model_data.n_per_cell_state_var;
540 int n_cells = sd->model_data.n_cells;
541 int flag;
542
543 // Update the dependent variables
544 int i_dep_var = 0;
545 for (int i_cell = 0; i_cell < n_cells; i_cell++)
546 for (int i_spec = 0; i_spec < n_state_var; i_spec++)
547 if (sd->model_data.var_type[i_spec] == CHEM_SPEC_VARIABLE) {
548 NV_Ith_S(sd->y, i_dep_var++) =
549 state[i_spec + i_cell * n_state_var] > TINY
550 ? (realtype)state[i_spec + i_cell * n_state_var]
551 : TINY;
552 } else if (md->var_type[i_spec] == CHEM_SPEC_CONSTANT) {
553 state[i_spec + i_cell * n_state_var] =
554 state[i_spec + i_cell * n_state_var] > TINY
555 ? state[i_spec + i_cell * n_state_var]
556 : TINY;
557 }
558
559 // Update model data pointers
560 sd->model_data.total_state = state;
561 sd->model_data.total_env = env;
562
563#ifdef CAMP_DEBUG
564 // Update the debug output flag in CVODES and the linear solver
565 flag = CVodeSetDebugOut(sd->cvode_mem, sd->debug_out);
566 check_flag_fail(&flag, "CVodeSetDebugOut", 1);
567 flag = SUNKLUSetDebugOut(sd->ls, sd->debug_out);
568 check_flag_fail(&flag, "SUNKLUSetDebugOut", 1);
569#endif
570
571 // Reset the counter of Jacobian evaluation failures
572 sd->Jac_eval_fails = 0;
573
574 // Update data for new environmental state
575 // (This is set up to assume the environmental variables do not change during
576 // solving. This can be changed in the future if necessary.)
577 for (int i_cell = 0; i_cell < md->n_cells; ++i_cell) {
578 // Set the grid cell state pointers
579 md->grid_cell_id = i_cell;
580 md->grid_cell_state = &(md->total_state[i_cell * md->n_per_cell_state_var]);
581 md->grid_cell_env = &(md->total_env[i_cell * CAMP_NUM_ENV_PARAM_]);
583 &(md->rxn_env_data[i_cell * md->n_rxn_env_data]);
585 &(md->aero_rep_env_data[i_cell * md->n_aero_rep_env_data]);
587 &(md->sub_model_env_data[i_cell * md->n_sub_model_env_data]);
588
589 // Update the model for the current environmental state
593 }
594
595 CAMP_DEBUG_JAC_STRUCT(sd->model_data.J_init, "Begin solving");
596
597 // Reset the flag indicating a current J_guess
598 sd->curr_J_guess = false;
599
600 // Set the initial time step
601 sd->init_time_step = (t_final - t_initial) * DEFAULT_TIME_STEP;
602
603 // Check whether there is anything to solve (filters empty air masses with no
604 // emissions)
605 if (is_anything_going_on_here(sd, t_initial, t_final) == false)
606 return CAMP_SOLVER_SUCCESS;
607
608 // Reinitialize the solver
609 flag = CVodeReInit(sd->cvode_mem, t_initial, sd->y);
610 check_flag_fail(&flag, "CVodeReInit", 1);
611
612 // Reinitialize the linear solver
613 flag = SUNKLUReInit(sd->ls, sd->J, SM_NNZ_S(sd->J), SUNKLU_REINIT_PARTIAL);
614 check_flag_fail(&flag, "SUNKLUReInit", 1);
615
616 // Set the inital time step
617 flag = CVodeSetInitStep(sd->cvode_mem, sd->init_time_step);
618 check_flag_fail(&flag, "CVodeSetInitStep", 1);
619
620 // Run the solver
621 realtype t_rt = (realtype)t_initial;
622 if (!sd->no_solve) {
623 flag = CVode(sd->cvode_mem, (realtype)t_final, sd->y, &t_rt, CV_NORMAL);
624 sd->solver_flag = flag;
625#ifndef FAILURE_DETAIL
626 if (flag < 0) {
627#else
628 if (check_flag(&flag, "CVode", 1) == CAMP_SOLVER_FAIL) {
629 if (flag == -6) {
630 long int lsflag;
631 int lastflag = CVDlsGetLastFlag(sd->cvode_mem, &lsflag);
632 printf("\nLinear Solver Setup Fail: %d %ld", lastflag, lsflag);
633 }
634 N_Vector deriv = N_VClone(sd->y);
635 flag = f(t_initial, sd->y, deriv, sd);
636 if (flag != 0)
637 printf("\nCall to f() at failed state failed with flag %d\n", flag);
638 for (int i_cell = 0; i_cell < md->n_cells; ++i_cell) {
639 printf("\n Cell: %d ", i_cell);
640 printf("temp = %le pressure = %le\n", env[i_cell * CAMP_NUM_ENV_PARAM_],
641 env[i_cell * CAMP_NUM_ENV_PARAM_ + 1]);
642 for (int i_spec = 0, i_dep_var = 0; i_spec < md->n_per_cell_state_var;
643 i_spec++)
644 if (md->var_type[i_spec] == CHEM_SPEC_VARIABLE) {
645 printf(
646 "spec %d = %le deriv = %le\n", i_spec,
647 NV_Ith_S(sd->y, i_cell * md->n_per_cell_dep_var + i_dep_var),
648 NV_Ith_S(deriv, i_cell * md->n_per_cell_dep_var + i_dep_var));
649 i_dep_var++;
650 } else {
651 printf("spec %d = %le\n", i_spec,
652 state[i_cell * md->n_per_cell_state_var + i_spec]);
653 }
654 }
656#endif
657 return CAMP_SOLVER_FAIL;
658 }
659 }
660
661 // Update the species concentrations on the state array
662 i_dep_var = 0;
663 for (int i_cell = 0; i_cell < n_cells; i_cell++) {
664 for (int i_spec = 0; i_spec < n_state_var; i_spec++) {
665 if (md->var_type[i_spec] == CHEM_SPEC_VARIABLE) {
666 state[i_spec + i_cell * n_state_var] =
667 (double)(NV_Ith_S(sd->y, i_dep_var) > 0.0
668 ? NV_Ith_S(sd->y, i_dep_var)
669 : 0.0);
670 i_dep_var++;
671 }
672 }
673 }
674
675 // Re-run the pre-derivative calculations to update equilibrium species
676 // and apply adjustments to final state
678
679 return CAMP_SOLVER_SUCCESS;
680#else
681 return CAMP_SOLVER_FAIL;
682#endif
683}
684
685/** \brief Get solver statistics after an integration attempt
686 *
687 * \param solver_data Pointer to the solver data
688 * \param solver_flag Last flag returned by the solver
689 * \param num_steps Pointer to set to the number of integration
690 * steps
691 * \param RHS_evals Pointer to set to the number of right-hand side
692 * evaluations
693 * \param LS_setups Pointer to set to the number of linear solver
694 * setups
695 * \param error_test_fails Pointer to set to the number of error test
696 * failures
697 * \param NLS_iters Pointer to set to the non-linear solver
698 * iterations
699 * \param NLS_convergence_fails Pointer to set to the non-linear solver
700 * convergence failures
701 * \param DLS_Jac_evals Pointer to set to the direct linear solver
702 * Jacobian evaluations
703 * \param DLS_RHS_evals Pointer to set to the direct linear solver
704 * right-hand side evaluations
705 * \param last_time_step__s Pointer to set to the last time step size [s]
706 * \param next_time_step__s Pointer to set to the next time step size [s]
707 * \param Jac_eval_fails Number of Jacobian evaluation failures
708 * \param RHS_evals_total Total calls to `f()`
709 * \param Jac_evals_total Total calls to `Jac()`
710 * \param RHS_time__s Compute time for calls to f() [s]
711 * \param Jac_time__s Compute time for calls to Jac() [s]
712 * \param max_loss_precision Indicators of loss of precision in derivative
713 * calculation for each species
714 */
715void solver_get_statistics(void *solver_data, int *solver_flag, int *num_steps,
716 int *RHS_evals, int *LS_setups,
717 int *error_test_fails, int *NLS_iters,
718 int *NLS_convergence_fails, int *DLS_Jac_evals,
719 int *DLS_RHS_evals, double *last_time_step__s,
720 double *next_time_step__s, int *Jac_eval_fails,
721 int *RHS_evals_total, int *Jac_evals_total,
722 double *RHS_time__s, double *Jac_time__s,
723 double *max_loss_precision) {
724#ifdef CAMP_USE_SUNDIALS
725 SolverData *sd = (SolverData *)solver_data;
726 long int nst, nfe, nsetups, nje, nfeLS, nni, ncfn, netf, nge;
727 realtype last_h, curr_h;
728 int flag;
729
730 *solver_flag = sd->solver_flag;
731 flag = CVodeGetNumSteps(sd->cvode_mem, &nst);
732 if (check_flag(&flag, "CVodeGetNumSteps", 1) == CAMP_SOLVER_FAIL) return;
733 *num_steps = (int)nst;
734 flag = CVodeGetNumRhsEvals(sd->cvode_mem, &nfe);
735 if (check_flag(&flag, "CVodeGetNumRhsEvals", 1) == CAMP_SOLVER_FAIL) return;
736 *RHS_evals = (int)nfe;
737 flag = CVodeGetNumLinSolvSetups(sd->cvode_mem, &nsetups);
738 if (check_flag(&flag, "CVodeGetNumLinSolveSetups", 1) == CAMP_SOLVER_FAIL)
739 return;
740 *LS_setups = (int)nsetups;
741 flag = CVodeGetNumErrTestFails(sd->cvode_mem, &netf);
742 if (check_flag(&flag, "CVodeGetNumErrTestFails", 1) == CAMP_SOLVER_FAIL)
743 return;
744 *error_test_fails = (int)netf;
745 flag = CVodeGetNumNonlinSolvIters(sd->cvode_mem, &nni);
746 if (check_flag(&flag, "CVodeGetNonlinSolvIters", 1) == CAMP_SOLVER_FAIL)
747 return;
748 *NLS_iters = (int)nni;
749 flag = CVodeGetNumNonlinSolvConvFails(sd->cvode_mem, &ncfn);
750 if (check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1) ==
752 return;
753 *NLS_convergence_fails = ncfn;
754 flag = CVDlsGetNumJacEvals(sd->cvode_mem, &nje);
755 if (check_flag(&flag, "CVDlsGetNumJacEvals", 1) == CAMP_SOLVER_FAIL) return;
756 *DLS_Jac_evals = (int)nje;
757 flag = CVDlsGetNumRhsEvals(sd->cvode_mem, &nfeLS);
758 if (check_flag(&flag, "CVDlsGetNumRhsEvals", 1) == CAMP_SOLVER_FAIL) return;
759 *DLS_RHS_evals = (int)nfeLS;
760 flag = CVodeGetLastStep(sd->cvode_mem, &last_h);
761 if (check_flag(&flag, "CVodeGetLastStep", 1) == CAMP_SOLVER_FAIL) return;
762 *last_time_step__s = (double)last_h;
763 flag = CVodeGetCurrentStep(sd->cvode_mem, &curr_h);
764 if (check_flag(&flag, "CVodeGetCurrentStep", 1) == CAMP_SOLVER_FAIL) return;
765 *next_time_step__s = (double)curr_h;
766 *Jac_eval_fails = sd->Jac_eval_fails;
767#ifdef CAMP_DEBUG
768 *RHS_evals_total = sd->counterDeriv;
769 *Jac_evals_total = sd->counterJac;
770 *RHS_time__s = ((double)sd->timeDeriv) / CLOCKS_PER_SEC;
771 *Jac_time__s = ((double)sd->timeJac) / CLOCKS_PER_SEC;
772 *max_loss_precision = sd->max_loss_precision;
773#else
774 *RHS_evals_total = -1;
775 *Jac_evals_total = -1;
776 *RHS_time__s = 0.0;
777 *Jac_time__s = 0.0;
778 *max_loss_precision = 0.0;
779#endif
780#endif
781}
782
783#ifdef CAMP_USE_SUNDIALS
784
785/** \brief Update the model state from the current solver state
786 *
787 * \param solver_state Solver state vector
788 * \param model_data Pointer to the model data (including the state array)
789 * \param threshhold A lower limit for model concentrations below which the
790 * solver value is replaced with a replacement value
791 * \param replacement_value Replacement value for low concentrations
792 * \return CAMP_SOLVER_SUCCESS for successful update or
793 * CAMP_SOLVER_FAIL for negative concentration
794 */
795int camp_solver_update_model_state(N_Vector solver_state, ModelData *model_data,
796 realtype threshhold,
797 realtype replacement_value) {
798 int n_state_var = model_data->n_per_cell_state_var;
799 int n_dep_var = model_data->n_per_cell_dep_var;
800 int n_cells = model_data->n_cells;
801
802 int i_dep_var = 0;
803 for (int i_cell = 0; i_cell < n_cells; i_cell++) {
804 for (int i_spec = 0; i_spec < n_state_var; ++i_spec) {
805 if (model_data->var_type[i_spec] == CHEM_SPEC_VARIABLE) {
806 if (NV_DATA_S(solver_state)[i_dep_var] < -SMALL) {
807#ifdef FAILURE_DETAIL
808 printf("\nFailed model state update: [spec %d] = %le", i_spec,
809 NV_DATA_S(solver_state)[i_dep_var]);
810#endif
811 return CAMP_SOLVER_FAIL;
812 }
813 // Assign model state to solver_state
814 model_data->total_state[i_spec + i_cell * n_state_var] =
815 NV_DATA_S(solver_state)[i_dep_var] > threshhold
816 ? NV_DATA_S(solver_state)[i_dep_var]
817 : replacement_value;
818 i_dep_var++;
819 }
820 }
821 }
822 return CAMP_SOLVER_SUCCESS;
823}
824
825/** \brief Compute the time derivative f(t,y)
826 *
827 * \param t Current model time (s)
828 * \param y Dependent variable array
829 * \param deriv Time derivative vector f(t,y) to calculate
830 * \param solver_data Pointer to the solver data
831 * \return Status code
832 */
833int f(realtype t, N_Vector y, N_Vector deriv, void *solver_data) {
834 SolverData *sd = (SolverData *)solver_data;
835 ModelData *md = &(sd->model_data);
836 realtype time_step;
837
838#ifdef CAMP_DEBUG
839 sd->counterDeriv++;
840#endif
841
842 // Get a pointer to the derivative data
843 double *deriv_data = N_VGetArrayPointer(deriv);
844
845 // Get a pointer to the Jacobian estimated derivative data
846 double *jac_deriv_data = N_VGetArrayPointer(md->J_tmp);
847
848 // Get the grid cell dimensions
849 int n_cells = md->n_cells;
850 int n_state_var = md->n_per_cell_state_var;
851 int n_dep_var = md->n_per_cell_dep_var;
852
853 // Get the current integrator time step (s)
854 CVodeGetCurrentStep(sd->cvode_mem, &time_step);
855
856 // On the first call to f(), the time step hasn't been set yet, so use the
857 // default value
858 time_step = time_step > ZERO ? time_step : sd->init_time_step;
859
860 // Update the state array with the current dependent variable values.
861 // Signal a recoverable error (positive return value) for negative
862 // concentrations.
864 return 1;
865
866 // Get the Jacobian-estimated derivative
867 N_VLinearSum(1.0, y, -1.0, md->J_state, md->J_tmp);
868 SUNMatMatvec(md->J_solver, md->J_tmp, md->J_tmp2);
869 N_VLinearSum(1.0, md->J_deriv, 1.0, md->J_tmp2, md->J_tmp);
870
871#ifdef CAMP_DEBUG
872 // Measure calc_deriv time execution
873 clock_t start = clock();
874#endif
875
876#ifdef CAMP_USE_GPU
877 // Reset the derivative vector
878 N_VConst(ZERO, deriv);
879
880 // Calculate the time derivative f(t,y)
881 // (this is for all grid cells at once)
882 rxn_calc_deriv_gpu(md, deriv, (double)time_step);
883#endif
884
885#ifdef CAMP_DEBUG
886 clock_t end = clock();
887 sd->timeDeriv += (end - start);
888#endif
889
890 // Loop through the grid cells and update the derivative array
891 for (int i_cell = 0; i_cell < n_cells; ++i_cell) {
892 // Set the grid cell state pointers
893 md->grid_cell_id = i_cell;
894 md->grid_cell_state = &(md->total_state[i_cell * n_state_var]);
895 md->grid_cell_env = &(md->total_env[i_cell * CAMP_NUM_ENV_PARAM_]);
897 &(md->rxn_env_data[i_cell * md->n_rxn_env_data]);
899 &(md->aero_rep_env_data[i_cell * md->n_aero_rep_env_data]);
901 &(md->sub_model_env_data[i_cell * md->n_sub_model_env_data]);
902
903 // Update the aerosol representations
905
906 // Run the sub models
908
909#ifdef CAMP_DEBUG
910 // Measure calc_deriv time execution
911 clock_t start2 = clock();
912#endif
913
914#ifndef CAMP_USE_GPU
915 // Reset the TimeDerivative
917
918 // Calculate the time derivative f(t,y)
919 rxn_calc_deriv(md, sd->time_deriv, (double)time_step);
920
921 // Update the deriv array
922 if (sd->use_deriv_est == 1) {
923 time_derivative_output(sd->time_deriv, deriv_data, jac_deriv_data,
924 sd->output_precision);
925 } else {
926 time_derivative_output(sd->time_deriv, deriv_data, NULL,
927 sd->output_precision);
928 }
929#else
930 // Add contributions from reactions not implemented on GPU
931 // FIXME need to fix this to use TimeDerivative
932 rxn_calc_deriv_specific_types(md, sd->time_deriv, (double)time_step);
933#endif
934
935#ifdef CAMP_DEBUG
936 clock_t end2 = clock();
937 sd->timeDeriv += (end2 - start2);
938 sd->max_loss_precision = time_derivative_max_loss_precision(sd->time_deriv);
939#endif
940
941 // Advance the derivative for the next cell
942 deriv_data += n_dep_var;
943 jac_deriv_data += n_dep_var;
944 }
945
946 // Return 0 if success
947 return (0);
948}
949
950/** \brief Compute the Jacobian
951 *
952 * \param t Current model time (s)
953 * \param y Dependent variable array
954 * \param deriv Time derivative vector f(t,y)
955 * \param J Jacobian to calculate
956 * \param solver_data Pointer to the solver data
957 * \param tmp1 Unused vector
958 * \param tmp2 Unused vector
959 * \param tmp3 Unused vector
960 * \return Status code
961 */
962int Jac(realtype t, N_Vector y, N_Vector deriv, SUNMatrix J, void *solver_data,
963 N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) {
964 SolverData *sd = (SolverData *)solver_data;
965 ModelData *md = &(sd->model_data);
966 realtype time_step;
967
968#ifdef CAMP_DEBUG
969 sd->counterJac++;
970#endif
971
972 // Get the grid cell dimensions
973 int n_state_var = md->n_per_cell_state_var;
974 int n_dep_var = md->n_per_cell_dep_var;
975 int n_cells = md->n_cells;
976
977 // Get pointers to the rxn and parameter Jacobian arrays
978 double *J_param_data = SM_DATA_S(md->J_params);
979 double *J_rxn_data = SM_DATA_S(md->J_rxn);
980 // Initialize the sparse matrix (sized for one grid cell)
981 // solver_data->model_data.J_rxn =
982 // SUNSparseMatrix(n_state_var, n_state_var, n_jac_elem_rxn, CSC_MAT);
983
984 // TODO: use this instead of saving all this jacs
985 // double J_rxn_data[md->n_per_cell_dep_var];
986 // memset(J_rxn_data, 0, md->n_per_cell_dep_var * sizeof(double));
987
988 // double *J_rxn_data = (double*)calloc(md->n_per_cell_state_var,
989 // sizeof(double));
990
991 // !!!! Do not use tmp2 - it is the same as y !!!! //
992 // FIXME Find out why cvode is sending tmp2 as y
993
994 // Calculate the the derivative for the current state y without
995 // the estimated derivative from the last Jacobian calculation
996 sd->use_deriv_est = 0;
997 if (f(t, y, deriv, solver_data) != 0) {
998 printf("\n Derivative calculation failed.\n");
999 sd->use_deriv_est = 1;
1000 return 1;
1001 }
1002 sd->use_deriv_est = 1;
1003
1004 // Update the state array with the current dependent variable values
1005 // Signal a recoverable error (positive return value) for negative
1006 // concentrations.
1008 return 1;
1009
1010 // Get the current integrator time step (s)
1011 CVodeGetCurrentStep(sd->cvode_mem, &time_step);
1012
1013 // Reset the primary Jacobian
1014 /// \todo #83 Figure out how to stop CVODE from resizing the Jacobian
1015 /// during solving
1016 SM_NNZ_S(J) = SM_NNZ_S(md->J_init);
1017 for (int i = 0; i <= SM_NP_S(J); i++) {
1018 (SM_INDEXPTRS_S(J))[i] = (SM_INDEXPTRS_S(md->J_init))[i];
1019 }
1020 for (int i = 0; i < SM_NNZ_S(J); i++) {
1021 (SM_INDEXVALS_S(J))[i] = (SM_INDEXVALS_S(md->J_init))[i];
1022 (SM_DATA_S(J))[i] = (realtype)0.0;
1023 }
1024
1025#ifdef CAMP_DEBUG
1026 clock_t start2 = clock();
1027#endif
1028
1029#ifdef CAMP_USE_GPU
1030 // Calculate the Jacobian
1031 rxn_calc_jac_gpu(md, J, time_step);
1032#endif
1033
1034#ifdef CAMP_DEBUG
1035 clock_t end2 = clock();
1036 sd->timeJac += (end2 - start2);
1037#endif
1038
1039 // Solving on CPU only
1040
1041 // Loop over the grid cells to calculate sub-model and rxn Jacobians
1042 for (int i_cell = 0; i_cell < n_cells; ++i_cell) {
1043 // Set the grid cell state pointers
1044 md->grid_cell_id = i_cell;
1045 md->grid_cell_state = &(md->total_state[i_cell * n_state_var]);
1046 md->grid_cell_env = &(md->total_env[i_cell * CAMP_NUM_ENV_PARAM_]);
1048 &(md->rxn_env_data[i_cell * md->n_rxn_env_data]);
1050 &(md->aero_rep_env_data[i_cell * md->n_aero_rep_env_data]);
1052 &(md->sub_model_env_data[i_cell * md->n_sub_model_env_data]);
1053
1054 // Reset the sub-model and reaction Jacobians
1055 for (int i = 0; i < SM_NNZ_S(md->J_params); ++i)
1056 SM_DATA_S(md->J_params)[i] = 0.0;
1057 jacobian_reset(sd->jac);
1058
1059 // Update the aerosol representations
1061
1062 // Run the sub models and get the sub-model Jacobian
1064 sub_model_get_jac_contrib(md, J_param_data, time_step);
1065 CAMP_DEBUG_JAC(md->J_params, "sub-model Jacobian");
1066
1067#ifdef CAMP_DEBUG
1068 clock_t start = clock();
1069#endif
1070
1071#ifndef CAMP_USE_GPU
1072 // Calculate the reaction Jacobian
1073 rxn_calc_jac(md, sd->jac, time_step);
1074#else
1075 // Add contributions from reactions not implemented on GPU
1076 rxn_calc_jac_specific_types(md, sd->jac, time_step);
1077#endif
1078
1079// rxn_calc_jac_specific_types(md, J_rxn_data, time_step);
1080#ifdef CAMP_DEBUG
1081 clock_t end = clock();
1082 sd->timeJac += (end - start);
1083#endif
1084
1085 // Output the Jacobian to the SUNDIALS J_rxn
1086 jacobian_output(sd->jac, SM_DATA_S(md->J_rxn));
1087 CAMP_DEBUG_JAC(md->J_rxn, "reaction Jacobian");
1088
1089 // Set the solver Jacobian using the reaction and sub-model Jacobians
1090 JacMap *jac_map = md->jac_map;
1091 SM_DATA_S(md->J_params)[0] = 1.0; // dummy value for non-sub model calcs
1092 for (int i_map = 0; i_map < md->n_mapped_values; ++i_map)
1093 SM_DATA_S(J)
1094 [i_cell * md->n_per_cell_solver_jac_elem + jac_map[i_map].solver_id] +=
1095 SM_DATA_S(md->J_rxn)[jac_map[i_map].rxn_id] *
1096 SM_DATA_S(md->J_params)[jac_map[i_map].param_id];
1097 CAMP_DEBUG_JAC(J, "solver Jacobian");
1098 }
1099
1100 // Save the Jacobian for use with derivative calculations
1101 for (int i_elem = 0; i_elem < SM_NNZ_S(J); ++i_elem)
1102 SM_DATA_S(md->J_solver)[i_elem] = SM_DATA_S(J)[i_elem];
1103 N_VScale(1.0, y, md->J_state);
1104 N_VScale(1.0, deriv, md->J_deriv);
1105
1106#ifdef CAMP_DEBUG
1107 // Evaluate the Jacobian if flagged to do so
1108 if (sd->eval_Jac == SUNTRUE) {
1109 if (!check_Jac(t, y, J, deriv, tmp1, tmp3, solver_data)) {
1110 ++(sd->Jac_eval_fails);
1111 }
1112 }
1113#endif
1114
1115 return (0);
1116}
1117
1118/** \brief Check a Jacobian for accuracy
1119 *
1120 * This function compares Jacobian elements against differences in derivative
1121 * calculations for small changes to the state array:
1122 * \f[
1123 * J_{ij}(x) = \frac{f_i(x+\sum_j e_j) - f_i(x)}{\epsilon}
1124 * \f]
1125 * where \f$\epsilon_j = 10^{-8} \left|x_j\right|\f$
1126 *
1127 * \param t Current time [s]
1128 * \param y Current state array
1129 * \param J Jacobian matrix to evaluate
1130 * \param deriv Current derivative \f$f(y)\f$
1131 * \param tmp Working array the size of \f$y\f$
1132 * \param tmp1 Working array the size of \f$y\f$
1133 * \param solver_data Solver data
1134 * \return True if Jacobian values are accurate, false otherwise
1135 */
1136bool check_Jac(realtype t, N_Vector y, SUNMatrix J, N_Vector deriv,
1137 N_Vector tmp, N_Vector tmp1, void *solver_data) {
1138 realtype *d_state = NV_DATA_S(y);
1139 realtype *d_deriv = NV_DATA_S(deriv);
1140 bool retval = true;
1141
1142 // Calculate the the derivative for the current state y
1143 if (f(t, y, deriv, solver_data) != 0) {
1144 printf("\n Derivative calculation failed.\n");
1145 return false;
1146 }
1147
1148 return retval;
1149}
1150
1151/** \brief Try to improve guesses of y sent to the linear solver
1152 *
1153 * This function checks if there are any negative guessed concentrations,
1154 * and if there are it calculates a set of initial corrections to the
1155 * guessed state using the state at time \f$t_{n-1}\f$ and the derivative
1156 * \f$f_{n-1}\f$ and advancing the state according to:
1157 * \f[
1158 * y_n = y_{n-1} + \sum_{j=1}^m h_j * f_j
1159 * \f]
1160 * where \f$h_j\f$ is the largest timestep possible where
1161 * \f[
1162 * y_{j-1} + h_j * f_j > 0
1163 * \f]
1164 * and
1165 * \f[
1166 * t_n = t_{n-1} + \sum_{j=1}^m h_j
1167 * \f]
1168 *
1169 * \param t_n Current time [s]
1170 * \param h_n Current time step size [s] If this is set to zero, the change hf
1171 * is assumed to be an adjustment where y_n = y_n1 + hf
1172 * \param y_n Current guess for \f$y(t_n)\f$
1173 * \param y_n1 \f$y(t_{n-1})\f$
1174 * \param hf Current guess for change in \f$y\f$ from \f$t_{n-1}\f$ to
1175 * \f$t_n\f$ [input/output]
1176 * \param solver_data Solver data
1177 * \param tmp1 Temporary vector for calculations
1178 * \param corr Vector of calculated adjustments to \f$y(t_n)\f$ [output]
1179 * \return 1 if corrections were calculated, 0 if not
1180 */
1181#ifdef CAMP_CUSTOM_CVODE
1182int guess_helper(const realtype t_n, const realtype h_n, N_Vector y_n,
1183 N_Vector y_n1, N_Vector hf, void *solver_data, N_Vector tmp1,
1184 N_Vector corr) {
1185 SolverData *sd = (SolverData *)solver_data;
1186 realtype *ay_n = NV_DATA_S(y_n);
1187 realtype *ay_n1 = NV_DATA_S(y_n1);
1188 realtype *atmp1 = NV_DATA_S(tmp1);
1189 realtype *acorr = NV_DATA_S(corr);
1190 realtype *ahf = NV_DATA_S(hf);
1191 int n_elem = NV_LENGTH_S(y_n);
1192
1193 // Only try improvements when negative concentrations are predicted
1194 if (N_VMin(y_n) > -SMALL) return 0;
1195
1196 CAMP_DEBUG_PRINT_FULL("Trying to improve guess");
1197
1198 // Copy \f$y(t_{n-1})\f$ to working array
1199 N_VScale(ONE, y_n1, tmp1);
1200
1201 // Get \f$f(t_{n-1})\f$
1202 if (h_n > ZERO) {
1203 N_VScale(ONE / h_n, hf, corr);
1204 } else {
1205 N_VScale(ONE, hf, corr);
1206 }
1207 CAMP_DEBUG_PRINT("Got f0");
1208
1209 // Advance state interatively
1210 realtype t_0 = h_n > ZERO ? t_n - h_n : t_n - ONE;
1211 realtype t_j = ZERO;
1212 int iter = 0;
1213 for (; iter < GUESS_MAX_ITER && t_0 + t_j < t_n; iter++) {
1214 // Calculate \f$h_j\f$
1215 realtype h_j = t_n - (t_0 + t_j);
1216 int i_fast = -1;
1217 for (int i = 0; i < n_elem; i++) {
1218 realtype t_star = -atmp1[i] / acorr[i];
1219 if ((t_star > ZERO || (t_star == ZERO && acorr[i] < ZERO)) &&
1220 t_star < h_j) {
1221 h_j = t_star;
1222 i_fast = i;
1223 }
1224 }
1225
1226 // Scale incomplete jumps
1227 if (i_fast >= 0 && h_n > ZERO)
1228 h_j *= 0.95 + 0.1 * iter / (double)GUESS_MAX_ITER;
1229 h_j = t_n < t_0 + t_j + h_j ? t_n - (t_0 + t_j) : h_j;
1230
1231 // Only make small changes to adjustment vectors used in Newton iteration
1232 if (h_n == ZERO &&
1233 t_n - (h_j + t_j + t_0) > ((CVodeMem)sd->cvode_mem)->cv_reltol)
1234 return -1;
1235
1236 // Advance the state
1237 N_VLinearSum(ONE, tmp1, h_j, corr, tmp1);
1238 CAMP_DEBUG_PRINT_FULL("Advanced state");
1239
1240 // Advance t_j
1241 t_j += h_j;
1242
1243 // Recalculate the time derivative \f$f(t_j)\f$
1244 if (f(t_0 + t_j, tmp1, corr, solver_data) != 0) {
1245 CAMP_DEBUG_PRINT("Unexpected failure in guess helper!");
1246 N_VConst(ZERO, corr);
1247 return -1;
1248 }
1249 ((CVodeMem)sd->cvode_mem)->cv_nfe++;
1250
1251 if (iter == GUESS_MAX_ITER - 1 && t_0 + t_j < t_n) {
1252 CAMP_DEBUG_PRINT("Max guess iterations reached!");
1253 if (h_n == ZERO) return -1;
1254 }
1255 }
1256
1257 CAMP_DEBUG_PRINT_INT("Guessed y_h in steps:", iter);
1258
1259 // Set the correction vector
1260 N_VLinearSum(ONE, tmp1, -ONE, y_n, corr);
1261
1262 // Scale the initial corrections
1263 if (h_n > ZERO) N_VScale(0.999, corr, corr);
1264
1265 // Update the hf vector
1266 N_VLinearSum(ONE, tmp1, -ONE, y_n1, hf);
1267
1268 return 1;
1269}
1270#endif
1271
1272/** \brief Create a sparse Jacobian matrix based on model data
1273 *
1274 * \param solver_data A pointer to the SolverData
1275 * \return Sparse Jacobian matrix with all possible non-zero elements intialize
1276 * to 1.0
1277 */
1278SUNMatrix get_jac_init(SolverData *solver_data) {
1279 int n_rxn; /* number of reactions in the mechanism
1280 * (stored in first position in *rxn_data) */
1281 sunindextype n_jac_elem_rxn; /* number of potentially non-zero Jacobian
1282 elements in the reaction matrix*/
1283 sunindextype n_jac_elem_param; /* number of potentially non-zero Jacobian
1284 elements in the reaction matrix*/
1285 sunindextype n_jac_elem_solver; /* number of potentially non-zero Jacobian
1286 elements in the reaction matrix*/
1287 // Number of grid cells
1288 int n_cells = solver_data->model_data.n_cells;
1289
1290 // Number of variables on the state array per grid cell
1291 // (these are the ids the reactions are initialized with)
1292 int n_state_var = solver_data->model_data.n_per_cell_state_var;
1293
1294 // Number of total state variables
1295 int n_state_var_total = n_state_var * n_cells;
1296
1297 // Number of solver variables per grid cell (excludes constants, parameters,
1298 // etc.)
1299 int n_dep_var = solver_data->model_data.n_per_cell_dep_var;
1300
1301 // Number of total solver variables
1302 int n_dep_var_total = n_dep_var * n_cells;
1303
1304 // Initialize the Jacobian for reactions
1305 if (jacobian_initialize_empty(&(solver_data->jac),
1306 (unsigned int)n_state_var) != 1) {
1307 printf("\n\nERROR allocating Jacobian structure\n\n");
1308 exit(EXIT_FAILURE);
1309 }
1310
1311 // Add diagonal elements by default
1312 for (unsigned int i_spec = 0; i_spec < n_state_var; ++i_spec) {
1313 jacobian_register_element(&(solver_data->jac), i_spec, i_spec);
1314 }
1315
1316 // Fill in the 2D array of flags with Jacobian elements used by the
1317 // mechanism reactions for a single grid cell
1318 rxn_get_used_jac_elem(&(solver_data->model_data), &(solver_data->jac));
1319
1320 // Build the sparse Jacobian
1321 if (jacobian_build_matrix(&(solver_data->jac)) != 1) {
1322 printf("\n\nERROR building sparse full-state Jacobian\n\n");
1323 exit(EXIT_FAILURE);
1324 }
1325
1326 // Determine the number of non-zero Jacobian elements per grid cell
1327 n_jac_elem_rxn = jacobian_number_of_elements(solver_data->jac);
1328
1329 // Save number of reaction jacobian elements per grid cell
1330 solver_data->model_data.n_per_cell_rxn_jac_elem = (int)n_jac_elem_rxn;
1331
1332 // Initialize the sparse matrix (sized for one grid cell)
1333 solver_data->model_data.J_rxn =
1334 SUNSparseMatrix(n_state_var, n_state_var, n_jac_elem_rxn, CSC_MAT);
1335
1336 // Set the column and row indices
1337 for (unsigned int i_col = 0; i_col <= n_state_var; ++i_col) {
1338 (SM_INDEXPTRS_S(solver_data->model_data.J_rxn))[i_col] =
1339 jacobian_column_pointer_value(solver_data->jac, i_col);
1340 }
1341 for (unsigned int i_elem = 0; i_elem < n_jac_elem_rxn; ++i_elem) {
1342 (SM_DATA_S(solver_data->model_data.J_rxn))[i_elem] = (realtype)0.0;
1343 (SM_INDEXVALS_S(solver_data->model_data.J_rxn))[i_elem] =
1344 jacobian_row_index(solver_data->jac, i_elem);
1345 }
1346
1347 // Build the set of time derivative ids
1348 int *deriv_ids = (int *)malloc(sizeof(int) * n_state_var);
1349
1350 if (deriv_ids == NULL) {
1351 printf("\n\nERROR allocating space for derivative ids\n\n");
1352 exit(EXIT_FAILURE);
1353 }
1354 int i_dep_var = 0;
1355 for (int i_spec = 0; i_spec < n_state_var; i_spec++) {
1356 if (solver_data->model_data.var_type[i_spec] == CHEM_SPEC_VARIABLE) {
1357 deriv_ids[i_spec] = i_dep_var++;
1358 } else {
1359 deriv_ids[i_spec] = -1;
1360 }
1361 }
1362
1363 // Update the ids in the reaction data
1364 rxn_update_ids(&(solver_data->model_data), deriv_ids, solver_data->jac);
1365
1366 ////////////////////////////////////////////////////////////////////////
1367 // Get the Jacobian elements used in sub model parameter calculations //
1368 ////////////////////////////////////////////////////////////////////////
1369
1370 // Initialize the Jacobian for sub-model parameters
1371 Jacobian param_jac;
1372 if (jacobian_initialize_empty(&param_jac, (unsigned int)n_state_var) != 1) {
1373 printf("\n\nERROR allocating sub-model Jacobian structure\n\n");
1374 exit(EXIT_FAILURE);
1375 }
1376
1377 // Set up a dummy element at the first position
1378 jacobian_register_element(&param_jac, 0, 0);
1379
1380 // Fill in the 2D array of flags with Jacobian elements used by the
1381 // mechanism sub models
1382 sub_model_get_used_jac_elem(&(solver_data->model_data), &param_jac);
1383
1384 // Build the sparse Jacobian for sub-model parameters
1385 if (jacobian_build_matrix(&param_jac) != 1) {
1386 printf("\n\nERROR building sparse Jacobian for sub-model parameters\n\n");
1387 exit(EXIT_FAILURE);
1388 }
1389
1390 // Save the number of sub model Jacobian elements per grid cell
1391 n_jac_elem_param = jacobian_number_of_elements(param_jac);
1392 solver_data->model_data.n_per_cell_param_jac_elem = (int)n_jac_elem_param;
1393
1394 // Set up the parameter Jacobian (sized for one grid cell)
1395 // Initialize the sparse matrix with one extra element (at the first position)
1396 // for use in mapping that is set to 1.0. (This is safe because there can be
1397 // no elements on the diagonal in the sub model Jacobian.)
1398 solver_data->model_data.J_params =
1399 SUNSparseMatrix(n_state_var, n_state_var, n_jac_elem_param, CSC_MAT);
1400
1401 // Set the column and row indices
1402 for (unsigned int i_col = 0; i_col <= n_state_var; ++i_col) {
1403 (SM_INDEXPTRS_S(solver_data->model_data.J_params))[i_col] =
1404 jacobian_column_pointer_value(param_jac, i_col);
1405 }
1406 for (unsigned int i_elem = 0; i_elem < n_jac_elem_param; ++i_elem) {
1407 (SM_DATA_S(solver_data->model_data.J_params))[i_elem] = (realtype)0.0;
1408 (SM_INDEXVALS_S(solver_data->model_data.J_params))[i_elem] =
1409 jacobian_row_index(param_jac, i_elem);
1410 }
1411
1412 // Update the ids in the sub model data
1413 sub_model_update_ids(&(solver_data->model_data), deriv_ids, param_jac);
1414
1415 ////////////////////////////////
1416 // Set up the solver Jacobian //
1417 ////////////////////////////////
1418
1419 // Initialize the Jacobian for sub-model parameters
1420 Jacobian solver_jac;
1421 if (jacobian_initialize_empty(&solver_jac, (unsigned int)n_state_var) != 1) {
1422 printf("\n\nERROR allocating solver Jacobian structure\n\n");
1423 exit(EXIT_FAILURE);
1424 }
1425
1426 // Determine the structure of the solver Jacobian and number of mapped values
1427 int n_mapped_values = 0;
1428 for (int i_ind = 0; i_ind < n_state_var; ++i_ind) {
1429 for (int i_dep = 0; i_dep < n_state_var; ++i_dep) {
1430 // skip dependent species that are not solver variables and
1431 // depenedent species that aren't used by any reaction
1432 if (solver_data->model_data.var_type[i_dep] != CHEM_SPEC_VARIABLE ||
1433 jacobian_get_element_id(solver_data->jac, i_dep, i_ind) == -1)
1434 continue;
1435 // If both elements are variable, use the rxn Jacobian only
1436 if (solver_data->model_data.var_type[i_ind] == CHEM_SPEC_VARIABLE &&
1437 solver_data->model_data.var_type[i_dep] == CHEM_SPEC_VARIABLE) {
1438 jacobian_register_element(&solver_jac, i_dep, i_ind);
1439 ++n_mapped_values;
1440 continue;
1441 }
1442 // Check the sub model Jacobian for remaining conditions
1443 /// \todo Make the Jacobian mapping recursive for sub model parameters
1444 /// that depend on other sub model parameters
1445 for (int j_ind = 0; j_ind < n_state_var; ++j_ind) {
1446 if (jacobian_get_element_id(param_jac, i_ind, j_ind) != -1 &&
1447 solver_data->model_data.var_type[j_ind] == CHEM_SPEC_VARIABLE) {
1448 jacobian_register_element(&solver_jac, i_dep, j_ind);
1449 ++n_mapped_values;
1450 }
1451 }
1452 }
1453 }
1454
1455 // Build the sparse solver Jacobian
1456 if (jacobian_build_matrix(&solver_jac) != 1) {
1457 printf("\n\nERROR building sparse Jacobian for the solver\n\n");
1458 exit(EXIT_FAILURE);
1459 }
1460
1461 // Save the number of non-zero Jacobian elements
1462 n_jac_elem_solver = jacobian_number_of_elements(solver_jac);
1463 solver_data->model_data.n_per_cell_solver_jac_elem = (int)n_jac_elem_solver;
1464
1465 // Initialize the sparse matrix (for solver state array including all cells)
1466 SUNMatrix M = SUNSparseMatrix(n_dep_var_total, n_dep_var_total,
1467 n_jac_elem_solver * n_cells, CSC_MAT);
1468 solver_data->model_data.J_solver = SUNSparseMatrix(
1469 n_dep_var_total, n_dep_var_total, n_jac_elem_solver * n_cells, CSC_MAT);
1470
1471 // Set the column and row indices
1472 for (unsigned int i_cell = 0; i_cell < n_cells; ++i_cell) {
1473 for (unsigned int cell_col = 0; cell_col < n_state_var; ++cell_col) {
1474 if (deriv_ids[cell_col] == -1) continue;
1475 unsigned int i_col = deriv_ids[cell_col] + i_cell * n_dep_var;
1476 (SM_INDEXPTRS_S(M))[i_col] =
1477 (SM_INDEXPTRS_S(solver_data->model_data.J_solver))[i_col] =
1478 jacobian_column_pointer_value(solver_jac, cell_col) +
1479 i_cell * n_jac_elem_solver;
1480 }
1481 for (unsigned int cell_elem = 0; cell_elem < n_jac_elem_solver;
1482 ++cell_elem) {
1483 unsigned int i_elem = cell_elem + i_cell * n_jac_elem_solver;
1484 (SM_DATA_S(M))[i_elem] =
1485 (SM_DATA_S(solver_data->model_data.J_solver))[i_elem] = (realtype)0.0;
1486 (SM_INDEXVALS_S(M))[i_elem] =
1487 (SM_INDEXVALS_S(solver_data->model_data.J_solver))[i_elem] =
1488 deriv_ids[jacobian_row_index(solver_jac, cell_elem)] +
1489 i_cell * n_dep_var;
1490 }
1491 }
1492 (SM_INDEXPTRS_S(M))[n_cells * n_dep_var] =
1493 (SM_INDEXPTRS_S(solver_data->model_data.J_solver))[n_cells * n_dep_var] =
1494 n_cells * n_jac_elem_solver;
1495
1496 // Allocate space for the map
1497 solver_data->model_data.n_mapped_values = n_mapped_values;
1498 solver_data->model_data.jac_map =
1499 (JacMap *)malloc(sizeof(JacMap) * n_mapped_values);
1500 if (solver_data->model_data.jac_map == NULL) {
1501 printf("\n\nERROR allocating space for jacobian map\n\n");
1502 exit(EXIT_FAILURE);
1503 }
1504 JacMap *map = solver_data->model_data.jac_map;
1505
1506 // Set map indices (when no sub-model value is used, the param_id is
1507 // set to 0 which maps to a fixed value of 1.0
1508 int i_mapped_value = 0;
1509 for (unsigned int i_ind = 0; i_ind < n_state_var; ++i_ind) {
1510 for (unsigned int i_elem =
1511 jacobian_column_pointer_value(solver_data->jac, i_ind);
1512 i_elem < jacobian_column_pointer_value(solver_data->jac, i_ind + 1);
1513 ++i_elem) {
1514 unsigned int i_dep = jacobian_row_index(solver_data->jac, i_elem);
1515 // skip dependent species that are not solver variables and
1516 // depenedent species that aren't used by any reaction
1517 if (solver_data->model_data.var_type[i_dep] != CHEM_SPEC_VARIABLE ||
1518 jacobian_get_element_id(solver_data->jac, i_dep, i_ind) == -1)
1519 continue;
1520 // If both elements are variable, use the rxn Jacobian only
1521 if (solver_data->model_data.var_type[i_ind] == CHEM_SPEC_VARIABLE &&
1522 solver_data->model_data.var_type[i_dep] == CHEM_SPEC_VARIABLE) {
1523 map[i_mapped_value].solver_id =
1524 jacobian_get_element_id(solver_jac, i_dep, i_ind);
1525 map[i_mapped_value].rxn_id = i_elem;
1526 map[i_mapped_value].param_id = 0;
1527 ++i_mapped_value;
1528 continue;
1529 }
1530 // Check the sub model Jacobian for remaining conditions
1531 // (variable dependent species; independent parameter from sub model)
1532 for (int j_ind = 0; j_ind < n_state_var; ++j_ind) {
1533 if (jacobian_get_element_id(param_jac, i_ind, j_ind) != -1 &&
1534 solver_data->model_data.var_type[j_ind] == CHEM_SPEC_VARIABLE) {
1535 map[i_mapped_value].solver_id =
1536 jacobian_get_element_id(solver_jac, i_dep, j_ind);
1537 map[i_mapped_value].rxn_id = i_elem;
1538 map[i_mapped_value].param_id =
1539 jacobian_get_element_id(param_jac, i_ind, j_ind);
1540 ++i_mapped_value;
1541 }
1542 }
1543 }
1544 }
1545
1546 SolverData *sd = solver_data;
1547 CAMP_DEBUG_JAC_STRUCT(sd->model_data.J_params, "Param struct");
1548 CAMP_DEBUG_JAC_STRUCT(sd->model_data.J_rxn, "Reaction struct");
1549 CAMP_DEBUG_JAC_STRUCT(M, "Solver struct");
1550
1551 if (i_mapped_value != n_mapped_values) {
1552 printf("[ERROR-340355266] Internal error");
1553 exit(EXIT_FAILURE);
1554 }
1555
1556 // Create vectors to store Jacobian state and derivative data
1557 solver_data->model_data.J_state = N_VClone(solver_data->y);
1558 solver_data->model_data.J_deriv = N_VClone(solver_data->y);
1559 solver_data->model_data.J_tmp = N_VClone(solver_data->y);
1560 solver_data->model_data.J_tmp2 = N_VClone(solver_data->y);
1561
1562 // Initialize the Jacobian state and derivative arrays to zero
1563 // for use before the first call to Jac()
1564 N_VConst(0.0, solver_data->model_data.J_state);
1565 N_VConst(0.0, solver_data->model_data.J_deriv);
1566
1567 // Free the memory used
1568 jacobian_free(&param_jac);
1569 jacobian_free(&solver_jac);
1570 free(deriv_ids);
1571
1572 return M;
1573}
1574
1575/** \brief Check the return value of a SUNDIALS function
1576 *
1577 * \param flag_value A pointer to check (either for NULL, or as an int pointer
1578 * giving the flag value
1579 * \param func_name A string giving the function name returning this result code
1580 * \param opt A flag indicating the type of check to perform (0 for NULL
1581 * pointer check; 1 for integer flag check)
1582 * \return Flag indicating CAMP_SOLVER_SUCCESS or CAMP_SOLVER_FAIL
1583 */
1584int check_flag(void *flag_value, char *func_name, int opt) {
1585 int *err_flag;
1586
1587 /* Check for a NULL pointer */
1588 if (opt == 0 && flag_value == NULL) {
1589 fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed - returned NULL pointer\n\n",
1590 func_name);
1591 return CAMP_SOLVER_FAIL;
1592 }
1593
1594 /* Check if flag < 0 */
1595 else if (opt == 1) {
1596 err_flag = (int *)flag_value;
1597 if (*err_flag < 0) {
1598 fprintf(stderr, "\nSUNDIALS_ERROR: %s() failed with flag = %d\n\n",
1599 func_name, *err_flag);
1600 return CAMP_SOLVER_FAIL;
1601 }
1602 }
1603 return CAMP_SOLVER_SUCCESS;
1604}
1605
1606/** \brief Check the return value of a SUNDIALS function and exit on failure
1607 *
1608 * \param flag_value A pointer to check (either for NULL, or as an int pointer
1609 * giving the flag value
1610 * \param func_name A string giving the function name returning this result code
1611 * \param opt A flag indicating the type of check to perform (0 for NULL
1612 * pointer check; 1 for integer flag check)
1613 */
1614void check_flag_fail(void *flag_value, char *func_name, int opt) {
1615 if (check_flag(flag_value, func_name, opt) == CAMP_SOLVER_FAIL) {
1616 exit(EXIT_FAILURE);
1617 }
1618}
1619
1620/** \brief Reset the timers for solver functions
1621 *
1622 * \param solver_data Pointer to the SolverData object with timers to reset
1623 */
1624#ifdef CAMP_USE_SUNDIALS
1625void solver_reset_timers(void *solver_data) {
1626 SolverData *sd = (SolverData *)solver_data;
1627
1628#ifdef CAMP_DEBUG
1629 sd->counterDeriv = 0;
1630 sd->counterJac = 0;
1631 sd->timeDeriv = 0;
1632 sd->timeJac = 0;
1633#endif
1634}
1635#endif
1636
1637/** \brief Print solver statistics
1638 *
1639 * \param cvode_mem Solver object
1640 */
1641static void solver_print_stats(void *cvode_mem) {
1642 long int nst, nfe, nsetups, nje, nfeLS, nni, ncfn, netf, nge;
1643 realtype last_h, curr_h;
1644 int flag;
1645
1646 flag = CVodeGetNumSteps(cvode_mem, &nst);
1647 if (check_flag(&flag, "CVodeGetNumSteps", 1) == CAMP_SOLVER_FAIL) return;
1648 flag = CVodeGetNumRhsEvals(cvode_mem, &nfe);
1649 if (check_flag(&flag, "CVodeGetNumRhsEvals", 1) == CAMP_SOLVER_FAIL) return;
1650 flag = CVodeGetNumLinSolvSetups(cvode_mem, &nsetups);
1651 if (check_flag(&flag, "CVodeGetNumLinSolveSetups", 1) == CAMP_SOLVER_FAIL)
1652 return;
1653 flag = CVodeGetNumErrTestFails(cvode_mem, &netf);
1654 if (check_flag(&flag, "CVodeGetNumErrTestFails", 1) == CAMP_SOLVER_FAIL)
1655 return;
1656 flag = CVodeGetNumNonlinSolvIters(cvode_mem, &nni);
1657 if (check_flag(&flag, "CVodeGetNonlinSolvIters", 1) == CAMP_SOLVER_FAIL)
1658 return;
1659 flag = CVodeGetNumNonlinSolvConvFails(cvode_mem, &ncfn);
1660 if (check_flag(&flag, "CVodeGetNumNonlinSolvConvFails", 1) ==
1662 return;
1663 flag = CVDlsGetNumJacEvals(cvode_mem, &nje);
1664 if (check_flag(&flag, "CVDlsGetNumJacEvals", 1) == CAMP_SOLVER_FAIL) return;
1665 flag = CVDlsGetNumRhsEvals(cvode_mem, &nfeLS);
1666 if (check_flag(&flag, "CVDlsGetNumRhsEvals", 1) == CAMP_SOLVER_FAIL) return;
1667 flag = CVodeGetNumGEvals(cvode_mem, &nge);
1668 if (check_flag(&flag, "CVodeGetNumGEvals", 1) == CAMP_SOLVER_FAIL) return;
1669 flag = CVodeGetLastStep(cvode_mem, &last_h);
1670 if (check_flag(&flag, "CVodeGetLastStep", 1) == CAMP_SOLVER_FAIL) return;
1671 flag = CVodeGetCurrentStep(cvode_mem, &curr_h);
1672 if (check_flag(&flag, "CVodeGetCurrentStep", 1) == CAMP_SOLVER_FAIL) return;
1673
1674 printf("\nSUNDIALS Solver Statistics:\n");
1675 printf("number of steps = %-6ld RHS evals = %-6ld LS setups = %-6ld\n", nst,
1676 nfe, nsetups);
1677 printf("error test fails = %-6ld LS iters = %-6ld NLS iters = %-6ld\n", netf,
1678 nni, ncfn);
1679 printf(
1680 "NL conv fails = %-6ld Dls Jac evals = %-6ld Dls RHS evals = %-6ld G "
1681 "evals ="
1682 " %-6ld\n",
1683 ncfn, nje, nfeLS, nge);
1684 printf("Last time step = %le Next time step = %le\n", last_h, curr_h);
1685}
1686
1687#endif // CAMP_USE_SUNDIALS
1688
1689/** \brief Free a SolverData object
1690 *
1691 * \param solver_data Pointer to the SolverData object to free
1692 */
1693void solver_free(void *solver_data) {
1694 SolverData *sd = (SolverData *)solver_data;
1695
1696#ifdef CAMP_USE_SUNDIALS
1697 // free the SUNDIALS solver
1698 CVodeFree(&(sd->cvode_mem));
1699
1700 // free the absolute tolerance vector
1701 N_VDestroy(sd->abs_tol_nv);
1702
1703 // free the TimeDerivative
1705
1706 // free the Jacobian
1707 jacobian_free(&(sd->jac));
1708
1709 // free the derivative vectors
1710 N_VDestroy(sd->y);
1711 N_VDestroy(sd->deriv);
1712
1713 // destroy the Jacobian marix
1714 SUNMatDestroy(sd->J);
1715
1716 // destroy Jacobian matrix for guessing state
1717 SUNMatDestroy(sd->J_guess);
1718
1719 // free the linear solver
1720 SUNLinSolFree(sd->ls);
1721#endif
1722
1723 // Free the allocated ModelData
1725
1726 // free the SolverData object
1727 free(sd);
1728}
1729
1730#ifdef CAMP_USE_SUNDIALS
1731/** \brief Determine if there is anything to solve
1732 *
1733 * If the solver state concentrations and the derivative vector are very small,
1734 * there is no point running the solver
1735 */
1736bool is_anything_going_on_here(SolverData *sd, realtype t_initial,
1737 realtype t_final) {
1738 ModelData *md = &(sd->model_data);
1739
1740 if (f(t_initial, sd->y, sd->deriv, sd)) {
1741 int i_dep_var = 0;
1742 for (int i_cell = 0; i_cell < md->n_cells; ++i_cell) {
1743 for (int i_spec = 0; i_spec < md->n_per_cell_state_var; ++i_spec) {
1744 if (md->var_type[i_spec] == CHEM_SPEC_VARIABLE) {
1745 if (NV_Ith_S(sd->y, i_dep_var) >
1746 NV_Ith_S(sd->abs_tol_nv, i_dep_var) * 1.0e-10)
1747 return true;
1748 if (NV_Ith_S(sd->deriv, i_dep_var) * (t_final - t_initial) >
1749 NV_Ith_S(sd->abs_tol_nv, i_dep_var) * 1.0e-10)
1750 return true;
1751 i_dep_var++;
1752 }
1753 }
1754 }
1755 return false;
1756 }
1757
1758 return true;
1759}
1760#endif
1761
1762/** \brief Custom error handling function
1763 *
1764 * This is used for quiet operation. Solver failures are returned with a flag
1765 * from the solver_run() function.
1766 */
1767void error_handler(int error_code, const char *module, const char *function,
1768 char *msg, void *sd) {
1769 // Do nothing
1770}
1771
1772/** \brief Free a ModelData object
1773 *
1774 * \param model_data Pointer to the ModelData object to free
1775 */
1776void model_free(ModelData model_data) {
1777#ifdef CAMP_USE_GPU
1778 // free_gpu_cu();
1779#endif
1780
1781#ifdef CAMP_USE_SUNDIALS
1782 // Destroy the initialized Jacbobian matrix
1783 SUNMatDestroy(model_data.J_init);
1784 SUNMatDestroy(model_data.J_rxn);
1785 SUNMatDestroy(model_data.J_params);
1786 SUNMatDestroy(model_data.J_solver);
1787 N_VDestroy(model_data.J_state);
1788 N_VDestroy(model_data.J_deriv);
1789 N_VDestroy(model_data.J_tmp);
1790 N_VDestroy(model_data.J_tmp2);
1791#endif
1792 free(model_data.jac_map);
1793 free(model_data.jac_map_params);
1794 free(model_data.var_type);
1795 free(model_data.rxn_int_data);
1796 free(model_data.rxn_float_data);
1797 free(model_data.rxn_env_data);
1798 free(model_data.rxn_int_indices);
1799 free(model_data.rxn_float_indices);
1800 free(model_data.rxn_env_idx);
1801 free(model_data.aero_phase_int_data);
1802 free(model_data.aero_phase_float_data);
1803 free(model_data.aero_phase_int_indices);
1804 free(model_data.aero_phase_float_indices);
1805 free(model_data.aero_rep_int_data);
1806 free(model_data.aero_rep_float_data);
1807 free(model_data.aero_rep_env_data);
1808 free(model_data.aero_rep_int_indices);
1809 free(model_data.aero_rep_float_indices);
1810 free(model_data.aero_rep_env_idx);
1811 free(model_data.sub_model_int_data);
1812 free(model_data.sub_model_float_data);
1813 free(model_data.sub_model_env_data);
1814 free(model_data.sub_model_int_indices);
1815 free(model_data.sub_model_float_indices);
1816 free(model_data.sub_model_env_idx);
1817}
1818
1819/** \brief Free update data
1820 *
1821 * \param update_data Object to free
1822 */
1823void solver_free_update_data(void *update_data) { free(update_data); }
unsigned int jacobian_column_pointer_value(Jacobian jac, unsigned int col_id)
Returns the value of a column pointer.
Definition Jacobian.c:192
void jacobian_free(Jacobian *jac)
Free memory associated with a Jacobian.
Definition Jacobian.c:281
unsigned int jacobian_build_matrix(Jacobian *jac)
Builds the sparse matrix with the registered elements.
Definition Jacobian.c:129
int jacobian_initialize_empty(Jacobian *jac, unsigned int num_spec)
Initialize the Jacobian.
Definition Jacobian.c:20
unsigned int jacobian_number_of_elements(Jacobian jac)
Returns the number of elements in the Jacobian.
Definition Jacobian.c:190
unsigned int jacobian_get_element_id(Jacobian jac, unsigned int dep_id, unsigned int ind_id)
Get an element id in the Jacobian data arrays.
Definition Jacobian.c:200
void jacobian_reset(Jacobian jac)
Reset the Jacobian.
Definition Jacobian.c:216
void jacobian_register_element(Jacobian *jac, unsigned int dep_id, unsigned int ind_id)
Adds an element to the sparse matrix.
Definition Jacobian.c:105
void jacobian_output(Jacobian jac, double *dest_array)
Output the Jacobian.
Definition Jacobian.c:223
unsigned int jacobian_row_index(Jacobian jac, unsigned int elem_id)
Returns the row for a given Jacobian element.
Definition Jacobian.c:196
#define CHEM_SPEC_VARIABLE
#define CHEM_SPEC_CONSTANT
void aero_rep_update_env_state(ModelData *model_data)
Update the aerosol representations for new environmental conditions.
void aero_rep_update_state(ModelData *model_data)
Update the aerosol representations for a new state.
Header file for abstract aerosol representation functions.
#define SMALL
Definition camp_common.h:45
#define ONE
Definition camp_common.h:43
#define CAMP_NUM_ENV_PARAM_
Definition camp_common.h:52
#define ZERO
Definition camp_common.h:42
#define TINY
Definition camp_common.h:46
#define CAMP_DEBUG_PRINT(x)
Definition camp_debug.h:121
#define CAMP_DEBUG_JAC(J, x)
Definition camp_debug.h:125
#define CAMP_DEBUG_JAC_STRUCT(J, x)
Definition camp_debug.h:124
static void print_data_sizes(ModelData *md)
Print some camp-chem data sizes.
Definition camp_debug.h:132
#define CAMP_DEBUG_PRINT_INT(x, y)
Definition camp_debug.h:122
#define CAMP_DEBUG_PRINT_FULL(x)
Definition camp_debug.h:123
void model_free(ModelData model_data)
Free a ModelData object.
int check_flag(void *flag_value, char *func_name, int opt)
Check the return value of a SUNDIALS function.
void solver_get_statistics(void *solver_data, int *solver_flag, int *num_steps, int *RHS_evals, int *LS_setups, int *error_test_fails, int *NLS_iters, int *NLS_convergence_fails, int *DLS_Jac_evals, int *DLS_RHS_evals, double *last_time_step__s, double *next_time_step__s, int *Jac_eval_fails, int *RHS_evals_total, int *Jac_evals_total, double *RHS_time__s, double *Jac_time__s, double *max_loss_precision)
Get solver statistics after an integration attempt.
int Jac(realtype t, N_Vector y, N_Vector deriv, SUNMatrix J, void *solver_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
Compute the Jacobian.
int camp_solver_update_model_state(N_Vector solver_state, ModelData *model_data, realtype threshhold, realtype replacement_value)
Update the model state from the current solver state.
#define CAMP_SOLVER_FAIL
Definition camp_solver.c:40
#define GUESS_MAX_ITER
Definition camp_solver.c:36
#define MAX_TIMESTEP_WARNINGS
Definition camp_solver.c:34
bool is_anything_going_on_here(SolverData *sd, realtype t_initial, realtype t_final)
Determine if there is anything to solve.
void solver_initialize(void *solver_data, double *abs_tol, double rel_tol, int max_steps, int max_conv_fails)
Solver initialization.
SUNMatrix get_jac_init(SolverData *solver_data)
Try to improve guesses of y sent to the linear solver.
void * solver_new(int n_state_var, int n_cells, int *var_type, int n_rxn, int n_rxn_int_param, int n_rxn_float_param, int n_rxn_env_param, int n_aero_phase, int n_aero_phase_int_param, int n_aero_phase_float_param, int n_aero_rep, int n_aero_rep_int_param, int n_aero_rep_float_param, int n_aero_rep_env_param, int n_sub_model, int n_sub_model_int_param, int n_sub_model_float_param, int n_sub_model_env_param)
Get a new solver object.
Definition camp_solver.c:73
void check_flag_fail(void *flag_value, char *func_name, int opt)
Check the return value of a SUNDIALS function and exit on failure.
#define DEFAULT_TIME_STEP
Definition camp_solver.c:29
void solver_free(void *solver_data)
Free a SolverData object.
void solver_free_update_data(void *update_data)
Free update data.
static void solver_print_stats(void *cvode_mem)
Print solver statistics.
#define CAMP_SOLVER_SUCCESS
Definition camp_solver.c:39
void error_handler(int error_code, const char *module, const char *function, char *msg, void *sd)
Custom error handling function.
int f(realtype t, N_Vector y, N_Vector deriv, void *solver_data)
Compute the time derivative f(t,y)
bool check_Jac(realtype t, N_Vector y, SUNMatrix J, N_Vector deriv, N_Vector tmp, N_Vector tmp1, void *solver_data)
Check a Jacobian for accuracy.
void solver_reset_timers(void *solver_data)
Reset the timers for solver functions.
int solver_run(void *solver_data, double *state, double *env, double t_initial, double t_final)
Solve for a given timestep.
Header file for solver functions.
int guess_helper(const realtype t_n, const realtype h_n, N_Vector y_n, N_Vector y_n1, N_Vector hf, void *solver_data, N_Vector tmp1, N_Vector corr)
void rxn_update_ids(ModelData *model_data, int *deriv_ids, Jacobian jac)
Update the time derivative and Jacobian array ids.
Definition rxn_solver.c:131
void rxn_calc_deriv_specific_types(ModelData *model_data, TimeDerivative time_deriv, realtype time_step)
Calculate the time derivative for only some specific types.
Definition rxn_solver.c:439
void rxn_calc_jac_specific_types(ModelData *model_data, Jacobian jac, realtype time_step)
Calculate the Jacobian for only some specific types.
Definition rxn_solver.c:595
void rxn_get_used_jac_elem(ModelData *model_data, Jacobian *jac)
Get the Jacobian elements used by a particular reaction.
Definition rxn_solver.c:42
void rxn_update_env_state(ModelData *model_data)
Update reaction data for new environmental state.
Definition rxn_solver.c:224
void rxn_calc_jac(ModelData *model_data, Jacobian jac, realtype time_step)
Calculate the Jacobian.
Definition rxn_solver.c:482
void rxn_calc_deriv(ModelData *model_data, TimeDerivative time_deriv, realtype time_step)
Calculate the time derivative .
Definition rxn_solver.c:322
Header file for abstract reaction functions.
int param_id
Definition camp_common.h:58
int rxn_id
Definition camp_common.h:57
int solver_id
Definition camp_common.h:56
int * rxn_int_indices
int * sub_model_int_data
int * aero_rep_env_idx
int * aero_phase_float_indices
int n_aero_rep_env_data
int * sub_model_int_indices
int n_per_cell_state_var
Definition camp_common.h:63
int n_added_aero_reps
int * var_type
Definition camp_common.h:74
double * rxn_env_data
int * aero_rep_int_indices
int * rxn_float_indices
double * total_env
N_Vector J_state
Definition camp_common.h:83
SUNMatrix J_rxn
Definition camp_common.h:79
double * aero_rep_env_data
int n_added_sub_models
JacMap * jac_map
Definition camp_common.h:88
int n_per_cell_rxn_jac_elem
Definition camp_common.h:65
int * rxn_env_idx
int * aero_phase_int_indices
N_Vector J_tmp2
Definition camp_common.h:86
double * grid_cell_rxn_env_data
int n_sub_model
double * aero_rep_float_data
N_Vector J_deriv
Definition camp_common.h:84
double * grid_cell_env
N_Vector J_tmp
Definition camp_common.h:85
int n_rxn_env_data
SUNMatrix J_init
Definition camp_common.h:77
int * rxn_int_data
int n_per_cell_param_jac_elem
Definition camp_common.h:67
double * sub_model_float_data
int grid_cell_id
double * grid_cell_state
int n_added_rxns
int * aero_rep_float_indices
double * abs_tol
Definition camp_common.h:72
double * total_state
int n_per_cell_solver_jac_elem
Definition camp_common.h:69
int * aero_rep_int_data
double * rxn_float_data
double * aero_phase_float_data
double * grid_cell_aero_rep_env_data
SUNMatrix J_params
Definition camp_common.h:80
double * grid_cell_sub_model_env_data
int n_mapped_values
Definition camp_common.h:97
double * sub_model_env_data
JacMap * jac_map_params
Definition camp_common.h:89
SUNMatrix J_solver
Definition camp_common.h:82
int n_sub_model_env_data
int * sub_model_env_idx
int * aero_phase_int_data
int n_per_cell_dep_var
Definition camp_common.h:64
int n_added_aero_phases
int * sub_model_float_indices
int n_aero_phase
SUNLinearSolver ls
Jacobian jac
double init_time_step
SUNMatrix J
bool curr_J_guess
SUNMatrix J_guess
int output_precision
TimeDerivative time_deriv
int use_deriv_est
N_Vector deriv
N_Vector abs_tol_nv
ModelData model_data
int Jac_eval_fails
void * cvode_mem
N_Vector y
void sub_model_update_ids(ModelData *model_data, int *deriv_ids, Jacobian jac)
Update the time derivative and Jacobian array ids.
void sub_model_get_used_jac_elem(ModelData *model_data, Jacobian *jac)
Get the Jacobian elements used by a particular sub model.
void sub_model_update_env_state(ModelData *model_data)
Update sub model data for a new environmental state.
void sub_model_calculate(ModelData *model_data)
Perform the sub model calculations for the current model state.
void sub_model_get_jac_contrib(ModelData *model_data, double *J_data, realtype time_step)
Calculate the Jacobian constributions from sub model calculations.
Header file for abstract sub model functions.
void time_derivative_free(TimeDerivative time_deriv)
Free memory associated with a TimeDerivative.
int time_derivative_initialize(TimeDerivative *time_deriv, unsigned int num_spec)
Initialize the derivative.
void time_derivative_reset(TimeDerivative time_deriv)
Reset the derivative.
void time_derivative_output(TimeDerivative time_deriv, double *dest_array, double *deriv_est, unsigned int output_precision)
Output the current derivative array.