diff options
Diffstat (limited to 'packages/sundials/src/Numeric')
-rw-r--r-- | packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs (renamed from packages/sundials/src/Numeric/Sundials/Arkode/ODE.hs) | 31 |
1 files changed, 16 insertions, 15 deletions
diff --git a/packages/sundials/src/Numeric/Sundials/Arkode/ODE.hs b/packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs index 6d9a1b2..f432951 100644 --- a/packages/sundials/src/Numeric/Sundials/Arkode/ODE.hs +++ b/packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs | |||
@@ -1,14 +1,14 @@ | |||
1 | {-# OPTIONS_GHC -Wall #-} | ||
2 | |||
3 | {-# LANGUAGE QuasiQuotes #-} | ||
4 | {-# LANGUAGE TemplateHaskell #-} | ||
1 | {-# LANGUAGE MultiWayIf #-} | 5 | {-# LANGUAGE MultiWayIf #-} |
2 | {-# LANGUAGE OverloadedStrings #-} | 6 | {-# LANGUAGE OverloadedStrings #-} |
3 | {-# LANGUAGE QuasiQuotes #-} | ||
4 | {-# LANGUAGE ScopedTypeVariables #-} | 7 | {-# LANGUAGE ScopedTypeVariables #-} |
5 | {-# LANGUAGE TemplateHaskell #-} | ||
6 | 8 | ||
7 | module Numeric.Sundials.Arkode.ODE | 9 | module Numeric.Sundials.Arkode.ODE ( solveOde |
8 | ( SundialsDiagnostics(..) | 10 | , odeSolve |
9 | , solveOde | 11 | ) where |
10 | , odeSolve | ||
11 | ) where | ||
12 | 12 | ||
13 | import qualified Language.C.Inline as C | 13 | import qualified Language.C.Inline as C |
14 | import qualified Language.C.Inline.Unsafe as CU | 14 | import qualified Language.C.Inline.Unsafe as CU |
@@ -40,10 +40,10 @@ C.include "<stdio.h>" | |||
40 | C.include "<math.h>" | 40 | C.include "<math.h>" |
41 | C.include "<arkode/arkode.h>" -- prototypes for ARKODE fcts., consts. | 41 | C.include "<arkode/arkode.h>" -- prototypes for ARKODE fcts., consts. |
42 | C.include "<nvector/nvector_serial.h>" -- serial N_Vector types, fcts., macros | 42 | C.include "<nvector/nvector_serial.h>" -- serial N_Vector types, fcts., macros |
43 | C.include "<sunmatrix/sunmatrix_dense.h>" -- access to dense SUNMatrix | 43 | C.include "<sunmatrix/sunmatrix_dense.h>" -- access to dense SUNMatrix |
44 | C.include "<sunlinsol/sunlinsol_dense.h>" -- access to dense SUNLinearSolver | 44 | C.include "<sunlinsol/sunlinsol_dense.h>" -- access to dense SUNLinearSolver |
45 | C.include "<arkode/arkode_direct.h>" -- access to ARKDls interface | 45 | C.include "<arkode/arkode_direct.h>" -- access to ARKDls interface |
46 | C.include "<sundials/sundials_types.h>" -- definition of type realtype | 46 | C.include "<sundials/sundials_types.h>" -- definition of type realtype |
47 | C.include "<sundials/sundials_math.h>" | 47 | C.include "<sundials/sundials_math.h>" |
48 | C.include "../../../helpers.h" | 48 | C.include "../../../helpers.h" |
49 | 49 | ||
@@ -108,7 +108,7 @@ odeSolve f y0 ts = case solveOde g (V.fromList y0) (V.fromList $ toList ts) of | |||
108 | nC = length y0 | 108 | nC = length y0 |
109 | g t x0 = V.fromList $ f t (V.toList x0) | 109 | g t x0 = V.fromList $ f t (V.toList x0) |
110 | 110 | ||
111 | solveOde :: | 111 | solveOde :: |
112 | (Double -> V.Vector Double -> V.Vector Double) -- ^ The RHS of the system \(\dot{y} = f(t,y)\) | 112 | (Double -> V.Vector Double -> V.Vector Double) -- ^ The RHS of the system \(\dot{y} = f(t,y)\) |
113 | -> V.Vector Double -- ^ Initial conditions | 113 | -> V.Vector Double -- ^ Initial conditions |
114 | -> V.Vector Double -- ^ Desired solution times | 114 | -> V.Vector Double -- ^ Desired solution times |
@@ -116,7 +116,7 @@ solveOde :: | |||
116 | solveOde f y0 tt = case solveOdeC (coerce f) (coerce y0) (coerce tt) of | 116 | solveOde f y0 tt = case solveOdeC (coerce f) (coerce y0) (coerce tt) of |
117 | Left c -> Left $ fromIntegral c | 117 | Left c -> Left $ fromIntegral c |
118 | Right (v, d) -> Right (coerce v, d) | 118 | Right (v, d) -> Right (coerce v, d) |
119 | 119 | ||
120 | solveOdeC :: | 120 | solveOdeC :: |
121 | (CDouble -> V.Vector CDouble -> V.Vector CDouble) -- ^ The RHS of the system \(\dot{y} = f(t,y)\) | 121 | (CDouble -> V.Vector CDouble -> V.Vector CDouble) -- ^ The RHS of the system \(\dot{y} = f(t,y)\) |
122 | -> V.Vector CDouble -- ^ Initial conditions | 122 | -> V.Vector CDouble -- ^ Initial conditions |
@@ -285,13 +285,13 @@ solveOdeC fun f0 ts = unsafePerformIO $ do | |||
285 | flag = ARKDlsGetNumRhsEvals(arkode_mem, &nfeLS); | 285 | flag = ARKDlsGetNumRhsEvals(arkode_mem, &nfeLS); |
286 | check_flag(&flag, "ARKDlsGetNumRhsEvals", 1); | 286 | check_flag(&flag, "ARKDlsGetNumRhsEvals", 1); |
287 | ($vec-ptr:(long int *diagMut))[9] = ncfn; | 287 | ($vec-ptr:(long int *diagMut))[9] = ncfn; |
288 | 288 | ||
289 | /* Clean up and return */ | 289 | /* Clean up and return */ |
290 | N_VDestroy(y); /* Free y vector */ | 290 | N_VDestroy(y); /* Free y vector */ |
291 | ARKodeFree(&arkode_mem); /* Free integrator memory */ | 291 | ARKodeFree(&arkode_mem); /* Free integrator memory */ |
292 | SUNLinSolFree(LS); /* Free linear solver */ | 292 | SUNLinSolFree(LS); /* Free linear solver */ |
293 | SUNMatDestroy(A); /* Free A matrix */ | 293 | SUNMatDestroy(A); /* Free A matrix */ |
294 | 294 | ||
295 | return flag; | 295 | return flag; |
296 | } |] | 296 | } |] |
297 | if res == 0 | 297 | if res == 0 |
@@ -311,3 +311,4 @@ solveOdeC fun f0 ts = unsafePerformIO $ do | |||
311 | return $ Right (m, d) | 311 | return $ Right (m, d) |
312 | else do | 312 | else do |
313 | return $ Left res | 313 | return $ Left res |
314 | |||