Определение количества теплоты, выделяющегося на единичном сопротивлении за единицу времени. Составление программы по блок-схеме и проверка правильности ее работы на тестовом примере, страница 2

     writeln('Q= ',s:4:4);

     readln;

end;

{--------------------------------------------------------------------}

BEGIN

     k0:=0.2*a0;                {начальные данные}

     l0:=0.2+0.1*a0+b0/1000;

     M:=5;

     repeat

           RK(M,U1);  {вызов процедуры Рунге-Кутта}

           M:=2*M;

           RK(M,U2);

           L:=true;

           M2:=M div 2;

           if (abs(u2[m]-u1[m2])/15) >e then L:=false; {это условие

           определяет - соответствует ли наши вычисления заданной погреш-ти}

     Until L;

     x:=a;

     U[0]:=a;

     clrscr;

     writeln('найденная ф-я');

     for i:=0 to M do

     begin

          {вывод найденной ф-ии}

          writeln('x= ',u[i]:4:4,'           y= ',u2[i]:4:4);

          x:=x+h;

          u[i+1]:=x;

     end;

     readln;

     simps;  {вызов процедуры Симпсона}

END.

Блок схема к задаче № 1:

Результаты счета программы:

Задача № 2

Текст программы:

Program Zadacha2;

Uses CRT;

Const

     a=0;        {a,b - начало и конец интервала }

     b=1;

     e=0.001;     {погрешность}

     y0=0;       {начальное условие Коши}

     a0=3;       {данные варианта }

     b0=6;       {данные варианта }

TYPE

    mas=array [0..1000] of real;

Var

   k0,l0:real;

   x,h:real;

   i,m,m2:integer;

   L:boolean;

   U,U1,U2:mas;

{--------------------------------------------------------------------}

{данная функция описывает диф. урав-е  }

FUNCTION F(x,y:real):real;

Begin

     F:=x;

End;

{--------------------------------------------------------------------}

{эта процедура осуществ-т алгоритм Рунге-Кутта}

Procedure RK(m:integer; var y:mas);

var k1,k2,k3,k4,kc:real;

begin

     h:=(b-a)/m;

     y[0]:=y0;

     for i:=0 to m-1 do

     begin

          k1:=F(a+i*h,y[i]);                 {формулы алг-ма Р-Кутта}

          k2:=F(a+i*h+h/2,y[i]+k1*h/2);

          k3:=F(a+i*h+h/2,y[i]+k2*h/2);

          k4:=F(a+i*h+h,y[i]+k3*h);

          kc:=(k1+2*k2+2*k3+k4)/6;

          y[i+1]:=y[i]+kc*h;

     end;

end;

{--------------------------------------------------------------------}

{эта процедура осущест-т метод Симпсона для нахождения интеграла Q}

Procedure Simps;

const hh=0.1;     {шаг по условию задачи}

var

   t,s1,s2,s:real;

   i,j:integer;

begin

     s1:=0;

     s2:=0;

     t:=-hh;

     j:=1;

     writeln('проинтерполированная ф-я');

     {а этом цикле осущ-ся алгор. линейной интерполяции

     для нахождения промежуточных точек ф-ии }

     repeat

          i:=0;

          t:=t+hh;

          repeat

                i:=i+1;

          until ((t>=u[i-1]) and (t<=u[i])); {нахождение подинтервала}

          u1[j]:=((u2[i]-u2[i-1])*(t-u[i-1]))/(u[i]-u[i-1])+u2[i-1];

          writeln('x= ',t:4:4,'  y= ',u1[j]:4:4);

        j:=j+1;

     until t>=b;

     for i:=1 to (j-1) do u2[i]:=u1[i]*u1[i];

     {в этом цикле находится сумма всех значений ф-ии с четными индексами}

     for i:=1 to (j-1) do

     begin

           if odd(i)=false then s1:=s1+u2[i];

     end;

     s1:=4*s1;

     {в этом цикле находится сумма всех значений ф-ии с нечетными индексами}

     for i:=0 to (j-1) do

     begin

           if odd(i) then s2:=s2+u2[i];

     end;

     s2:=2*s2;

     s:=(u2[0]+u2[j]+s1+s2)*hh/3;     {формула Симпсона}

     writeln('интеграл равен');

     writeln('Q= ',s:4:4);

     readln;

end;

{--------------------------------------------------------------------}

BEGIN

     k0:=0.2*a0;                {начальные данные}

     l0:=0.2+0.1*a0+b0/1000;

     M:=5;

     repeat

           RK(M,U1);  {вызов процедуры Рунге-Кутта}

           M:=2*M;

           RK(M,U2);

           L:=true;

           M2:=M div 2;

           if (abs(u2[m]-u1[m2])/15) >e then L:=false; {это условие

           определяет - соответствует ли наши вычисления заданной погреш-ти}

     Until L;

     x:=a;

     U[0]:=a;

     clrscr;

     writeln('найденная ф-я');

     for i:=0 to M do

     begin

          {вывод найденной ф-ии}

          writeln('x= ',u[i]:4:4,'           y= ',u2[i]:4:4);

          x:=x+h;

          u[i+1]:=x;

     end;

     readln;

     simps;  {вызов процедуры Симпсона}

END.

Блок схема к задаче № 2:

Результаты счета программы: