Return to floating_support_functions.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Supports

Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Supports/floating_support_functions.adb, Revision 1.1.1.1

1.1       maekawa     1: package body Floating_Support_Functions is
                      2:
                      3:   function Maximal_Support ( l : List; v : Vector ) return double_float is
                      4:
                      5:     sp,max : double_float;
                      6:     tmp : List;
                      7:
                      8:   begin
                      9:     if not Is_Null(l)
                     10:      then max := Head_Of(l).all*v;
                     11:           tmp := Tail_Of(l);
                     12:           while not Is_Null(tmp) loop
                     13:             sp := Head_Of(tmp).all*v;
                     14:             if sp > max
                     15:              then max := sp;
                     16:             end if;
                     17:             tmp := Tail_Of(tmp);
                     18:           end loop;
                     19:           return max;
                     20:      else return 0.0;
                     21:     end if;
                     22:   end Maximal_Support;
                     23:
                     24:   function Minimal_Support ( l : List; v : Vector ) return double_float is
                     25:
                     26:     sp,min : double_float;
                     27:     tmp : List;
                     28:
                     29:   begin
                     30:     if not Is_Null(l)
                     31:      then min := Head_Of(l).all*v;
                     32:           tmp := Tail_Of(l);
                     33:           while not Is_Null(tmp) loop
                     34:             sp := Head_Of(tmp).all*v;
                     35:             if sp < min
                     36:              then min := sp;
                     37:             end if;
                     38:             tmp := Tail_Of(tmp);
                     39:           end loop;
                     40:           return min;
                     41:      else return 0.0;
                     42:     end if;
                     43:   end Minimal_Support;
                     44:
                     45:   function Face ( l : List; v : Vector; m,tol : double_float ) return List is
                     46:
                     47:     res,tmp,res_last : List;
                     48:     d : Vector(v'range);
                     49:
                     50:   begin
                     51:     tmp := l;
                     52:     while not Is_Null(tmp) loop
                     53:       d := Head_Of(tmp).all;
                     54:       if abs(d*v - m) < tol
                     55:        then Append(res,res_last,d);
                     56:       end if;
                     57:       tmp := Tail_Of(tmp);
                     58:     end loop;
                     59:     return res;
                     60:   end Face;
                     61:
                     62: end Floating_Support_Functions;