program Maschinenzahltest(input,output);

use i_ari;

var e : integer;
    i : interval;
   
begin
  e := 1;
  while e <> 0 do 
    begin
      write('Zu testende Dezimalzahl = '); read(i);
      if inf(i) = sup(i) then 
        writeln('ist eine Maschinenzahl !')
      else
        writeln('ist keine Maschinenzahl !');
      writeln;
      write('(Weiter = 1, Ende = 0)  '); read(e);
    end
end.

-------------------------------------------

Zu testende Dezimalzahl = 0.50000125
ist keine Maschinenzahl !

(Weiter = 1, Ende = 0)  1
Zu testende Dezimalzahl = 0.625
ist eine Maschinenzahl !

(Weiter = 1, Ende = 0)  1
Zu testende Dezimalzahl = 0.1
ist keine Maschinenzahl !

(Weiter = 1, Ende = 0)  0

-------------------------------------------------------------------------------

program NullSteigung(input,output);

use i_ari;

var links,rechts,wert_links,wert_rechts : interval;
    i, res				: interval;

function imc(i : interval) : interval;
begin
  imc := i - cos(i);
end;

begin
  links :=  0.7390851325;
  rechts := 0.7390851335;
  i := links+*rechts; {Intervall-Huelle}
  res := imc(i);
  if (inf(res) > 0.0) or (sup(res) < 0.0) then
    writeln('Keine Nullstelle im betrachteten Intervall!')
  else
    begin
      wert_links := imc(links);
      wert_rechts := imc(rechts);
      if (inf(wert_links) >= 0.0) and (sup(wert_rechts) <= 0.0) or
         (sup(wert_links) <= 0.0) and (inf(wert_rechts) >= 0.0) then
        writeln('Es gibt eine Nullstelle im betrachteten Intervall!')
      else
        writeln('Unklarer Fall!');
    end
end.
    
-------------------------------------------

Es gibt eine Nullstelle im betrachteten Intervall!

-------------------------------------------------------------------------------

program quadGl(input,output);

use i_ari;

var A,B,C,nenn,m,r,rp,rn,d,x1,x2 : interval;

begin

  writeln('Einschliessung der Loesungen einer quadratischen Gleichung');
  writeln('axx + bx + cx = 0 fuer a aus A (mit 0 nicht in A),');
  writeln('b aus B und c aus C');
  writeln;
  write('A = '); read(A);
  write('B = '); read(B);
  write('C = '); read(C); writeln;

  nenn := 2*A; 
  m := -B/nenn;
  r := ##(B*B - A*C - A*C - A*C - A*C);
  {Weniger genaue Alternative : r := sqr(B) - 4*A*C;}

  if inf(r) > 0.0 then 
    begin
      d := sqrt(r)/nenn;
      x1 := m - d; x2 := m + d;
      writeln('Zwei (versch.) reelle Loesungen,');
      writeln('eine in ',x1,',');
      writeln('eine in ',x2);
    end
  else {inf(r) <= 0.0}
    begin
      if sup(r) < 0.0 then
        begin
          d := sqrt(-r)/nenn;
          writeln('Zwei (versch.) konjugiert komplexe Loesungen');
          writeln('mit Realteil in ',m);
          writeln('und Imaginaerteil in ',d);
          writeln('bzw in ',-d);
        end
      else {inf(r) <= 0.0 und sup(r) >= 0.0}
        begin
          rp := intval(0.0,sup(r));
          d := sqrt(rp)/nenn;
          x1 := m - d; x2 := m + d;
          writeln('Zwei (versch.) reelle Loesungen,');
          writeln('eine in ',x1,',');
          writeln('eine in ',x2);

          writeln('oder');

          writeln('eine zweifache (reelle) Loesung in ',m);

          writeln('oder');

          rn := intval(0.0,-inf(r));
          d := sqrt(rn)/nenn;
          writeln('zwei (versch.) konjugiert komplexe Loesungen');
          writeln('mit Realteil in ',m);
          writeln('und Imaginaerteil in ',d);
          writeln('bzw in ',-d);
        end
    end

end.
    
-------------------------------------------

Einschliessung der Loesungen einer quadratischen Gleichung
axx + bx + cx = 0 fuer a aus A (mit 0 nicht in A),
b aus B und c aus C

A = [0.0995,0.1005]
B = [0.1395,0.1405]
C = [-0.3515,-0.3505]

Zwei (versch.) reelle Loesungen,
eine in [               -2.8E+000,               -2.6E+000 ],
eine in [                1.2E+000,                1.4E+000 ]
    
-------------------------------------------

Einschliessung der Loesungen einer quadratischen Gleichung
axx + bx + cx = 0 fuer a aus A (mit 0 nicht in A),
b aus B und c aus C

A = -1.1
B = 2.86
C = -1.859

Zwei (versch.) reelle Loesungen,
eine in [          1.2999999E+000,          1.3000001E+000 ],
eine in [          1.2999999E+000,          1.3000001E+000 ]
oder
eine zweifache (reelle) Loesung in [  1.299999999999999E+000,  1.300000000000001E+000 ]
oder
zwei (versch.) konjugiert komplexe Loesungen
mit Realteil in [  1.299999999999999E+000,  1.300000000000001E+000 ]
und Imaginaerteil in [               -2.2E-008,                0.0E+000 ]
bzw in [                0.0E+000,                2.2E-008 ]
  
-------------------------------------------

Einschliessung der Loesungen einer quadratischen Gleichung
axx + bx + cx = 0 fuer a aus A (mit 0 nicht in A),
b aus B und c aus C

A = [0.695,0.705]
B = [-1.825,-1.815]
C = [4.265,4.275]

Zwei (versch.) konjugiert komplexe Loesungen
mit Realteil in [                1.2E+000,                1.4E+000 ]
und Imaginaerteil in [                2.0E+000,                2.2E+000 ]
bzw in [               -2.2E+000,               -2.0E+000 ]

-------------------------------------------------------------------------------

program Hoeheneinschliessung(input,output);

use i_ari;

var alpha1,alpha2,phi1,phi2,s,h1,h2,nenn,Hoehe1,Hoehe2,Hoehe : interval;

procedure swriteln(i : interval);
begin
  writeln('[',i.inf:7:3:-1,',',i.sup:7:3:1,']')
end;

begin

  alpha1 := intval(1.0711,1.0719);
  alpha2 := intval(1.0300,1.0308);
  phi1 := intval(0.5411,0.5419);
  phi2 := intval(0.5233,0.5241);
  s := intval(65.22,65.25);
  h1 := intval(1.708,1.712);
  h2 := intval(2.372,2.376);

  nenn := sin(alpha1 + alpha2);
  Hoehe1 := h1 + s*sin(alpha2)*tan(phi1)/nenn;
  Hoehe2 := h2 + s*sin(alpha1)*tan(phi2)/nenn;
  if Hoehe1 >< Hoehe2 then 
    writeln('Widerspruechliche Messungen!')
  else
    begin
      Hoehe := Hoehe1**Hoehe2;
      write('Hoehe aus '); swriteln(hoehe)
    end

end.
  
-------------------------------------------

Hoehe aus [ 40.658, 40.804]