1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158 | with Ada.Text_IO; use Ada.Text_IO;
package body gsl.vector_double is
use double_text_Io;
use size_t_text_Io;
procedure WriteCSV
(v : access constant gsl_vector; fn : String;
v1 : access constant gsl_vector := null;
v2 : access constant gsl_vector := null;
v3 : access constant gsl_vector := null;
v4 : access constant gsl_vector := null;
v5 : access constant gsl_vector := null;
v6 : access constant gsl_vector := null)
is
f : File_Type;
begin
Create (f, Out_File, fn);
Set_Output (f);
for i in 1 .. v.size loop
Put (i);
Put (" ; ");
Put (get (v, i - 1));
Put (" ; ");
if v1 /= null then
Put (get (v1, i - 1));
Put (" ; ");
end if;
if v2 /= null then
Put (get (v2, i - 1));
Put (" ; ");
end if;
if v3 /= null then
Put (get (v3, i - 1));
Put (" ; ");
end if;
if v4 /= null then
Put (get (v4, i - 1));
Put (" ; ");
end if;
if v5 /= null then
Put (get (v5, i - 1));
Put (" ; ");
end if;
if v6 /= null then
Put (get (v6, i - 1));
Put (" ; ");
end if;
New_Line;
end loop;
Set_Output (Standard_Output);
Close (f);
end WriteCSV;
function fprintf
(v : access constant gsl_vector; filename : String; format : String)
return int
is
cfilename : aliased String := filename & ASCII.nul;
cmode : aliased String := "w" & ASCII.nul;
file : Interfaces.C_Streams.FILEs;
Status : int;
Status2 : Integer;
begin
file := Interfaces.C_Streams.fopen (cfilename'Address, cmode'Address);
Status := fprintf (file, v, Interfaces.C.Strings.New_String (format));
Status2 := Interfaces.C_Streams.fclose (file);
return Status;
end fprintf;
function To_Ada
(c : access constant gsl_vector)
return Ada.Numerics.Long_Real_Arrays.Real_Vector
is
av : Ada.Numerics.Long_Real_Arrays.Real_Vector (1 .. Integer (c.size));
begin
for i in 1 .. Integer (c.size) loop
av (i) := Long_Float (vector_double.get (c, size_t (i)));
end loop;
return av;
end To_Ada;
function To_C
(a : Ada.Numerics.Long_Real_Arrays.Real_Vector) return access gsl_vector
is
cout : access gsl_vector;
begin
cout := alloc (size_t (a'Length));
for i in 1 .. a'Length loop
Set (cout, size_t (i), double (a (i)));
end loop;
return cout;
end To_C;
function To_Ada
(c : access constant gsl_vector)
return Ada.Numerics.Real_Arrays.Real_Vector
is
av : Ada.Numerics.Real_Arrays.Real_Vector (1 .. Integer (c.size));
begin
for i in 1 .. Integer (c.size) loop
av (i) := Float (get (c, size_t (i - 1)));
end loop;
return av;
end To_Ada;
function To_C
(a : Ada.Numerics.Real_Arrays.Real_Vector) return access gsl_vector
is
cout : access gsl_vector;
begin
cout := alloc (size_t (a'Length));
for i in 1 .. a'Length loop
Set (cout, size_t (i), double (a (i)));
end loop;
return cout;
end To_C;
procedure Set( from : access gsl.vector_double.gsl_vector ; to : in out double_array ) is
begin
if to'Length /= from.size
then
raise Program_Error with "Incompatible sizes" ;
end if ;
declare
f : array(1..from.size) of double ;
for f'Address use from.data.all'Address ;
begin
for i in 1..from.size
loop
to(to'First+Integer(i)-1) := f(i);
end loop ;
end ;
end Set ;
procedure Set( from : double_array ; to : access gsl.vector_double.gsl_vector ) is
begin
if to.size /= from'Length
then
raise Program_Error with "Incompatible sizes" ;
end if ;
declare
t : array(1..to.size) of double ;
for t'address use to.data.all'Address ;
begin
for i in 1..from'Length
loop
t(size_t(i)) := from(from'First+Integer(i)-1);
end loop ;
end ;
end Set ;
begin
double_text_Io.Default_exp := 0;
double_text_Io.Default_aft := 4;
end gsl.vector_double;
|