Основы программирования на языке Паскаль

оформим в виде функции f1;

– в виде f2;

sin(x)+f1 – в виде f3;

cos(x)+f1 – в виде f4;

cos(x)-f2 – в виде f5;

вычисления по методу трапеций с точностью 0.1 oформим в виде подпрограммы

-функции f6.

Program Prim32; label NAH,P;

Var b,a,z:real;

lit:char;

function f1(x:real):real;

Begin f1:=exp(x/10)+sqrt(x/(x+3)); end;

function f2(x:real):real;

Begin f2:=sqrt(sqr(x)/(3*x+10)); end;

function f3(x:real):real;

Begin f3:=sin(x)+f1(x); end;

function f4(x:real):real;

Begin f4:=cos(x)+f1(x); end;

function f5(x:real):real;

Begin f5:=cos(x)-f2(x); end;

function f6(a,b:real):real;

label K,N1,K1,KC,T;

Var h,s1,s,x:real; i,n:integer;

Begin

s1:=9.999e+10; n:=10;

N1: h:=(b-a)/n; s:=0; x:=a;

for i:=1 to n do

Begin if a>b then goto t else

if (0<=a)and(b<5) then Begin s:=s+(f3(x)+f3(x+h))/2*h;

goto kc; end else

if (5<=a)and(b<10) then Begin s:=s+(f4(x)+f4(x+h))/2*h;

goto kc; end else

if (10<=a)and(b<=16) then Begin s:=s+(f5(x)+f5(x+h))/2*h;

goto kc; end else goto t;

KC: x:=x+h; end;

if abs(s-s1)<0.1 then goto k

else Begin s1:=s; n:=n*10; goto n1; end;

K: f6:=s; gotok1;

T: writeln('пределы интегрирования не соответствуют условию');

f6:=-9999999999.;

K1: end;

BEGIN

NAH: writeln('введитезначения a,b');

readln(a,b); z:=f6(a,b);

if z=-9999999999. then goto p;

writeln('z=',z);

P: readln;

writeln(' будем еще вычислять z ? , если "да" ',

'то нажмите клавишу "y" , если нет, то любую клавишу ');

readln(lit);

if (lit='Y') or (lit='y') then goto NAH;

END.

7.3. Подпрограммы-процедуры

Описание процедуры:

Procedure имя (входные формальные параметры: тип;

Var выходные формальные параметры: тип);

описания (если они есть)

begin операторы

end;

Пусть необходимо найти корни квадратных уравнений

ax2+bx+c=0,

ky2+my+d=0,

sz2+tz+p=0,

где коэффициенты a, b, c вводятся по запросу. количество уравнений не ограничено. результаты вычислений выводить на экран (в основную программу не возвращать), см. рис. 2.1.

Program Prim33;

label K,NAH;

Var let:char; a,b,c:real;

procedure root(a,b,c:real); {процедура не имеет выходных параметров}

label K;

Var d,x1d,x1m,x2d,x2m:real;

Beginifa=0 thenBegin

writeln('уравнение первой степени, корень один');

x1d:=-c/b; writeln('x=',x1d); goto K; end

else d:=b*b-4*a*c;

if d>=0 then Begin

writeln('уравнение второй степени, корни действительные');

x1d:=(-b-sqrt(d))/(2*a);

x2d:=(-b+sqrt(d))/(2*a);

writeln('x1d=',x1d,' x2d=',x2d); goto K; end

else writeln('уравнение второй степени, корни комплексные');

x1d:=-b/(2*a); x2d:=x1d;

x1m:=-sqrt(-d)/(2*a); x2m:=-x1m;

writeln('z1=',x1d,' ',x1m,' i;');

writeln('z2=',x2d,' ',x2m,' i;');

K: end;

BEGIN NAH: writeln('введите a,b,c'); readln(a,b,c); root(a,b,c);

writeln('будет еще уравнение? если "да", нажмите клавишу"Y"',

'если "нет", нажмите любую клавишу');

read(let);

if (let='Y') or (let='y') then goto nah else goto K;

K: END.

Найти x, y, z — корни системы уравнений:

Как известно из линейной алгебры ,

где

Раскрытие определителя

в процедуре a,b,c,d – входные данные, x,y,z – результаты.

Program Prim34;

label N,K;

Type w=array[1 3] of integer;

Var a,b,c,d:w; x,y,z:real; let:char;

function det(a:w;b:w;c:w):real;

Begin det:=a[1]*b[2]*c[3]+b[1]*c[2]*a[3]+c[1]*a[2]*b[3]

-c[1]*b[2]*a[3]-a[1]*c[2]*b[3]-b[1]*a[2]*c[3]; end;

procedure ur(a,b,c,d:w; Var x,y,z:real);

Var d0:real;

Begin d0:=det(a,b,c);

if d0=0 then Begin writeln('det=0 решениянет');

let:='0'; Exit; end else {EXIT – выход из процедуры}

x:=det(d,b,c)/d0;

y:=det(a,d,c)/d0;

z:=det(a,b,d)/d0; let:='1'; end;

BEGIN N: writeln('введите a1,b1,c1,d1'); readln(a[1],b[1],c[1],d[1]);

writeln('введите a2,b2,c2,d2'); readln(a[2],b[2],c[2],d[2]);

writeln('введите a3,b3,c3,d3'); readln(a[3],b[3],c[3],d[3]);

ur(a,b,c,d,x,y,z);

if let='0' then goto K else

 Скачать реферат