Скачиваний:
26
Добавлен:
09.12.2013
Размер:
2.69 Кб
Скачать
program thebuch;
uses crt;
const e=0.001;
a=0;
b=1;
t=0.7947;
var xa,xb,e1,s1,s2,eq:real;
q1:array[0..100] of real;
q2:array[0..100] of real;
ep1:array[0..100] of real;
ep2:array[0..100] of real;
h1:array[0..100] of real;
h2:array[0..100] of real;
i,i1,i2:integer;

function f(x:real):real;
begin
f:=(x*x)*sin(4*ln(x))/ln(x)
end;

function epsi(a,b:real):real;
var f4,x9:real;
begin
x9:=(b+a)/2;
f4:=((2*x9*sin(4*ln(x9))/ln(x9))+(4*x9*cos(4*ln(x9))/ln(x9))+(x9*sin(4*ln(x9))/ln(x9)*ln(x9)));
epsi:=(1/2721600)*exp(5*ln(b-a))*f4;
end;

function Theb(a1,b1:extended):extended;
var x1,x2,x3:real;
begin
x1:=(b1+a1)/2-(b1-a1)/2*t;
x2:=(b1+a1)/2+(b1-a1)/2*t;
x3:=(b1+a1)/2;
Theb:=(0.5*(f(x1)+f(x2)+f(x3)));
end;

procedure Out;
begin
ClrScr;
Writeln('‚лзЁб«Ґ­ЁҐ Ё­вҐЈа «  ЎҐ§ Ў ­ЄЁа®ў ­Ёп');
WriteLn('j':5, '|', 'h(i)':17,'Q(i)':21,'e(i)':5);
WriteLn('-----------------------------------------------------------------------------');
WriteLn('-----------------------------------------------------------------------------');
for i:=0 to i1-1 do begin
WriteLn(' ':5, ' ', h1[i]:5:5, ' | ', q1[i]:7:7, ' | ' , ep1[i]:5:11);
end;
WriteLn;
WriteLn('‡ ¤ ­  Ї®ЈаҐи­®бвм : ',e:5:5);
WriteLn('‡­ зҐ­ЁҐ Ё­вҐЈа «  : ',S1:7:7);readln;
Writeln('‚лзЁб«Ґ­ЁҐ Ё­вҐЈа «  c Ў ­ЄЁа®ў ­ЁҐ¬');
WriteLn('j':5, '|', 'h(i)':17,'Q(i)':21,'e(i)':5);
WriteLn('-------------------------------------------------------------------------------');
WriteLn('-------------------------------------------------------------------------------');
for i:=0 to i2-1 do begin
WriteLn(' ':5, ' ', h2[i]:5:5, ' | ', q2[i]:5:5, ' | ' , ep2[i]:5:11);
end;
WriteLn('‡ ¤ ­  Ї®ЈаҐи­®бвм : ',e:5:5);
WriteLn('‡­ зҐ­ЁҐ Ё­вҐЈа «  : ',S2:5:5);readln


end;


BEGIN
xa:=a;xb:=b;i:=0;
repeat
if abs(e*(b-a)/(xb-xa))>abs(epsi(xa,xb)) then
begin q1[i]:=Theb(xa,xb);ep1[i]:=abs(epsi(xa,xb));h1[i]:=xb-xa;xa:=xb;xb:=b;i:=i+1;i1:=i;end
else xb:=(xa+xb)/2;
if xa<>xb then eq:=epsi(xa,xb);
until xa=b;
{Bank}
xa:=a;xb:=b;i:=0;e1:=e;
repeat
if abs(e1*(b-a)/(xb-xa))>abs(epsi(xa,xb))
then begin q2[i]:=Theb(xa,xb);ep2[i]:=abs(epsi(xa,xb));h2[i]:=xb-xa;e1:=e1-epsi(xa,xb);xa:=xb;xb:=b;i:=i+1;i2:=i;end
else xb:=(xa+xb)/2;
if xa<>xb then eq:=epsi(xa,xb);
until xa=b;
s1:=0;
for i:=0 to i1 do s1:=q1[i]+s1;
{writeln(s1);}s2:=0;
for i:=0 to i2 do s2:=q2[i]+s1;
{writeln(s2); }
out;
END.
Соседние файлы в папке МОЕ
  • #
    09.12.20132.69 Кб251.BAK
  • #
    09.12.201325.44 Кб251.EXE
  • #
    09.12.20132.69 Кб261.PAS
  • #
    09.12.20133.88 Кб25INTM.BAK
  • #
    09.12.201320.34 Кб25INTM.EXE
  • #
    09.12.20133.88 Кб27INTM.PAS
  • #
    09.12.20131.16 Кб25INT___.BAK
  • #
    09.12.201318.8 Кб25INT___.EXE