Annotation of OpenXM_contrib/PHC/Ada/Continuation/vlprs_algorithm.adb, Revision 1.1.1.1
1.1 maekawa 1: with vLpRs_Tables; use vLpRs_Tables;
2: with Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
3: with Standard_Floating_Matrices_io; use Standard_Floating_Matrices_io;
4:
5: package body vLpRs_Algorithm is
6:
7: -- OUTPUT ROUTINES OF ERROR :
8:
9: procedure Write_Init ( file : in file_type; s,l,v : in Vector ) is
10:
11: -- DESCRIPTION :
12: -- Writes the beginning of the error table.
13:
14: tmp,err : double_float;
15: w : integer;
16:
17: begin
18: tmp := v(1)/l(1);
19: w := integer(tmp);
20: err := abs(tmp - double_float(w));
21: put(file,s(0),2,3,3); new_line(file);
22: put(file,s(1),2,3,3); put(file,err,2,3,3); new_line(file);
23: end Write_Init;
24:
25: procedure Write ( file : in file_type; k : in natural;
26: s : in double_float; l,v : in Vector ) is
27:
28: -- DESCRIPTION :
29: -- Writes an additional row of k columns of the error table.
30: -- Note that when m is wrong, the outcome is no longer integer.
31:
32: tmp,err : double_float;
33: w : integer;
34:
35: begin
36: put(file,s,2,3,3);
37: -- w := v(k)/l(k); --
38: w := integer(v(k)/l(k));
39: for i in 1..k loop
40: tmp := v(i)/l(i);
41: -- err := abs(tmp-w); --
42: err := abs(tmp - double_float(w));
43: put(file,err,2,3,3);
44: end loop;
45: new_line(file);
46: end Write;
47:
48: -- TARGET ROUTINES :
49:
50: procedure vLpRs_full
51: ( r : in natural; s,logs,logx : in Vector;
52: srp,dsp,p,l,v : in out Vector; rt1,rt2 : in out Matrix ) is
53: begin
54: vL_full(s(0..r),logs(0..r),logx(0..r),srp,dsp,p,l,v,rt1,rt2);
55: rt1 := rt2;
56: for k in r+1..s'last loop
57: vlprs_pipe(s(k),logs(k),logx(k),srp,dsp,p,l,v,rt1,rt2);
58: end loop;
59: end vLpRs_full;
60:
61: procedure vLpRs_pipe
62: ( file : in file_type; r : in natural;
63: s,logs,logx : in Vector; srp,dsp,p,l,v : in out Vector;
64: rt1,rt2 : in out Matrix ) is
65: begin
66: p(0) := 1.0; -- initialization
67: v(0..1) := logx(0..1);
68: l(0..1) := logs(0..1);
69: L_pipe(l(0..1),p(0..0),logs(1));
70: v_pipe(v(0..1),p(0..0),logx(1));
71: -- Write_Init(file,s,l,v); -- write the error table
72: for k in 2..r loop
73: p_full(s(0..k),srp(1..k-1),dsp(1..k-1),p(0..k-1),rt1,rt2);
74: L_pipe(l(0..k),p(0..k-1),logs(k)); -- extrapolate
75: v_pipe(v(0..k),p(0..k-1),logx(k));
76: -- Write(file,k,s(k),l,v); -- write the error table
77: -- put_line(file,"rt2 :"); put(file,rt2,3,3,3);
78: end loop;
79: rt1 := rt2;
80: for k in r+1..s'last loop
81: vlprs_pipe(file,s(k),logs(k),logx(k),srp,dsp,p,l,v,rt1,rt2);
82: -- put_line(file,"rt2 : "); put(file,rt2,3,3,3);
83: end loop;
84: end vLpRs_pipe;
85:
86: procedure vLpRs_pipe
87: ( s,logs,logx : in double_float;
88: srp,dsp,p,l,v : in out Vector; rt1,rt2 : in out Matrix ) is
89: begin
90: s_pipe(srp,s,dsp);
91: RR_pipe(rt1,dsp,p,rt2);
92: p_pipe(rt1,rt2,p); rt1 := rt2;
93: L_pipe(l,p,logs);
94: v_pipe(v,p,logx);
95: end vLpRs_pipe;
96:
97: procedure vLpRs_pipe
98: ( file : in file_type; s,logs,logx : in double_float;
99: srp,dsp,p,l,v : in out Vector; rt1,rt2 : in out Matrix ) is
100: begin
101: vLpRs_pipe(s,logs,logx,srp,dsp,p,l,v,rt1,rt2);
102: -- Write(file,l'last,s,l,v);
103: end vLpRs_pipe;
104:
105: end vLpRs_Algorithm;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>