← Back to branch summary

~ubuntu-branches/ubuntu/quantal/orpie/quantal

« back to all changes in this revision

Viewing changes to gsl/mlgsl_blas.c

  • Committer: Bazaar Package Importer
  • Author(s): Uwe Steinmann
  • Date: 2004-09-20 14:18:45 UTC
  • Revision ID: james.westby@ubuntu.com-20040920141845-j092sbrg4hd0nfsf
Tags: upstream-1.4.1
Import upstream version 1.4.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
gsl/mlgsl_blas.c
 
1
/* ocamlgsl - OCaml interface to GSL                        */
 
2
/* Copyright (�) 2002 - Olivier Andrieu                     */
 
3
/* distributed under the terms of the GPL version 2         */
 
4
 
 
5
 
 
6
#include <gsl/gsl_blas.h>
 
7
 
 
8
#include "mlgsl_vector_double.h"
 
9
#include "mlgsl_matrix_double.h"
 
10
 
 
11
#include "mlgsl_blas.h"
 
12
 
 
13
 
 
14
/* LEVEL1 double */
 
15
 
 
16
value ml_gsl_blas_ddot(value X, value Y)
 
17
{
 
18
  double r;
 
19
  _DECLARE_VECTOR2(X, Y);
 
20
  _CONVERT_VECTOR2(X, Y);
 
21
  gsl_blas_ddot(&v_X, &v_Y, &r);
 
22
  return copy_double(r);
 
23
}
 
24
 
 
25
value ml_gsl_blas_dnrm2(value X)
 
26
{
 
27
  _DECLARE_VECTOR(X);
 
28
  _CONVERT_VECTOR(X);
 
29
  return copy_double(gsl_blas_dnrm2(&v_X));
 
30
}
 
31
 
 
32
value ml_gsl_blas_dasum(value X)
 
33
{
 
34
  _DECLARE_VECTOR(X);
 
35
  _CONVERT_VECTOR(X);
 
36
  return copy_double(gsl_blas_dasum(&v_X));
 
37
}
 
38
 
 
39
value ml_gsl_blas_idamax(value X)
 
40
{
 
41
  _DECLARE_VECTOR(X);
 
42
  _CONVERT_VECTOR(X);
 
43
  return Val_int(gsl_blas_idamax(&v_X));
 
44
}
 
45
 
 
46
value ml_gsl_blas_dswap(value X, value Y)
 
47
{
 
48
  _DECLARE_VECTOR2(X, Y);
 
49
  _CONVERT_VECTOR2(X, Y);
 
50
  gsl_blas_dswap(&v_X, &v_Y);
 
51
  return Val_unit;
 
52
}
 
53
 
 
54
value ml_gsl_blas_dcopy(value X, value Y)
 
55
{
 
56
  _DECLARE_VECTOR2(X, Y);
 
57
  _CONVERT_VECTOR2(X, Y);
 
58
  gsl_blas_dcopy(&v_X, &v_Y);
 
59
  return Val_unit;
 
60
}
 
61
 
 
62
value ml_gsl_blas_daxpy(value alpha, value X, value Y)
 
63
{
 
64
  _DECLARE_VECTOR2(X, Y);
 
65
  _CONVERT_VECTOR2(X, Y);
 
66
  gsl_blas_daxpy(Double_val(alpha), &v_X, &v_Y);
 
67
  return Val_unit;
 
68
}
 
69
 
 
70
/* FIXME: drotg drotmg drotm */
 
71
 
 
72
value ml_gsl_blas_drot(value X, value Y, value c, value s)
 
73
{
 
74
  _DECLARE_VECTOR2(X, Y);
 
75
  _CONVERT_VECTOR2(X, Y);
 
76
  gsl_blas_drot(&v_X, &v_Y, Double_val(c), Double_val(s));
 
77
  return Val_unit;
 
78
}
 
79
 
 
80
value ml_gsl_blas_dscal(value alpha, value X)
 
81
{
 
82
  _DECLARE_VECTOR(X);
 
83
  _CONVERT_VECTOR(X);
 
84
  gsl_blas_dscal(Double_val(alpha), &v_X);
 
85
  return Val_unit;
 
86
}
 
87
 
 
88
 
 
89
/* LEVEL2 double */
 
90
 
 
91
value ml_gsl_blas_dgemv(value transa, value alpha, value A, 
 
92
                        value X, value beta, value Y)
 
