[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     ! 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>