From 15a2c146d677dea7c4e0d7a39cbd6c8e9edb658f Mon Sep 17 00:00:00 2001
From: Dominic Steinitz <dominic@steinitz.org>
Date: Mon, 19 Mar 2018 16:22:20 +0000
Subject: More removal of the Fortran way

---
 packages/sundials/src/Main.hs   | 14 --------------
 packages/sundials/src/helpers.c | 35 -----------------------------------
 packages/sundials/src/helpers.h |  9 ---------
 3 files changed, 58 deletions(-)

(limited to 'packages')

diff --git a/packages/sundials/src/Main.hs b/packages/sundials/src/Main.hs
index 89d6668..ab5b153 100644
--- a/packages/sundials/src/Main.hs
+++ b/packages/sundials/src/Main.hs
@@ -84,19 +84,6 @@ vectorToC vec len ptr = do
   ptr' <- newForeignPtr_ ptr
   V.copy (VM.unsafeFromForeignPtr0 ptr' len) vec
 
--- Provided you always call your function 'multiEq' then we can
--- probably solve any set of ODEs! But of course we don't want to
--- follow the Fortran way of interacting with sundials.
-
--- foreign export ccall multiEq :: Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CLong -> Ptr CDouble -> Ptr CInt -> IO ()
-
-multiEq :: Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CLong -> Ptr CDouble -> Ptr CInt -> IO ()
-multiEq tPtr yPtr yDotPtr iParPtr rParPtr ierPtr = do
-  t <- peek tPtr
-  y <- vectorFromC 1 yPtr
-  vectorToC (V.map realToFrac $ stiffish (realToFrac t) (V.map realToFrac y)) 1 yDotPtr
-  poke ierPtr 0
-
 stiffish :: Double -> V.Vector Double -> V.Vector Double
 stiffish t v = V.fromList [ lamda * u + 1.0 / (1.0 + t * t) - lamda * atan t ]
   where
@@ -161,7 +148,6 @@ solveOdeC fun f0 = unsafePerformIO $ do
                          /* Here we use the C types defined in helpers.h which tie up with */
                          /* the Haskell types defined in Types                             */
                          flag = ARKodeInit(arkode_mem, NULL, $fun:(int (* funIO) (double t, BarType y[], BarType dydt[], void * params)), T0, y);
-                         /* flag = ARKodeInit(arkode_mem, NULL, FARKfi, T0, y); */
                          if (check_flag(&flag, "ARKodeInit", 1)) return 1;
 
                          /* Set routines */
diff --git a/packages/sundials/src/helpers.c b/packages/sundials/src/helpers.c
index 6162b71..f3fe40b 100644
--- a/packages/sundials/src/helpers.c
+++ b/packages/sundials/src/helpers.c
@@ -49,41 +49,6 @@ int check_flag(void *flagvalue, const char *funcname, int opt)
   return 0;
 }
 
-/* f routine to compute the ODE RHS function f(t,y). */
-int f(realtype t, N_Vector y, N_Vector ydot, void *user_data)
-{
-  realtype *rdata = (realtype *) user_data;   /* cast user_data to realtype */
-  realtype lamda = rdata[0];                  /* set shortcut for stiffness parameter */
-  realtype u = NV_Ith_S(y,0);                 /* access current solution value */
-
-  /* fill in the RHS function: "NV_Ith_S" accesses the 0th entry of ydot */
-  NV_Ith_S(ydot,0) = lamda*u + 1.0/(1.0+t*t) - lamda*atan(t);
-
-  return 0;                                   /* return with success */
-}
-
-int FARK_IMP_FUN(realtype *T, realtype *Y, realtype *YDOT,
-		 long int *IPAR, realtype *RPAR, int *IER) {
-  multiEq(T, Y, YDOT, IPAR, RPAR, IER);
-  return 0;
-}
-
-/* C interface to user-supplied FORTRAN function FARKIFUN; see
-   farkode.h for further details */
-int FARKfi(realtype t, N_Vector y, N_Vector ydot, void *user_data) {
-
-  int ier;
-  realtype *ydata, *dydata;
-  FARKUserData ARK_userdata;
-  ydata  = N_VGetArrayPointer(y);
-  dydata = N_VGetArrayPointer(ydot);
-  ARK_userdata = (FARKUserData) user_data;
-
-  FARK_IMP_FUN(&t, ydata, dydata, ARK_userdata->ipar,
-	       ARK_userdata->rpar, &ier);
-  return(ier);
-}
-
 /* Jacobian routine to compute J(t,y) = df/dy. */
 int Jac(realtype t, N_Vector y, N_Vector fy, SUNMatrix J,
         void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
diff --git a/packages/sundials/src/helpers.h b/packages/sundials/src/helpers.h
index 7f4ba02..69a3dfe 100644
--- a/packages/sundials/src/helpers.h
+++ b/packages/sundials/src/helpers.h
@@ -21,14 +21,5 @@ typedef struct _N_VectorContent_Serial BazType;
 */
 int check_flag(void *flagvalue, const char *funcname, int opt);
 
-/* f routine to compute the ODE RHS function f(t,y). */
-int f(realtype t, N_Vector y, N_Vector ydot, void *user_data);
-
-int FARKfi(realtype t, N_Vector y, N_Vector ydot, void *user_data);
-
-/* Jacobian routine to compute J(t,y) = df/dy. */
-int Jac(realtype t, N_Vector y, N_Vector fy, SUNMatrix J,
-        void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3);
-
 /* check the computed solution */
 int check_ans(N_Vector y, realtype t, realtype rtol, realtype atol);
-- 
cgit v1.2.3