93
{
 
94
  _DECLARE_MATRIX(A);
 
95
  _DECLARE_VECTOR2(X, Y);
 
96
  _CONVERT_MATRIX(A);
 
97
  _CONVERT_VECTOR2(X, Y);
 
98
  gsl_blas_dgemv(CBLAS_TRANS_val(transa), Double_val(alpha),
 
99
                 &m_A, &v_X, Double_val(beta), &v_Y);
 
100
  return Val_unit;
 
101
}
 
102
 
 
103
value ml_gsl_blas_dgemv_bc(value *argv, int argc)
 
104
{
 
105
  return ml_gsl_blas_dgemv(argv[0], argv[1], argv[2],
 
106
                           argv[3], argv[4], argv[5]);
 
107
}
 
108
 
 
109
value ml_gsl_blas_dtrmv(value uplo, value transa, value diag,
 
110
                        value A, value X)
 
111
{
 
112
  _DECLARE_MATRIX(A);
 
113
  _DECLARE_VECTOR(X);
 
114
  _CONVERT_MATRIX(A);
 
115
  _CONVERT_VECTOR(X);
 
116
  gsl_blas_dtrmv(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa),
 
117
                 CBLAS_DIAG_val(diag), &m_A, &v_X);
 
118
  return Val_unit;
 
119
}
 
120
 
 
121
value ml_gsl_blas_dtrsv(value uplo, value transa, value diag,
 
122
                        value A, value X)
 
123
{
 
124
  _DECLARE_MATRIX(A);
 
125
  _DECLARE_VECTOR(X);
 
126
  _CONVERT_MATRIX(A);
 
127
  _CONVERT_VECTOR(X);
 
128
  gsl_blas_dtrsv(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa),
 
129
                 CBLAS_DIAG_val(diag), &m_A, &v_X);
 
130
  return Val_unit;
 
131
}
 
132
 
 
133
value ml_gsl_blas_dsymv(value uplo, value alpha, value A, 
 
134
                        value X, value beta, value Y)
 
135
{
 
136
  _DECLARE_MATRIX(A);
 
137
  _DECLARE_VECTOR2(X, Y);
 
138
  _CONVERT_MATRIX(A);
 
139
  _CONVERT_VECTOR2(X, Y);
 
140
  gsl_blas_dsymv(CBLAS_UPLO_val(uplo), Double_val(alpha),
 
141
                 &m_A, &v_X, Double_val(beta), &v_Y);
 
142
  return Val_unit;
 
143
}
 
144
 
 
145
value ml_gsl_blas_dsymv_bc(value *argv, int argc)
 
146
{
 
147
  return ml_gsl_blas_dsymv(argv[0], argv[1], argv[2],
 
148
                           argv[3], argv[4], argv[5]);
 
149
}
 
150
 
 
151
value ml_gsl_blas_dger(value alpha, value X, value Y, value A)
 
152
{
 
153
  _DECLARE_MATRIX(A);
 
154
  _DECLARE_VECTOR2(X, Y);
 
155
  _CONVERT_MATRIX(A);
 
156
  _CONVERT_VECTOR2(X, Y);
 
157
  gsl_blas_dger(Double_val(alpha), &v_X, &v_Y, &m_A);
 
158
  return Val_unit;
 
159
}
 
160
 
 
161
value ml_gsl_blas_dsyr(value uplo ,value alpha, value X, value A)
 
162
{
 
163
  _DECLARE_MATRIX(A);
 
164
  _DECLARE_VECTOR(X);
 
165
  _CONVERT_MATRIX(A);
 
166
  _CONVERT_VECTOR(X);
 
167
  gsl_blas_dsyr(CBLAS_UPLO_val(uplo), Double_val(alpha), 
 
168
                &v_X, &m_A);
 
169
  return Val_unit;
 
170
}
 
171
 
 
172
value ml_gsl_blas_dsyr2(value uplo ,value alpha, value X, value Y, value A)
 
173
{
 
174
  _DECLARE_MATRIX(A);
 
175
  _DECLARE_VECTOR2(X, Y);
 
176
  _CONVERT_MATRIX(A);
 
177
  _CONVERT_VECTOR2(X, Y);
 
178
  gsl_blas_dsyr2(CBLAS_UPLO_val(uplo), Double_val(alpha), 
 
179
                &v_X, &v_Y, &m_A);
 
180
  return Val_unit;
 
181
}
 
182
 
 
183
 
 
184
 
 
185
/* LEVEL3 double */
 
186
 
 
187
value ml_gsl_blas_dgemm(value transa, value transb, 
 
188
                        value alpha, value A, value B, 
 
189
                        value beta, value C)
 
