Annotation of OpenXM_contrib/PHC/Ada/Continuation/vlprs_algorithm.adb, Revision 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>