adagsl_335d13f0/gsl/src/gsl-matrix_double.adb

 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
package body gsl.matrix_double is
   function fprintf
     (m : access constant gsl_matrix; 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, m, Interfaces.C.Strings.New_String (format));
      Status2 := Interfaces.C_Streams.fclose (file);
      return Status;
   end fprintf;

   function To_Ada
     (c : access constant gsl_matrix)
      return Ada.Numerics.Long_Real_Arrays.Real_Matrix
   is
      a : Ada.Numerics.Long_Real_Arrays.Real_Matrix
        (1 .. Integer (c.size1), 1 .. Integer (c.size2));
   begin
      for i in 1 .. Integer (c.size1) loop
         for j in 1 .. Integer (c.size2) loop
            a (i, j) :=
              Long_Float (matrix_double.get (c, size_t (i), size_t (j)));
         end loop;
      end loop;
      return a;
   end To_Ada;
   function To_C
     (a : Ada.Numerics.Long_Real_Arrays.Real_Matrix) return access gsl_matrix
   is
      cmat : access gsl_matrix;
   begin
      cmat := alloc (a'Length (1), a'Length (2));
      for i in 1 .. a'Length (1) loop
         for j in 1 .. a'Length (2) loop
            set (cmat, size_t (i), size_t (j), double (a (i, j)));
         end loop;
      end loop;
      return cmat;
   end To_C;

end gsl.matrix_double;