190
{
 
191
  _DECLARE_MATRIX3(A, B, C);
 
192
  _CONVERT_MATRIX3(A, B, C);
 
193
  gsl_blas_dgemm(CBLAS_TRANS_val(transa), CBLAS_TRANS_val(transb),
 
194
                 Double_val(alpha), &m_A, &m_B, Double_val(beta), &m_C);
 
195
  return Val_unit;
 
196
}
 
197
 
 
198
value ml_gsl_blas_dgemm_bc(value *argv, int argc)
 
199
{
 
200
  return ml_gsl_blas_dgemm(argv[0], argv[1], argv[2],
 
201
                           argv[3], argv[4], argv[5], argv[6]);
 
202
}
 
203
 
 
204
 
 
205
value ml_gsl_blas_dsymm(value side, value uplo,
 
206
                        value alpha, value A, value B, 
 
207
                        value beta, value C)
 
208
{
 
209
  _DECLARE_MATRIX3(A, B, C);
 
210
  _CONVERT_MATRIX3(A, B, C);
 
211
  gsl_blas_dsymm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo),
 
212
                 Double_val(alpha), &m_A, &m_B, Double_val(beta), &m_C);
 
213
  return Val_unit;
 
214
}
 
215
 
 
216
value ml_gsl_blas_dsymm_bc(value *argv, int argc)
 
217
{
 
218
  return ml_gsl_blas_dsymm(argv[0], argv[1], argv[2],
 
219
                           argv[3], argv[4], argv[5], argv[6]);
 
220
}
 
221
 
 
222
value ml_gsl_blas_dtrmm(value side, value uplo,
 
223
                        value transa, value diag,
 
224
                        value alpha, value A, value B)
 
225
{
 
226
  _DECLARE_MATRIX2(A, B);
 
227
  _CONVERT_MATRIX2(A, B);
 
228
  gsl_blas_dtrmm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo),
 
229
                 CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag),
 
230
                 Double_val(alpha), &m_A, &m_B);
 
231
  return Val_unit;
 
232
}
 
233
 
 
234
value ml_gsl_blas_dtrmm_bc(value *argv, int argc)
 
235
{
 
236
  return ml_gsl_blas_dtrmm(argv[0], argv[1], argv[2],
 
237
                           argv[3], argv[4], argv[5], argv[6]);
 
238
}
 
239
 
 
240
value ml_gsl_blas_dtrsm(value side, value uplo,
 
241
                        value transa, value diag,
 
242
                        value alpha, value A, value B)
 
243
{
 
244
  _DECLARE_MATRIX2(A, B);
 
245
  _CONVERT_MATRIX2(A, B);
 
246
  gsl_blas_dtrsm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo),
 
247
                 CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag),
 
248
                 Double_val(alpha), &m_A, &m_B);
 
249
  return Val_unit;
 
250
}
 
251
 
 
252
value ml_gsl_blas_dtrsm_bc(value *argv, int argc)
 
253
{
 
254
  return ml_gsl_blas_dtrsm(argv[0], argv[1], argv[2],
 
255
                           argv[3], argv[4], argv[5], argv[6]);
 
256
}
 
257
 
 
258
value ml_gsl_blas_dsyrk(value uplo, value trans, value alpha, 
 
259
                        value A, value beta, value C)
 
260
{
 
261
  _DECLARE_MATRIX2(A, C);
 
262
  _CONVERT_MATRIX2(A, C);
 
263
  gsl_blas_dsyrk(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(trans), 
 
264
                 Double_val(alpha), &m_A,
 
265
                 Double_val(beta), &m_C);
 
266
  return Val_unit;
 
267
}
 
268
 
 
269
value ml_gsl_blas_dsyrk_bc(value *argv, int argc)
 
270
{
 
271
  return ml_gsl_blas_dsyrk(argv[0], argv[1], argv[2],
 
272
                           argv[3], argv[4], argv[5]);
 
273
}
 
274
 
 
275
 
 
276
value ml_gsl_blas_dsyr2k(value uplo, value trans, value alpha, 
 
277
                         value A, value B, value beta, value C)
 
278
{
 
279
  _DECLARE_MATRIX3(A, B, C);
 
280
  _CONVERT_MATRIX3(A, B, C);
 
281
  gsl_blas_dsyr2k(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(trans), 
 
282
                  Double_val(alpha), &m_A, &m_B,
 
283
                  Double_val(beta), &m_C);
 
284
  return Val_unit;
 
285
}
 
286
 
 
287
value ml_gsl_blas_dsyr2k_bc(value *argv, int argc)
 
288
{
 
289
  return ml_gsl_blas_dsyr2k(argv[0], argv[1], argv[2],
 
290
                            argv[3], argv[4], argv[5], argv[6]);
 
291
}