(*$B- Aufgabe 5.13 *)
PROGRAM zeilengivens;
CONST nd = 20; (* N < ND *)
VAR v: ARRAY[1..200] OF real; d,x: ARRAY [1..nd] OF real;
    n,i,j,k,min,ind : integer; co,si,h,residuum : real ;

BEGIN
  writeln('Anzahl Unbekannte ?'); read(n);
  k := 0; residuum:=0;
  REPEAT
    k := k + 1;
    writeln('naechste Gleichung eingeben');
    FOR j := 1 TO n+1 DO read(d[j]);
    IF k<=n THEN min := k-1 ELSE min := n;
    FOR i := 1 TO min DO
    BEGIN
      IF d[i]<>0 THEN
      BEGIN
        ind:=i*(i+1) DIV 2;
        h:=v[ind]/d[i]; si:=1/sqrt(1+h*h);co:=si*h;
        v[ind] := v[ind]*co+d[i]*si;
        FOR j:= i+1 TO n+1 DO
        BEGIN
         ind:=i+j*(j-1) DIV 2;
         h:=v[ind]*co+d[j]*si;
         d[j]:=-v[ind]*si+d[j]*co;v[ind]:=h;
        END;
      END;
    END;
    IF k<=n THEN FOR j:=k TO n+1 DO v[k+j*(j-1) DIV 2]:=d[j]
    ELSE residuum:= residuum + sqr(d[n+1]);

    IF k>=n THEN
    BEGIN
      (* Rueckwaetrseinsetzen *)
      FOR i := n DOWNTO 1 DO
      BEGIN
        h := v[i+(n+1)*n DIV 2];
        FOR j := i+1 TO n DO h:=h-v[i+j*(j-1) DIV 2]*x[j];
        ind:=i*(i+1) DIV 2;
        IF v[ind]<>0 THEN x[i] := h/v[ind]
        ELSE BEGIN writeln('singulaer');x[i]:=h*1e11 END;
      END;
      writeln('Loesung x, Diagonalelemente von R: r[i,i]');
      FOR i := 1 TO n DO writeln(x[i]:12:8,v[i*(i+1) DIV 2]:20);
      writeln('Residuenquadrat  ',residuum);
    END;
  UNTIL eof
 END.