summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--packages/sundials/src/Arkode.hsc4
-rw-r--r--packages/sundials/src/Main.hs14
-rw-r--r--packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs8
3 files changed, 15 insertions, 11 deletions
diff --git a/packages/sundials/src/Arkode.hsc b/packages/sundials/src/Arkode.hsc
index ae2b40f..83d1127 100644
--- a/packages/sundials/src/Arkode.hsc
+++ b/packages/sundials/src/Arkode.hsc
@@ -4,7 +4,6 @@ module Arkode where
4 4
5import Foreign 5import Foreign
6import Foreign.C.Types 6import Foreign.C.Types
7import Foreign.C.String
8 7
9 8
10#include <stdio.h> 9#include <stdio.h>
@@ -14,12 +13,14 @@ import Foreign.C.String
14#include <sunmatrix/sunmatrix_dense.h> 13#include <sunmatrix/sunmatrix_dense.h>
15#include <arkode/arkode.h> 14#include <arkode/arkode.h>
16 15
16
17#def typedef struct _generic_N_Vector SunVector; 17#def typedef struct _generic_N_Vector SunVector;
18#def typedef struct _N_VectorContent_Serial SunContent; 18#def typedef struct _N_VectorContent_Serial SunContent;
19 19
20#def typedef struct _generic_SUNMatrix SunMatrix; 20#def typedef struct _generic_SUNMatrix SunMatrix;
21#def typedef struct _SUNMatrixContent_Dense SunMatrixContent; 21#def typedef struct _SUNMatrixContent_Dense SunMatrixContent;
22 22
23getContentMatrixPtr :: Storable a => Ptr b -> IO a
23getContentMatrixPtr ptr = (#peek SunMatrix, content) ptr 24getContentMatrixPtr ptr = (#peek SunMatrix, content) ptr
24 25
25getNRows :: Ptr b -> IO CInt 26getNRows :: Ptr b -> IO CInt
@@ -32,6 +33,7 @@ getNCols ptr = (#peek SunMatrixContent, N) ptr
32putNCols :: CInt -> Ptr b -> IO () 33putNCols :: CInt -> Ptr b -> IO ()
33putNCols nc ptr = (#poke SunMatrixContent, N) ptr nc 34putNCols nc ptr = (#poke SunMatrixContent, N) ptr nc
34 35
36getMatrixData :: Storable a => Ptr b -> IO a
35getMatrixData ptr = (#peek SunMatrixContent, data) ptr 37getMatrixData ptr = (#peek SunMatrixContent, data) ptr
36 38
37getContentPtr :: Storable a => Ptr b -> IO a 39getContentPtr :: Storable a => Ptr b -> IO a
diff --git a/packages/sundials/src/Main.hs b/packages/sundials/src/Main.hs
index 01d3595..4e0cf4b 100644
--- a/packages/sundials/src/Main.hs
+++ b/packages/sundials/src/Main.hs
@@ -1,6 +1,5 @@
1{-# OPTIONS_GHC -Wall #-} 1{-# OPTIONS_GHC -Wall #-}
2 2
3import qualified Data.Vector.Storable as V
4import Numeric.Sundials.Arkode.ODE 3import Numeric.Sundials.Arkode.ODE
5import Numeric.LinearAlgebra 4import Numeric.LinearAlgebra
6 5
@@ -9,14 +8,14 @@ import qualified Diagrams.Prelude as D
9import Diagrams.Backend.Rasterific 8import Diagrams.Backend.Rasterific
10 9
11import Control.Lens 10import Control.Lens
12import Data.List (zip4) 11import Data.List (intercalate)
13 12
14import Text.PrettyPrint.HughesPJClass 13import Text.PrettyPrint.HughesPJClass
15import Data.List (intercalate)
16 14
17 15
18brusselator _t x = [ a - (w + 1) * u + v * u^2 16brusselator :: Double -> [Double] -> [Double]
19 , w * u - v * u^2 17brusselator _t x = [ a - (w + 1) * u + v * u * u
18 , w * u - v * u * u
20 , (b - w) / eps - w * u 19 , (b - w) / eps - w * u
21 ] 20 ]
22 where 21 where
@@ -27,6 +26,7 @@ brusselator _t x = [ a - (w + 1) * u + v * u^2
27 v = x !! 1 26 v = x !! 1
28 w = x !! 2 27 w = x !! 2
29 28
29brussJac :: Double -> Vector Double -> Matrix Double
30brussJac _t x = (3><3) [ (-(w + 1.0)) + 2.0 * u * v, w - 2.0 * u * v, (-w) 30brussJac _t x = (3><3) [ (-(w + 1.0)) + 2.0 * u * v, w - 2.0 * u * v, (-w)
31 , u * u , (-(u * u)) , 0.0 31 , u * u , (-(u * u)) , 0.0
32 , (-u) , u , (-1.0) / eps - u 32 , (-u) , u , (-1.0) / eps - u
@@ -38,11 +38,13 @@ brussJac _t x = (3><3) [ (-(w + 1.0)) + 2.0 * u * v, w - 2.0 * u * v, (-w)
38 w = y !! 2 38 w = y !! 2
39 eps = 5.0e-6 39 eps = 5.0e-6
40 40
41stiffish :: Double -> [Double] -> [Double]
41stiffish t v = [ lamda * u + 1.0 / (1.0 + t * t) - lamda * atan t ] 42stiffish t v = [ lamda * u + 1.0 / (1.0 + t * t) - lamda * atan t ]
42 where 43 where
43 lamda = -100.0 44 lamda = -100.0
44 u = v !! 0 45 u = v !! 0
45 46
47stiffJac :: Double -> Vector Double -> Matrix Double
46stiffJac _t _v = (1><1) [ lamda ] 48stiffJac _t _v = (1><1) [ lamda ]
47 where 49 where
48 lamda = -100.0 50 lamda = -100.0
@@ -71,7 +73,7 @@ butcherTableauTex m = render $
71 n = rows m 73 n = rows m
72 rs = toLists m 74 rs = toLists m
73 ss = map (\r -> intercalate " & " $ map show r) rs 75 ss = map (\r -> intercalate " & " $ map show r) rs
74 ts = zipWith (\n r -> "c_" ++ show n ++ " & " ++ r) [1..n] ss 76 ts = zipWith (\i r -> "c_" ++ show i ++ " & " ++ r) [1..n] ss
75 us = vcat $ map (\r -> text r <+> text "\\\\") ts 77 us = vcat $ map (\r -> text r <+> text "\\\\") ts
76 78
77main :: IO () 79main :: IO ()
diff --git a/packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs b/packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs
index 5af9e41..b419843 100644
--- a/packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs
+++ b/packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs
@@ -87,8 +87,8 @@ getDataFromContents len ptr = do
87 vectorFromC len rtr 87 vectorFromC len rtr
88 88
89-- FIXME: Potentially an instance of Storable 89-- FIXME: Potentially an instance of Storable
90getMatrixDataFromContents :: Ptr T.SunMatrix -> IO T.SunMatrix 90_getMatrixDataFromContents :: Ptr T.SunMatrix -> IO T.SunMatrix
91getMatrixDataFromContents ptr = do 91_getMatrixDataFromContents ptr = do
92 qtr <- B.getContentMatrixPtr ptr 92 qtr <- B.getContentMatrixPtr ptr
93 rs <- B.getNRows qtr 93 rs <- B.getNRows qtr
94 cs <- B.getNCols qtr 94 cs <- B.getNCols qtr
@@ -239,8 +239,8 @@ solveOdeC method jacH relTol absTol fun f0 ts = unsafePerformIO $ do
239 Ptr () -> Ptr T.SunVector -> Ptr T.SunVector -> Ptr T.SunVector -> 239 Ptr () -> Ptr T.SunVector -> Ptr T.SunVector -> Ptr T.SunVector ->
240 IO CInt 240 IO CInt
241 jacIO t y _fy jacS _ptr _tmp1 _tmp2 _tmp3 = do 241 jacIO t y _fy jacS _ptr _tmp1 _tmp2 _tmp3 = do
242 foo <- jacH t <$> getDataFromContents dim y 242 j <- jacH t <$> getDataFromContents dim y
243 putMatrixDataFromContents foo jacS 243 putMatrixDataFromContents j jacS
244 -- FIXME: I don't understand what this comment means 244 -- FIXME: I don't understand what this comment means
245 -- Unsafe since the function will be called many times. 245 -- Unsafe since the function will be called many times.
246 [CU.exp| int{ 0 } |] 246 [CU.exp| int{ 0 } |]