share/lapack/rtest_dgeqrf.mac

   1 /* rtest_dgeqrf.mac -- test script for dgeqrf
   2  * Copyright 2011 by Robert Dodier
   3  * I release this work under terms of the GNU General Public License.
   4  */
   5
   6 (if not ?fboundp ('dgeqrf) then load (lapack), 0);
   7 0;
   8
   9 (random_matrix () := block ([nr : 5 + random (10), nc : 5 + random (10)],
  10   genmatrix (lambda ([i, j], random (100.0) - 50), nr, nc)), 0);
  11 0;
  12
  13 set_random_state (make_random_state (12345));
  14 done;
  15
  16 block ([a, q, r],
  17   a : random_matrix (),
  18   [q, r] : dgeqrf (a),
  19   mat_norm (q . r - a, 1),
  20   if %% < 1e-12 then true else [a, q, r, %%]);
  21 true;
  22
  23 block ([a, q, r],
  24   a : random_matrix (),
  25   [q, r] : dgeqrf (a),
  26   mat_norm (q . r - a, 1),
  27   if %% < 1e-12 then true else [a, q, r, %%]);
  28 true;
  29
  30 block ([a, q, r],
  31   a : random_matrix (),
  32   [q, r] : dgeqrf (a),
  33   mat_norm (q . r - a, 1),
  34   if %% < 1e-12 then true else [a, q, r, %%]);
  35 true;
  36
  37 block ([a, q, r],
  38   a : random_matrix (),
  39   [q, r] : dgeqrf (a),
  40   mat_norm (q . r - a, 1),
  41   if %% < 1e-12 then true else [a, q, r, %%]);
  42 true;
  43
  44 block ([a, q, r],
  45   a : random_matrix (),
  46   [q, r] : dgeqrf (a),
  47   mat_norm (q . r - a, 1),
  48   if %% < 1e-12 then true else [a, q, r, %%]);
  49 true;
  50
  51 block ([a, q, r],
  52   a : random_matrix (),
  53   [q, r] : dgeqrf (a),
  54   mat_norm (q . r - a, 1),
  55   if %% < 1e-12 then true else [a, q, r, %%]);
  56 true;
  57
  58 block ([a, q, r],
  59   a : random_matrix (),
  60   [q, r] : dgeqrf (a),
  61   mat_norm (q . r - a, 1),
  62   if %% < 1e-12 then true else [a, q, r, %%]);
  63 true;
  64
  65 block ([a, q, r],
  66   a : random_matrix (),
  67   [q, r] : dgeqrf (a),
  68   mat_norm (q . r - a, 1),
  69   if %% < 1e-12 then true else [a, q, r, %%]);
  70 true;
  71
  72 block ([a, q, r],
  73   a : random_matrix (),
  74   [q, r] : dgeqrf (a),
  75   mat_norm (q . r - a, 1),
  76   if %% < 1e-12 then true else [a, q, r, %%]);
  77 true;
  78
  79 block ([a, q, r],
  80   a : random_matrix (),
  81   [q, r] : dgeqrf (a),
  82   mat_norm (q . r - a, 1),
  83   if %% < 1e-12 then true else [a, q, r, %%]);
  84 true;
  85
  86 block ([a, q, r],
  87   a : random_matrix (),
  88   [q, r] : dgeqrf (a),
  89   mat_norm (q . r - a, 1),
  90   if %% < 1e-12 then true else [a, q, r, %%]);
  91 true;
  92
  93 block ([a, q, r],
  94   a : random_matrix (),
  95   [q, r] : dgeqrf (a),
  96   mat_norm (q . r - a, 1),
  97   if %% < 1e-12 then true else [a, q, r, %%]);
  98 true;
  99