01 семестр / К экзамену-зачёту / Все задачи с экзамена в формате PAS / Alex / SERG

uses crt ;
var e:char;
    k:integer;
Function F(x:real):real;
var ff:real;
Begin ff:=x*x;
      f:=ff;
End;
Procedure P;
var a,b,eps,h,It,Ip,sum,r:real;
    j,m:integer;
    i,n:longint;
Begin clrscr;
      writeln('                        ЊҐв®¤ Їаאַ㣮«м­ЁЄ®ў');
      writeln('‡ ¤ ©вҐ ЇаҐ¤Ґ«л Ё­вҐЈаЁа®ў ­Ёп:');
      write('a='); readln(a);
      write('b='); readln(b);
      write('‡ ¤ ©вҐ в®з­®бвм  eps= '); readln(eps);
      write('‡ ¤ ©вҐ зЁб«® ®ЇҐа жЁ©  m= '); readln(m);
      if a>b then begin
                  r:=b;
                  b:=a;
                  a:=r;
                  end;
      h:=sqrt(eps);
      n:=trunc((b-a)/h)+1;
      h:=(b-a)/n;
      Ip:=0;
      repeat;
      writeln('         Ipred                     I                іI-Ipredі  ');
      for j:=1 to m do begin {j}
          sum:=0;
          for i:=1 to n do begin {i}
              sum:=sum+F(a+h/2+(i-1)*h);
                           end{i};
          It:=sum*h;
          writeln(' ',Ip:17,'    ',It:17,'       ',abs(Ip-It):17);
          Ip:=It;
          n:=n*2;
          h:=h/2;
                       end{j};
      writeln('Ќ ¦¬ЁвҐ «оЎго Є« ўЁиг (ENTER-Їа®¤®«¦Ёвм)...');
      e:=readkey;
      until e<>#13;
End;
Procedure T;
var a,b,eps,h,It,Ip,sum,r:real;
    j,m:integer;
    i,n:longint;
Begin clrscr;
      writeln('                        ЊҐв®¤ ва ЇҐжЁ©');
      writeln('‡ ¤ ©вҐ ЇаҐ¤Ґ«л Ё­вҐЈаЁа®ў ­Ёп:');
      write('a='); readln(a);
      write('b='); readln(b);
      write('‡ ¤ ©вҐ в®з­®бвм  eps= '); readln(eps);
      write('‡ ¤ ©вҐ зЁб«® ®ЇҐа жЁ©  m= '); readln(m);
      if a>b then begin
                  r:=b;
                  b:=a;
                  a:=r;
                  end;
      h:=sqrt(eps);
      n:=trunc((b-a)/h)+1;
      h:=(b-a)/n;
      Ip:=0;
      repeat
      writeln('          Ipred               I               іI-Ipredі  ');
      for j:=1 to m do begin {j}
          sum:=(F(a)+F(b))/2;
          for i:=1 to n-1 do begin {i}
              sum:=sum+F(a+i*h);
                           end{i};
          It:=sum*h;
          writeln(' ',Ip:17,'   ',It:17,'      ',abs(Ip-It):17);
          Ip:=It;
          n:=n*2;
          h:=h/2;
                       end{j};
      writeln('Ќ ¦¬ЁвҐ «оЎго Є« ўЁиг (ENTER-Їа®¤®«¦Ёвм)...');
      e:=readkey;
      until e<>#13;
End;
Procedure S;
var a,b,eps,h,It,Ip,sum,s1,s2,r:real;
    j,m:integer;
    i,n:longint;
Begin clrscr;
      writeln('                        ЊҐв®¤ Ї а Ў®«');
      writeln('‡ ¤ ©вҐ ЇаҐ¤Ґ«л Ё­вҐЈаЁа®ў ­Ёп:');
      write('a='); readln(a);
      write('b='); readln(b);
      write('‡ ¤ ©вҐ в®з­®бвм  eps= '); readln(eps);
      write('‡ ¤ ©вҐ зЁб«® ®ЇҐа жЁ©  m= '); readln(m);
      if a>b then begin
                  r:=b;
                  b:=a;
                  a:=r;
                  end;
      h:=sqrt(sqrt(eps));
      n:=trunc((b-a)/h)+1;
      if n mod 2 =1 then n:=n+1;
      h:=(b-a)/n;
      Ip:=0;
      repeat
      writeln('         Ipred                     I                іI-Ipredі  ');
      for j:=1 to m do begin {j}
          sum:=f(a); s1:=0; s2:=0;
          for i:=1 to n do begin {i}
              r:=f(a+i*h);
              if (i=n) then sum:=sum+r else
              if i mod 2 =1 then s1:=s1+r else
              if i mod 2 =0 then s2:=s2+r;
                           end{i};
          It:=(sum+4*s1+2*s2)*h/3;
          writeln('  ',Ip:17,'    ',It:17,'       ',abs(Ip-It):17);
          Ip:=It;
          n:=n*2;
          h:=h/2;
                       end{j};
      writeln('Ќ ¦¬ЁвҐ «оЎго Є« ўЁиг (ENTER-Їа®¤®«¦Ёвм)...');
      e:=readkey;
      until e<>#13;
End;

Begin textbackground(lightblue);
      k:=10;
      repeat
      clrscr;
      textcolor(lightred);
      writeln('                       ‚лзЁб«Ґ­ЁҐ Ї«®й ¤Ґ© дЁЈга');
      textcolor(white);
      writeln;
      writeln(' 1 - ¬Ґв®¤ Їаאַ㣮«м­ЁЄ®ў ');
      writeln(' 2 - ¬Ґв®¤ ва ЇҐжЁ©        ');
      writeln(' 3 - ¬Ґв®¤ Ї а Ў®«         ');
      write(' 0 - ўл室                      : ');
      readln(k);
      case k of
      1: P;
      2: T;
      3: S;
      end{case};
      until k=0;
End.