[BACK]Return to vlprs_algorithm.adb CVS log [TXT][DIR] Up to [local] / OpenXM_contrib / PHC / Ada / Continuation

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>