Var I : integer;

term,new_term,

sum,x2 : real;

begin { bessj }

x2:=x*x;

if (x=0.0)and(N=1.0) then bessj:=0.0

else if x>15 then { asymptotic expansion }

bessj:=sqrt(2/(pi*x))*cos(x-pi/4-n*pi/2)

else

begin

if n=0.0 then sum:=1.0

else sum:=exp(n*ln(x/2))/gamma(n+1.0);

new_term:=sum;

i:=0;

repeat

i:=i+1;

term:=new_term;

new_term:=-term*x2*0.25/(i*(n+1));

sum:=sum+new_term

until abs(new_term)<=abs(sum*tol);

bessj:=sum

end { if}

end; { bessj }

begin { main }

done:=false;

repeat

write('Order: ');

readln(ordr);

if ordr<-25.0 then done:=true

else

begin

write('X: ');

readln(x);

writeln('J Bessel is ',bessj(x,ordr))

end

until done

end.

Программа 17. Задача линейного приближения с помощью МНК.

program cfit1;

{ Pascal program to perform a linear least-squares fit }

const max = 20;

type index = 1..max;

ary = array[index] of real;

var x,y,y_calc : ary;

n : integer;

first,done : boolean;

seed,a,b : real;

procedure get_data(var x,y: ary;

var n: integer);

{ get values for n and arrays x,y }

{ y is randomly scattered about a straight line }

const a = 2.0;

b = 5.0;

var i,j : integer;

fudge : real;

begin

write('Fudge? (<0 to terminate)');

readln(fudge);

if fudge<0.0 then done:=true

else

begin

repeat

write('How many points? ');

readln(n)

until (n>2) and (n<=max);

if first then first:=false else ClrScr;

for i:=1 to n do

begin

j:=n+1-i;

x[i]:=j;

y[i]:=(a+b*j)*(1.0+(2.0*Random-1.0)*fudge)

end { for-loop }

end { if }

end; { procedure get_data }

procedure write_data;

{ print out the answers }

Var I : integer;

begin

writeln;

writeln(' I X Y');

for i:=1 to n do

writeln(i:3,x[i]:8:1,y[i]:9:2);

writeln

end; { write_data }

begin { MAIN program }

first:=true;

seed:=4.0;

ClrScr;

done:=false;

repeat

get_data(x,y,n);

if not done then

begin

write_data;

{ ***** ---> more lines to be added here ********* }

end

until done

end.

Программа 18. Решение системы уравнений методом Крамера.

program simq1;

{ pascal program to solve three simultaneous equations by Cramer's rule }

const rmax = 3; {эти значения не следует считать }

cmax = 3; { фиксированными - они могут изменяться}

type arys = array[1..cmax] of real;

ary2s = array[1..rmax,1..cmax] of real;

var y,coef : arys;

a : ary2s;

n : integer;

yesno : char;

error : boolean;

procedure get_data(var a: ary2s;

var y: arys;

var n: integer);

{ get the values for n, and arrays a,y }

var i,j : integer;

begin { procedure get_data }

writeln;

n:=rmax;

for i:=1 to n do

begin

writeln(' Equation',i:3);

for j:=1 to n do

begin

write(j:3,':');

read(a[i,j])

end;

write(',C:');

readln(y[i])

end;

writeln;

for i:=1 to n do

begin

for j:=1 to n do

write(a[i,j]:7:4,' ');

writeln(':',y[i]:7:4)

end;

writeln

end; { procedure get_data }

procedure write_data;

{ print out the answeres }