diff options
Diffstat (limited to 'packages/sundials/src/Numeric/Sundials/ARKode')
-rw-r--r-- | packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs | 28 |
1 files changed, 9 insertions, 19 deletions
diff --git a/packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs b/packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs index 44b724e..b621c58 100644 --- a/packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs +++ b/packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs | |||
@@ -61,9 +61,9 @@ import qualified Types as T | |||
61 | import Bar (sDIRK_2_1_2, kVAERNO_4_2_3) | 61 | import Bar (sDIRK_2_1_2, kVAERNO_4_2_3) |
62 | import qualified Bar as B | 62 | import qualified Bar as B |
63 | 63 | ||
64 | |||
64 | C.context (C.baseCtx <> C.vecCtx <> C.funCtx <> T.sunCtx) | 65 | C.context (C.baseCtx <> C.vecCtx <> C.funCtx <> T.sunCtx) |
65 | 66 | ||
66 | -- C includes | ||
67 | C.include "<stdlib.h>" | 67 | C.include "<stdlib.h>" |
68 | C.include "<stdio.h>" | 68 | C.include "<stdio.h>" |
69 | C.include "<math.h>" | 69 | C.include "<math.h>" |
@@ -77,26 +77,16 @@ C.include "<sundials/sundials_math.h>" | |||
77 | C.include "../../../helpers.h" | 77 | C.include "../../../helpers.h" |
78 | 78 | ||
79 | 79 | ||
80 | -- These were semi-generated using hsc2hs with Bar.hsc as the | ||
81 | -- template. They are probably very fragile and could easily break on | ||
82 | -- different architectures and / or changes in the sundials package. | ||
83 | |||
84 | getContentPtr :: Storable a => Ptr b -> IO a | ||
85 | getContentPtr ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr | ||
86 | |||
87 | getData :: Storable a => Ptr b -> IO a | ||
88 | getData ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr | ||
89 | |||
90 | getDataFromContents :: Storable b => Int -> Ptr a -> IO (V.Vector b) | 80 | getDataFromContents :: Storable b => Int -> Ptr a -> IO (V.Vector b) |
91 | getDataFromContents len ptr = do | 81 | getDataFromContents len ptr = do |
92 | qtr <- getContentPtr ptr | 82 | qtr <- B.getContentPtr ptr |
93 | rtr <- getData qtr | 83 | rtr <- B.getData qtr |
94 | vectorFromC len rtr | 84 | vectorFromC len rtr |
95 | 85 | ||
96 | putDataInContents :: Storable a => V.Vector a -> Int -> Ptr b -> IO () | 86 | putDataInContents :: Storable a => V.Vector a -> Int -> Ptr b -> IO () |
97 | putDataInContents vec len ptr = do | 87 | putDataInContents vec len ptr = do |
98 | qtr <- getContentPtr ptr | 88 | qtr <- B.getContentPtr ptr |
99 | rtr <- getData qtr | 89 | rtr <- B.getData qtr |
100 | vectorToC vec len rtr | 90 | vectorToC vec len rtr |
101 | 91 | ||
102 | -- Utils | 92 | -- Utils |
@@ -199,7 +189,7 @@ solveOdeC method relTol absTol fun f0 ts = unsafePerformIO $ do | |||
199 | diagMut <- V.thaw diagnostics | 189 | diagMut <- V.thaw diagnostics |
200 | -- We need the types that sundials expects. These are tied together | 190 | -- We need the types that sundials expects. These are tied together |
201 | -- in 'Types'. FIXME: The Haskell type is currently empty! | 191 | -- in 'Types'. FIXME: The Haskell type is currently empty! |
202 | let funIO :: CDouble -> Ptr T.BarType -> Ptr T.BarType -> Ptr () -> IO CInt | 192 | let funIO :: CDouble -> Ptr T.SunVector -> Ptr T.SunVector -> Ptr () -> IO CInt |
203 | funIO x y f _ptr = do | 193 | funIO x y f _ptr = do |
204 | -- Convert the pointer we get from C (y) to a vector, and then | 194 | -- Convert the pointer we get from C (y) to a vector, and then |
205 | -- apply the user-supplied function. | 195 | -- apply the user-supplied function. |
@@ -240,7 +230,7 @@ solveOdeC method relTol absTol fun f0 ts = unsafePerformIO $ do | |||
240 | 230 | ||
241 | /* Here we use the C types defined in helpers.h which tie up with */ | 231 | /* Here we use the C types defined in helpers.h which tie up with */ |
242 | /* the Haskell types defined in Types */ | 232 | /* the Haskell types defined in Types */ |
243 | flag = ARKodeInit(arkode_mem, NULL, $fun:(int (* funIO) (double t, BarType y[], BarType dydt[], void * params)), T0, y); | 233 | flag = ARKodeInit(arkode_mem, NULL, $fun:(int (* funIO) (double t, SunVector y[], SunVector dydt[], void * params)), T0, y); |
244 | if (check_flag(&flag, "ARKodeInit", 1)) return 1; | 234 | if (check_flag(&flag, "ARKodeInit", 1)) return 1; |
245 | 235 | ||
246 | /* Set routines */ | 236 | /* Set routines */ |
@@ -378,7 +368,7 @@ getButcherTable method = unsafePerformIO $ do | |||
378 | btAsMut <- V.thaw btAs | 368 | btAsMut <- V.thaw btAs |
379 | -- We need the types that sundials expects. These are tied together | 369 | -- We need the types that sundials expects. These are tied together |
380 | -- in 'Types'. FIXME: The Haskell type is currently empty! | 370 | -- in 'Types'. FIXME: The Haskell type is currently empty! |
381 | let funIO :: CDouble -> Ptr T.BarType -> Ptr T.BarType -> Ptr () -> IO CInt | 371 | let funIO :: CDouble -> Ptr T.SunVector -> Ptr T.SunVector -> Ptr () -> IO CInt |
382 | funIO x y f _ptr = do | 372 | funIO x y f _ptr = do |
383 | -- Convert the pointer we get from C (y) to a vector, and then | 373 | -- Convert the pointer we get from C (y) to a vector, and then |
384 | -- apply the user-supplied function. | 374 | -- apply the user-supplied function. |
@@ -411,7 +401,7 @@ getButcherTable method = unsafePerformIO $ do | |||
411 | arkode_mem = ARKodeCreate(); /* Create the solver memory */ | 401 | arkode_mem = ARKodeCreate(); /* Create the solver memory */ |
412 | if (check_flag((void *)arkode_mem, "ARKodeCreate", 0)) return 1; | 402 | if (check_flag((void *)arkode_mem, "ARKodeCreate", 0)) return 1; |
413 | 403 | ||
414 | flag = ARKodeInit(arkode_mem, NULL, $fun:(int (* funIO) (double t, BarType y[], BarType dydt[], void * params)), T0, y); | 404 | flag = ARKodeInit(arkode_mem, NULL, $fun:(int (* funIO) (double t, SunVector y[], SunVector dydt[], void * params)), T0, y); |
415 | if (check_flag(&flag, "ARKodeInit", 1)) return 1; | 405 | if (check_flag(&flag, "ARKodeInit", 1)) return 1; |
416 | 406 | ||
417 | flag = ARKodeSetIRKTableNum(arkode_mem, $(int mN)); | 407 | flag = ARKodeSetIRKTableNum(arkode_mem, $(int mN)); |