diff options
Diffstat (limited to 'packages/sundials/src/helpers.c')
-rw-r--r-- | packages/sundials/src/helpers.c | 31 |
1 files changed, 31 insertions, 0 deletions
diff --git a/packages/sundials/src/helpers.c b/packages/sundials/src/helpers.c index d51310c..eab5ac9 100644 --- a/packages/sundials/src/helpers.c +++ b/packages/sundials/src/helpers.c | |||
@@ -8,6 +8,12 @@ | |||
8 | #include <sundials/sundials_types.h> /* definition of type realtype */ | 8 | #include <sundials/sundials_types.h> /* definition of type realtype */ |
9 | #include <sundials/sundials_math.h> | 9 | #include <sundials/sundials_math.h> |
10 | 10 | ||
11 | #include "farkode.h" | ||
12 | |||
13 | #include <HsFFI.h> | ||
14 | #include "Main_stub.h" | ||
15 | |||
16 | |||
11 | /* Check function return value... | 17 | /* Check function return value... |
12 | opt == 0 means SUNDIALS function allocates memory so check if | 18 | opt == 0 means SUNDIALS function allocates memory so check if |
13 | returned NULL pointer | 19 | returned NULL pointer |
@@ -56,6 +62,31 @@ int f(realtype t, N_Vector y, N_Vector ydot, void *user_data) | |||
56 | return 0; /* return with success */ | 62 | return 0; /* return with success */ |
57 | } | 63 | } |
58 | 64 | ||
65 | int FARK_IMP_FUN(realtype *T, realtype *Y, realtype *YDOT, | ||
66 | long int *IPAR, realtype *RPAR, int *IER) { | ||
67 | realtype t = *T; | ||
68 | realtype u = Y[0]; | ||
69 | realtype lamda = -100.0; | ||
70 | YDOT[0] = singleEq(t, u); | ||
71 | return 0; | ||
72 | } | ||
73 | |||
74 | /* C interface to user-supplied FORTRAN function FARKIFUN; see | ||
75 | farkode.h for further details */ | ||
76 | int FARKfi(realtype t, N_Vector y, N_Vector ydot, void *user_data) { | ||
77 | |||
78 | int ier; | ||
79 | realtype *ydata, *dydata; | ||
80 | FARKUserData ARK_userdata; | ||
81 | ydata = N_VGetArrayPointer(y); | ||
82 | dydata = N_VGetArrayPointer(ydot); | ||
83 | ARK_userdata = (FARKUserData) user_data; | ||
84 | |||
85 | FARK_IMP_FUN(&t, ydata, dydata, ARK_userdata->ipar, | ||
86 | ARK_userdata->rpar, &ier); | ||
87 | return(ier); | ||
88 | } | ||
89 | |||
59 | /* Jacobian routine to compute J(t,y) = df/dy. */ | 90 | /* Jacobian routine to compute J(t,y) = df/dy. */ |
60 | int Jac(realtype t, N_Vector y, N_Vector fy, SUNMatrix J, | 91 | int Jac(realtype t, N_Vector y, N_Vector fy, SUNMatrix J, |
61 | void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) | 92 | void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) |