summaryrefslogtreecommitdiff
path: root/packages/sundials/src/Numeric
diff options
context:
space:
mode:
authoridontgetoutmuch <dominic@steinitz.org>2018-03-26 02:33:19 -0700
committerGitHub <noreply@github.com>2018-03-26 02:33:19 -0700
commit4d871f5372d8d242f4497de433433edec8e9e50c (patch)
tree03e23b7027dd1e7983a98328b47aa795256005de /packages/sundials/src/Numeric
parent560f38ab27bcc44c80ce7d9c2e4972342170fe28 (diff)
parent9fd7adf7dda75077b85f0337a548be9138fc1ed5 (diff)
Merge pull request #2 from idontgetoutmuch/revert-1-sundials
Revert "Cleanups to Sundials PR"
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
7module Numeric.Sundials.Arkode.ODE 9module Numeric.Sundials.Arkode.ODE ( solveOde
8 ( SundialsDiagnostics(..) 10 , odeSolve
9 , solveOde 11 ) where
10 , odeSolve
11 ) where
12 12
13import qualified Language.C.Inline as C 13import qualified Language.C.Inline as C
14import qualified Language.C.Inline.Unsafe as CU 14import qualified Language.C.Inline.Unsafe as CU
@@ -40,10 +40,10 @@ C.include "<stdio.h>"
40C.include "<math.h>" 40C.include "<math.h>"
41C.include "<arkode/arkode.h>" -- prototypes for ARKODE fcts., consts. 41C.include "<arkode/arkode.h>" -- prototypes for ARKODE fcts., consts.
42C.include "<nvector/nvector_serial.h>" -- serial N_Vector types, fcts., macros 42C.include "<nvector/nvector_serial.h>" -- serial N_Vector types, fcts., macros
43C.include "<sunmatrix/sunmatrix_dense.h>" -- access to dense SUNMatrix 43C.include "<sunmatrix/sunmatrix_dense.h>" -- access to dense SUNMatrix
44C.include "<sunlinsol/sunlinsol_dense.h>" -- access to dense SUNLinearSolver 44C.include "<sunlinsol/sunlinsol_dense.h>" -- access to dense SUNLinearSolver
45C.include "<arkode/arkode_direct.h>" -- access to ARKDls interface 45C.include "<arkode/arkode_direct.h>" -- access to ARKDls interface
46C.include "<sundials/sundials_types.h>" -- definition of type realtype 46C.include "<sundials/sundials_types.h>" -- definition of type realtype
47C.include "<sundials/sundials_math.h>" 47C.include "<sundials/sundials_math.h>"
48C.include "../../../helpers.h" 48C.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
111solveOde :: 111solveOde ::
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 ::
116solveOde f y0 tt = case solveOdeC (coerce f) (coerce y0) (coerce tt) of 116solveOde 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
120solveOdeC :: 120solveOdeC ::
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