diff options
-rw-r--r-- | packages/sundials/src/Arkode.hsc | 4 | ||||
-rw-r--r-- | packages/sundials/src/Main.hs | 14 | ||||
-rw-r--r-- | packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs | 8 |
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 | ||
5 | import Foreign | 5 | import Foreign |
6 | import Foreign.C.Types | 6 | import Foreign.C.Types |
7 | import 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 | ||
23 | getContentMatrixPtr :: Storable a => Ptr b -> IO a | ||
23 | getContentMatrixPtr ptr = (#peek SunMatrix, content) ptr | 24 | getContentMatrixPtr ptr = (#peek SunMatrix, content) ptr |
24 | 25 | ||
25 | getNRows :: Ptr b -> IO CInt | 26 | getNRows :: Ptr b -> IO CInt |
@@ -32,6 +33,7 @@ getNCols ptr = (#peek SunMatrixContent, N) ptr | |||
32 | putNCols :: CInt -> Ptr b -> IO () | 33 | putNCols :: CInt -> Ptr b -> IO () |
33 | putNCols nc ptr = (#poke SunMatrixContent, N) ptr nc | 34 | putNCols nc ptr = (#poke SunMatrixContent, N) ptr nc |
34 | 35 | ||
36 | getMatrixData :: Storable a => Ptr b -> IO a | ||
35 | getMatrixData ptr = (#peek SunMatrixContent, data) ptr | 37 | getMatrixData ptr = (#peek SunMatrixContent, data) ptr |
36 | 38 | ||
37 | getContentPtr :: Storable a => Ptr b -> IO a | 39 | getContentPtr :: 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 | ||
3 | import qualified Data.Vector.Storable as V | ||
4 | import Numeric.Sundials.Arkode.ODE | 3 | import Numeric.Sundials.Arkode.ODE |
5 | import Numeric.LinearAlgebra | 4 | import Numeric.LinearAlgebra |
6 | 5 | ||
@@ -9,14 +8,14 @@ import qualified Diagrams.Prelude as D | |||
9 | import Diagrams.Backend.Rasterific | 8 | import Diagrams.Backend.Rasterific |
10 | 9 | ||
11 | import Control.Lens | 10 | import Control.Lens |
12 | import Data.List (zip4) | 11 | import Data.List (intercalate) |
13 | 12 | ||
14 | import Text.PrettyPrint.HughesPJClass | 13 | import Text.PrettyPrint.HughesPJClass |
15 | import Data.List (intercalate) | ||
16 | 14 | ||
17 | 15 | ||
18 | brusselator _t x = [ a - (w + 1) * u + v * u^2 | 16 | brusselator :: Double -> [Double] -> [Double] |
19 | , w * u - v * u^2 | 17 | brusselator _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 | ||
29 | brussJac :: Double -> Vector Double -> Matrix Double | ||
30 | brussJac _t x = (3><3) [ (-(w + 1.0)) + 2.0 * u * v, w - 2.0 * u * v, (-w) | 30 | brussJac _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 | ||
41 | stiffish :: Double -> [Double] -> [Double] | ||
41 | stiffish t v = [ lamda * u + 1.0 / (1.0 + t * t) - lamda * atan t ] | 42 | stiffish 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 | ||
47 | stiffJac :: Double -> Vector Double -> Matrix Double | ||
46 | stiffJac _t _v = (1><1) [ lamda ] | 48 | stiffJac _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 | ||
77 | main :: IO () | 79 | main :: 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 |
90 | getMatrixDataFromContents :: Ptr T.SunMatrix -> IO T.SunMatrix | 90 | _getMatrixDataFromContents :: Ptr T.SunMatrix -> IO T.SunMatrix |
91 | getMatrixDataFromContents 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 } |] |