summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Config.hs22
-rw-r--r--hmatrix.cabal3
-rw-r--r--lib/Numeric/GSL/gsl-aux.c87
-rw-r--r--lib/Numeric/GSL/gsl-ode.c182
4 files changed, 204 insertions, 90 deletions
diff --git a/Config.hs b/Config.hs
index 2ea0fa8..3582ef5 100644
--- a/Config.hs
+++ b/Config.hs
@@ -79,6 +79,18 @@ gsl112 bInfo buildInfo =
79 ++ (join $ map ("-L"++) $ extraLibDirs buildInfo) ++ " -lgsl -lgslcblas" 79 ++ (join $ map ("-L"++) $ extraLibDirs buildInfo) ++ " -lgsl -lgslcblas"
80 ++ " > /dev/null 2> /dev/null" 80 ++ " > /dev/null 2> /dev/null"
81 81
82-- test for odeiv2
83gslodeiv2 bInfo buildInfo =
84 "echo \"#include <gsl/gsl_odeiv2.h>\nint main(){return 0;}\""
85 ++" > " ++ (buildDir bInfo) ++ "/dummy.c; gcc "
86 ++ (buildDir bInfo) ++ "/dummy.c "
87 ++ (join $ ccOptions buildInfo) ++ " "
88 ++ (join $ cppOptions buildInfo) ++ " "
89 ++ (join $ map ("-I"++) $ includeDirs buildInfo)
90 ++" -o " ++ (buildDir bInfo) ++ "/dummy "
91 ++ (join $ map ("-L"++) $ extraLibDirs buildInfo) ++ " -lgsl -lgslcblas"
92 ++ " > /dev/null 2> /dev/null"
93
82 94
83checkCommand c = (ExitSuccess ==) `fmap` system c 95checkCommand c = (ExitSuccess ==) `fmap` system c
84 96
@@ -133,9 +145,11 @@ config bInfo = do
133 return (Just emptyBuildInfo { buildable = False }, []) 145 return (Just emptyBuildInfo { buildable = False }, [])
134 Just ops -> do 146 Just ops -> do
135 putStrLn $ " OK " ++ ops 147 putStrLn $ " OK " ++ ops
136 g <- checkCommand $ gsl112 bInfo buildInfo 148 g1 <- checkCommand $ gsl112 bInfo buildInfo
137 let hbi = if g 149 let op1 = if g1 then "" else "-DGSL110"
138 then emptyBuildInfo { extraLibs = words ops} 150 g2 <- checkCommand $ gslodeiv2 bInfo buildInfo
139 else emptyBuildInfo { extraLibs = words ops, ccOptions = ["-DGSL110"]} 151 let op2 = if g2 then "" else "-DGSLODE1"
152 opts = filter (not.null) [op1,op2]
153 let hbi = emptyBuildInfo { extraLibs = words ops, ccOptions = opts }
140 return (Just hbi, []) 154 return (Just hbi, [])
141 155
diff --git a/hmatrix.cabal b/hmatrix.cabal
index 7ffa01d..4d3beb6 100644
--- a/hmatrix.cabal
+++ b/hmatrix.cabal
@@ -1,5 +1,5 @@
1Name: hmatrix 1Name: hmatrix
2Version: 0.14.0.0 2Version: 0.14.0.1
3License: GPL 3License: GPL
4License-file: LICENSE 4License-file: LICENSE
5Author: Alberto Ruiz 5Author: Alberto Ruiz
@@ -56,6 +56,7 @@ extra-source-files: examples/deriv.hs
56 56
57extra-source-files: lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h, 57extra-source-files: lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h,
58 lib/Numeric/LinearAlgebra/LAPACK/clapack.h 58 lib/Numeric/LinearAlgebra/LAPACK/clapack.h
59 lib/Numeric/GSL/gsl-ode.c
59 60
60flag dd 61flag dd
61 description: svd = zgesdd 62 description: svd = zgesdd
diff --git a/lib/Numeric/GSL/gsl-aux.c b/lib/Numeric/GSL/gsl-aux.c
index 7f1cf68..fc14ff5 100644
--- a/lib/Numeric/GSL/gsl-aux.c
+++ b/lib/Numeric/GSL/gsl-aux.c
@@ -32,7 +32,6 @@
32#include <gsl/gsl_complex_math.h> 32#include <gsl/gsl_complex_math.h>
33#include <gsl/gsl_rng.h> 33#include <gsl/gsl_rng.h>
34#include <gsl/gsl_randist.h> 34#include <gsl/gsl_randist.h>
35#include <gsl/gsl_odeiv2.h>
36#include <gsl/gsl_multifit_nlin.h> 35#include <gsl/gsl_multifit_nlin.h>
37#include <string.h> 36#include <string.h>
38#include <stdio.h> 37#include <stdio.h>
@@ -1331,89 +1330,7 @@ int random_vector(int seed, int code, RVEC(r)) {
1331#undef RAN 1330#undef RAN
1332 1331
1333////////////////////////////////////////////////////// 1332//////////////////////////////////////////////////////
1334// ODE
1335 1333
1336typedef struct {int n; int (*f)(double,int, const double*, int, double *); int (*j)(double,int, const double*, int, int, double*);} Tode; 1334#include "gsl-ode.c"
1337
1338int odefunc (double t, const double y[], double f[], void *params) {
1339 Tode * P = (Tode*) params;
1340 (P->f)(t,P->n,y,P->n,f);
1341 return GSL_SUCCESS;
1342}
1343
1344int odejac (double t, const double y[], double *dfdy, double dfdt[], void *params) {
1345 Tode * P = ((Tode*) params);
1346 (P->j)(t,P->n,y,P->n,P->n,dfdy);
1347 int j;
1348 for (j=0; j< P->n; j++)
1349 dfdt[j] = 0.0;
1350 return GSL_SUCCESS;
1351}
1352
1353
1354int ode(int method, double h, double eps_abs, double eps_rel,
1355 int f(double, int, const double*, int, double*),
1356 int jac(double, int, const double*, int, int, double*),
1357 KRVEC(xi), KRVEC(ts), RMAT(sol)) {
1358
1359 const gsl_odeiv2_step_type * T;
1360
1361 switch(method) {
1362 case 0 : {T = gsl_odeiv2_step_rk2; break; }
1363 case 1 : {T = gsl_odeiv2_step_rk4; break; }
1364 case 2 : {T = gsl_odeiv2_step_rkf45; break; }
1365 case 3 : {T = gsl_odeiv2_step_rkck; break; }
1366 case 4 : {T = gsl_odeiv2_step_rk8pd; break; }
1367 case 5 : {T = gsl_odeiv2_step_rk2imp; break; }
1368 case 6 : {T = gsl_odeiv2_step_rk4imp; break; }
1369 case 7 : {T = gsl_odeiv2_step_bsimp; break; }
1370 case 8 : {T = gsl_odeiv2_step_rk1imp; break; }
1371 case 9 : {T = gsl_odeiv2_step_msadams; break; }
1372 case 10: {T = gsl_odeiv2_step_msbdf; break; }
1373 default: ERROR(BAD_CODE);
1374 }
1375
1376 Tode P;
1377 P.f = f;
1378 P.j = jac;
1379 P.n = xin;
1380
1381 gsl_odeiv2_system sys = {odefunc, odejac, xin, &P};
1382
1383 gsl_odeiv2_driver * d =
1384 gsl_odeiv2_driver_alloc_y_new (&sys, T, h, eps_abs, eps_rel);
1385
1386 double t = tsp[0];
1387
1388 double* y = (double*)calloc(xin,sizeof(double));
1389 int i,j;
1390 int status;
1391 for(i=0; i< xin; i++) {
1392 y[i] = xip[i];
1393 solp[i] = xip[i];
1394 }
1395
1396 for (i = 1; i < tsn ; i++)
1397 {
1398 double ti = tsp[i];
1399
1400 status = gsl_odeiv2_driver_apply (d, &t, ti, y);
1401
1402 if (status != GSL_SUCCESS) {
1403 printf ("error in ode, return value=%d\n", status);
1404 break;
1405 }
1406
1407// printf ("%.5e %.5e %.5e\n", t, y[0], y[1]);
1408
1409 for(j=0; j<xin; j++) {
1410 solp[i*xin + j] = y[j];
1411 }
1412 }
1413
1414 free(y);
1415 gsl_odeiv2_driver_free (d);
1416
1417 return status;
1418}
1419 1335
1336//////////////////////////////////////////////////////
diff --git a/lib/Numeric/GSL/gsl-ode.c b/lib/Numeric/GSL/gsl-ode.c
new file mode 100644
index 0000000..7386d10
--- /dev/null
+++ b/lib/Numeric/GSL/gsl-ode.c
@@ -0,0 +1,182 @@
1
2#ifdef GSLODE1
3
4////////////////////////////// ODE V1 //////////////////////////////////////////
5
6#include <gsl/gsl_odeiv.h>
7
8typedef struct {int n; int (*f)(double,int, const double*, int, double *); int (*j)(double,int, const double*, int, int, double*);} Tode;
9
10int odefunc (double t, const double y[], double f[], void *params) {
11 Tode * P = (Tode*) params;
12 (P->f)(t,P->n,y,P->n,f);
13 return GSL_SUCCESS;
14}
15
16int odejac (double t, const double y[], double *dfdy, double dfdt[], void *params) {
17 Tode * P = ((Tode*) params);
18 (P->j)(t,P->n,y,P->n,P->n,dfdy);
19 int j;
20 for (j=0; j< P->n; j++)
21 dfdt[j] = 0.0;
22 return GSL_SUCCESS;
23}
24
25
26int ode(int method, double h, double eps_abs, double eps_rel,
27 int f(double, int, const double*, int, double*),
28 int jac(double, int, const double*, int, int, double*),
29 KRVEC(xi), KRVEC(ts), RMAT(sol)) {
30
31 const gsl_odeiv_step_type * T;
32
33 switch(method) {
34 case 0 : {T = gsl_odeiv_step_rk2; break; }
35 case 1 : {T = gsl_odeiv_step_rk4; break; }
36 case 2 : {T = gsl_odeiv_step_rkf45; break; }
37 case 3 : {T = gsl_odeiv_step_rkck; break; }
38 case 4 : {T = gsl_odeiv_step_rk8pd; break; }
39 case 5 : {T = gsl_odeiv_step_rk2imp; break; }
40 case 6 : {T = gsl_odeiv_step_rk4imp; break; }
41 case 7 : {T = gsl_odeiv_step_bsimp; break; }
42 case 8 : { printf("Sorry: ODE rk1imp not available in this GSL version\n"); exit(0); }
43 case 9 : { printf("Sorry: ODE msadams not available in this GSL version\n"); exit(0); }
44 case 10: { printf("Sorry: ODE msbdf not available in this GSL version\n"); exit(0); }
45 default: ERROR(BAD_CODE);
46 }
47
48 gsl_odeiv_step * s = gsl_odeiv_step_alloc (T, xin);
49 gsl_odeiv_control * c = gsl_odeiv_control_y_new (eps_abs, eps_rel);
50 gsl_odeiv_evolve * e = gsl_odeiv_evolve_alloc (xin);
51
52 Tode P;
53 P.f = f;
54 P.j = jac;
55 P.n = xin;
56
57 gsl_odeiv_system sys = {odefunc, odejac, xin, &P};
58
59 double t = tsp[0];
60
61 double* y = (double*)calloc(xin,sizeof(double));
62 int i,j;
63 for(i=0; i< xin; i++) {
64 y[i] = xip[i];
65 solp[i] = xip[i];
66 }
67
68 for (i = 1; i < tsn ; i++)
69 {
70 double ti = tsp[i];
71 while (t < ti)
72 {
73 gsl_odeiv_evolve_apply (e, c, s,
74 &sys,
75 &t, ti, &h,
76 y);
77 // if (h < hmin) h = hmin;
78 }
79 for(j=0; j<xin; j++) {
80 solp[i*xin + j] = y[j];
81 }
82 }
83
84 free(y);
85 gsl_odeiv_evolve_free (e);
86 gsl_odeiv_control_free (c);
87 gsl_odeiv_step_free (s);
88 return 0;
89}
90
91#else
92
93///////////////////// ODE V2 ///////////////////////////////////////////////////
94
95#include <gsl/gsl_odeiv2.h>
96
97typedef struct {int n; int (*f)(double,int, const double*, int, double *); int (*j)(double,int, const double*, int, int, double*);} Tode;
98
99int odefunc (double t, const double y[], double f[], void *params) {
100 Tode * P = (Tode*) params;
101 (P->f)(t,P->n,y,P->n,f);
102 return GSL_SUCCESS;
103}
104
105int odejac (double t, const double y[], double *dfdy, double dfdt[], void *params) {
106 Tode * P = ((Tode*) params);
107 (P->j)(t,P->n,y,P->n,P->n,dfdy);
108 int j;
109 for (j=0; j< P->n; j++)
110 dfdt[j] = 0.0;
111 return GSL_SUCCESS;
112}
113
114
115int ode(int method, double h, double eps_abs, double eps_rel,
116 int f(double, int, const double*, int, double*),
117 int jac(double, int, const double*, int, int, double*),
118 KRVEC(xi), KRVEC(ts), RMAT(sol)) {
119
120 const gsl_odeiv2_step_type * T;
121
122 switch(method) {
123 case 0 : {T = gsl_odeiv2_step_rk2; break; }
124 case 1 : {T = gsl_odeiv2_step_rk4; break; }
125 case 2 : {T = gsl_odeiv2_step_rkf45; break; }
126 case 3 : {T = gsl_odeiv2_step_rkck; break; }
127 case 4 : {T = gsl_odeiv2_step_rk8pd; break; }
128 case 5 : {T = gsl_odeiv2_step_rk2imp; break; }
129 case 6 : {T = gsl_odeiv2_step_rk4imp; break; }
130 case 7 : {T = gsl_odeiv2_step_bsimp; break; }
131 case 8 : {T = gsl_odeiv2_step_rk1imp; break; }
132 case 9 : {T = gsl_odeiv2_step_msadams; break; }
133 case 10: {T = gsl_odeiv2_step_msbdf; break; }
134 default: ERROR(BAD_CODE);
135 }
136
137 Tode P;
138 P.f = f;
139 P.j = jac;
140 P.n = xin;
141
142 gsl_odeiv2_system sys = {odefunc, odejac, xin, &P};
143
144 gsl_odeiv2_driver * d =
145 gsl_odeiv2_driver_alloc_y_new (&sys, T, h, eps_abs, eps_rel);
146
147 double t = tsp[0];
148
149 double* y = (double*)calloc(xin,sizeof(double));
150 int i,j;
151 int status;
152 for(i=0; i< xin; i++) {
153 y[i] = xip[i];
154 solp[i] = xip[i];
155 }
156
157 for (i = 1; i < tsn ; i++)
158 {
159 double ti = tsp[i];
160
161 status = gsl_odeiv2_driver_apply (d, &t, ti, y);
162
163 if (status != GSL_SUCCESS) {
164 printf ("error in ode, return value=%d\n", status);
165 break;
166 }
167
168// printf ("%.5e %.5e %.5e\n", t, y[0], y[1]);
169
170 for(j=0; j<xin; j++) {
171 solp[i*xin + j] = y[j];
172 }
173 }
174
175 free(y);
176 gsl_odeiv2_driver_free (d);
177
178 return status;
179}
180
181#endif
182