← Back to branch summary

~ubuntu-branches/ubuntu/lucid/fpc/lucid-proposed

« back to all changes in this revision

Viewing changes to fpcsrc/packages/numlib/tests/eigbs3te.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-10-09 23:29:00 UTC
  • mfrom: (4.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20081009232900-553f61m37jkp6upv
Tags: 2.2.2-4
http://bugs.debian.org/498882
[ Torsten Werner ]
* Update ABI version in fpc-depends automatically.
* Remove empty directories from binary package fpc-source.

[ Mazen Neifer ]
* Removed leading path when calling update-alternatives to remove a Linitian
  error.
* Fixed clean target.
* Improved description of packages. (Closes: #498882)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/numlib/tests/eigbs3te.pas
 
1
program eigbs3te;
 
2
 
 
3
uses
 
4
  typ,
 
5
  iom,
 
6
  eig,
 
7
  omv;
 
8
 
 
9
const
 
10
  n1  = -100;
 
11
  n2  = 100;
 
12
  i1  = -10;
 
13
  i2  = 10;
 
14
  rwx = i2 - i1 + 1;
 
15
var
 
16
  ex, nex, nel, ind, p, q, r, s, n, i, j, b, term: ArbInt;
 
17
  a:   array[n1..n2] of ArbFloat;
 
18
  lam: array[i1..i2] of ArbFloat;
 
19
  x, mat, e: array[i1..i2, i1..i2] of ArbFloat;
 
20
begin
 
21
  Write(' program results eigbs3te');
 
22
  case sizeof(ArbFloat) of
 
23
    4: writeln('(single)');
 
24
    6: writeln('(real)');
 
25
    8: writeln('(double)');
 
26
  end;
 
27
  Read(nex);
 
28
  writeln;
 
29
  writeln('number of examples', nex: 2);
 
30
  writeln;
 
31
  for ex := 1 to nex do
 
32
  begin
 
33
    writeln('example number', ex: 2);
 
34
    writeln;
 
35
    Read(p, q, r, s, n, b);
 
36
    nel := n * (b + 1) - (b * (b + 1)) div 2;
 
37
    iomrev(input, a[p], nel);
 
38
    eigbs3(a[p], n, b, lam[q], x[r, s], rwx, term);
 
39
    writeln(' A = ');
 
40
    iomwrv(output, a[p], nel, numdig);
 
41
    writeln;
 
42
    writeln('term=', term: 2);
 
43
    if term = 1 then
 
44
    begin
 
45
      writeln;
 
46
      writeln('lambda=');
 
47
      iomwrv(output, lam[q], n, numdig);
 
48
      writeln;
 
49
      writeln('X=');
 
50
      iomwrm(output, x[r, s], n, n, rwx, numdig);
 
51
      ind := p;
 
52
      for i := 1 to n do
 
53
        for j := 1 to i do
 
54
          if j < i - b then
 
55
            mat[i + r - 1, j + s - 1] := 0
 
56
          else
 
57
          begin
 
58
            mat[i + r - 1, j + s - 1] := a[ind];
 
59
            ind := ind + 1;
 
60
          end;
 
61
      for i := 1 to n do
 
62
        for j := i + 1 to n do
 
63
          mat[i + r - 1, j + s - 1] := mat[j + r - 1, i + s - 1];
 
64
      writeln;
 
65
      writeln(' matrix A =');
 
66
      iomwrm(output, mat[r, s], n, n, rwx, numdig);
 
67
      writeln;
 
68
      writeln('Ax-lambda.x = ');
 
69
      omvmmm(mat[r, s], n, n, rwx, x[r, s], n, rwx, e[r, s], rwx);
 
70
      for j := 1 to n do
 
71
        for i := 1 to n do
 
72
          e[i + r - 1, j + s - 1] := e[i + r - 1, j + s - 1] - lam[q + j - 1] * x[i + r - 1, j + s - 1];
 
73
      iomwrm(output, e[r, s], n, n, rwx, numdig);
 
74
    end;
 
75
    writeln;
 
76
    writeln('-------------------------------------------');
 
77
  end;
 
78
  Close(input);
 
79
  Close(output);
 
80
end.
 
81
program eigbs3te;
 
82
 
 
83
uses
 
84
  typ,
 
85
  iom,
 
86
  eig,
 
87
  omv;
 
88
 
 
89
const
 
90
  n1  = -100;
 
91
  n2  = 100;
 
92
  i1  = -10;
 
93
  i2  = 10;
 
94
  rwx = i2 - i1 + 1;
 
95
var
 
96
  ex, nex, nel, ind, p, q, r, s, n, i, j, b, term: ArbInt;
 
97
  a:   array[n1..n2] of ArbFloat;
 
98
  lam: array[i1..i2] of ArbFloat;
 
99
  x, mat, e: array[i1..i2, i1..i2] of ArbFloat;
 
100
begin
 
101
  Write(' program results eigbs3te');
 
102
  case sizeof(ArbFloat) of
 
103
    4: writeln('(single)');
 
104
    6: writeln('(real)');
 
105
    8: writeln('(double)');
 
106
  end;
 
107
  Read(nex);
 
108
  writeln;
 
109
  writeln('number of examples', nex: 2);
 
110
  writeln;
 
111
  for ex := 1 to nex do
 
112
  begin
 
113
    writeln('example number', ex: 2);
 
114
    writeln;
 
115
    Read(p, q, r, s, n, b);
 
116
    nel := n * (b + 1) - (b * (b + 1)) div 2;
 
117
    iomrev(input, a[p], nel);
 
118
    eigbs3(a[p], n, b, lam[q], x[r, s], rwx, term);
 
119
    writeln(' A = ');
 
120
    iomwrv(output, a[p], nel, numdig);
 
121
    writeln;
 
122
    writeln('term=', term: 2);
 
123
    if term = 1 then
 
124
    begin
 
125
      writeln;
 
126
      writeln('lambda=');
 
127
      iomwrv(output, lam[q], n, numdig);
 
128
      writeln;
 
129
      writeln('X=');
 
130
      iomwrm(output, x[r, s], n, n, rwx, numdig);
 
131
      ind := p;
 
132
      for i := 1 to n do
 
133
        for j := 1 to i do
 
134
          if j < i - b then
 
135
            mat[i + r - 1, j + s - 1] := 0
 
136
          else
 
137
          begin
 
138
            mat[i + r - 1, j + s - 1] := a[ind];
 
139
            ind := ind + 1;
 
140
          end;
 
141
      for i := 1 to n do
 
142
        for j := i + 1 to n do
 
143
          mat[i + r - 1, j + s - 1] := mat[j + r - 1, i + s - 1];
 
144
      writeln;
 
145
      writeln(' matrix A =');
 
146
      iomwrm(output, mat[r, s], n, n, rwx, numdig);
 
147
      writeln;
 
148
      writeln('Ax-lambda.x = ');
 
149
      omvmmm(mat[r, s], n, n, rwx, x[r, s], n, rwx, e[r, s], rwx);
 
150
      for j := 1 to n do
 
151
        for i := 1 to n do
 
152
          e[i + r - 1, j + s - 1] := e[i + r - 1, j + s - 1] - lam[q + j - 1] * x[i + r - 1, j + s - 1];
 
153
      iomwrm(output, e[r, s], n, n, rwx, numdig);
 
154
    end;
 
155
    writeln;
 
156
    writeln('-------------------------------------------');
 
157
  end;
 
158
  Close(input);
 
159
  Close(output);
 
160
end.