(*$B- AUFGABE 2.1 *)
PROGRAM qgleich;
TYPE zustand=(beliebig,keine,eine,komplex,doppel,reell);
VAR a,b,c,x1,x2 : real;
    info: zustand;

PROCEDURE quad(a,b,c: real; VAR x1,x2: real; VAR info:zustand);
VAR p,q,diskr,fak,max :real;
BEGIN
  max:=abs(a);
  IF abs(b)> max THEN max :=abs(b);
  IF abs(c)> max THEN max :=abs(c);
  IF max = 0 THEN info:= beliebig
  ELSE
   BEGIN
     a:=a/max; b:=b/max; c:=c/max;
     IF a=0 THEN
       IF b=0 THEN info := keine
       ELSE BEGIN info :=eine; x1:=-c/b END
     ELSE
      BEGIN
        p:=b/a; q:=c/a;
        IF abs(p)>1 THEN
        BEGIN fak:=abs(p); diskr:=0.25-q/p/p END
        ELSE
        BEGIN fak:=1; diskr:=sqr(p/2)-q END;
        IF diskr<0 THEN
        BEGIN
          info:=komplex; x1:=-p/2; x2:=fak*sqrt(-diskr)
        END
        ELSE
        BEGIN
          x1:=abs(p/2)+fak*sqrt(diskr);
          IF p>0 THEN x1:=-x1;
          IF x1=0 THEN x2:=0 ELSE x2:=q/x1;
          IF diskr=0 THEN info := doppel
          ELSE info := reell
        END
      END
     END
 END;
BEGIN
REPEAT
  writeln('Koeffizienten a,b,c ?'); read(a,b,c);
  writeln(a,' x**2 + ',b,' x + ',c,' = 0 hat ');
  quad(a,b,c,x1,x2,info);
  CASE info OF
    keine:     writeln('keine Loesung');
    eine:      writeln('die Loesung x=',x1);
    beliebig:  writeln('jedes x als Loesung');
    reell:     writeln('die beiden Loesungen ', x1,' und ',x2);
    doppel:    writeln('die Doppelloesung x1=x2=',x1);
    komplex:   writeln('die komplexen Loesungen ',x1,' +- I* ',x2)
  END;
 UNTIL eof
END.