(*$B-,R+ Aufgaben 6.9 und 6.10 *)
PROGRAM summe;
VAR n,i,j,k,faktor, aufg : integer;
    x,y : ARRAY[0..10] OF real; zhj,h : real;

FUNCTION sum(n:integer):real;
VAR k: integer; s:real;
BEGIN
   CASE aufg OF
(* 6.9 *)
    1:  BEGIN  s:=0;
          FOR k := n DOWNTO 1 DO s := s + 1/k; s:= s-ln(n)
        END;
(* 6.10a) *)
    2:  BEGIN
           s :=0; FOR k:= n DOWNTO 1 DO s := s + sqr(1/k);
        END;
(* 6.10b) *)
    3: BEGIN  s :=0; (* aufpassen wegen integer Ueberlauf ! *)
          FOR k:= n DOWNTO 1 DO
             s := s + (1+1/k+1/k/k)/(3+1/k/k/k/k)/k/k;
          s := s+1;
       END;
   END;
   sum:=s
END;

BEGIN
  REPEAT
    writeln; writeln('1: Aufgabe 6.9');
    writeln('2: Aufgabe 6.10 a)');
    writeln('3: Aufgabe 6.10 b)'); writeln;
    writeln('Waehle: 1,2 oder 3 ? (0:fertig)');
    read(aufg);
    IF (0<aufg) and (aufg<4) THEN
    BEGIN
      y[0]:=sum(1);
      writeln(y[0]:7:4); i:=0; n :=1; faktor := 2;
      REPEAT
         n:=2*n; i:=i+1;
         y[i]:=sum(n); zhj:=1; k:=6;
         write(y[i]:13-k:10-k);
         FOR j:=i-1 DOWNTO 0 DO
         BEGIN
            k:=k-1;
            zhj:=zhj/faktor;
            y[j]:=(y[j+1]-zhj*y[j])/(1-zhj);
            write(y[j]:13-k:10-k)
         END;
         writeln
      UNTIL abs(y[0]-y[1])<=1e-8*abs(y[0]);
      writeln('extrapolierter Wert:',y[0])
   END
  UNTIL aufg=0
END.