Численные методы решения задачи нахождения температуры

p>   outtextxy(gx(-1.1,50),gy(-0.6,50),'38');

   outtextxy(gx(-2.1,50),gy(-0.3,50),'39'); 

   readkey;

     closegraph;

end;

  type mas1=array[1..19] of real; 

var

A:masik;

B:mas1;

 i,j:integer;

{***************************************************}

       {Решение системы хранится в  массиве В }

procedure GAUS(n:integer;var A:masik; var B:mas1);

var

l,k:integer;

r,buf:real;

begin

     l:=0;

FOR i:=1 TO n do

   begin

      k:=i;

      R:=ABS(A[i, i]);

      for j:=i+1 to n do

      if ABS(A[j, i])>=R then

                              begin

                               k:=j;

                               R:=ABS(A[j, i]);

                              end;

       IF R = 0 THEN begin l:=1; i:=n+1; end;

       IF k<>i THEN

       begin

          buf:=B[k];

          b[k]:=B[i];

          b[i]:=buf;

          FOR j:=i TO n do

           begin

            buf:=A[k, j];

            a[k,j]:=a[i, j];

            a[i,j]:=buf;

           end;

       end;

       R:=A[i, i]; B[i]:=B[i]/R;

       FOR j:=i TO n do A[i, j]:=A[i, j]/R;

       FOR k:=i+1 TO n do

        begin

         R:=A[k, i];

         B[k]:=B[k]-R*B[i];

         FOR j:=i TO n do A[k, j]:=A[k, j]-R*A[i, j];

        end;

   end;

IF l=1 THEN

       begin

          WriteLn('Система не имеет решений');

          exit;

       end;

FOR i:=n-1 DOWNTO 1 do

FOR j:=i+1 TO n do B[i]:=B[i]-A[i, j]*B[j];

WriteLn('Решение системы:');

FOR i:=1 TO n do Writeln('  ',B[i]:7:5);

writeln ('             Следующее->любая клава!!!');

end; 

procedure treygol(t1,t2,t3,x1,y1,x2,y2,x3,y3,x,y:real);

var

S1,g,S2,S3,D,Sl,lippa,a,b,c,S,T:real;

begin

       s1:=abs(x*(y2-y3)-y*(x2-x3)+x2*y3-x3*y2);

       s2:=abs(x1*(y-y3)-y1*(x-x3)+x*y3-x3*y);

       s3:=abs(x1*(y2-y)-y1*(x2-x)+x2*y-x*y2);

       D:=s1+s2+s3;

       SL:=abs(x1*(y2-y3)-y1*(x2-x3)+x2*y3-x3*y2);

if  abs(sl-d)<=0.0001

    then begin

       S:=x1*(y2-y3)-y1*(x2-x3)+x2*y3-x3*y2;

       a:=((x-x3)*(y2-y3)-(y-y3)*(x2-x3))/s;

       b:=((x-x1)*(y3-y1)-(y-y1)*(x3-x1))/s;

       c:=((x-x2)*(y1-y2)-(y-y2)*(x1-x2))/s;

       T:=a*T1+b*T2+c*T3;

       lippa:=sqr(x)-x*y-sqr(y)+2*x-y;

       clrscr;writeln;writeln;

writeln ('      T=',T:3:3,'   t(точная)=',lippa:3:3);

if (lippa=0) then

writeln('      Относительная погрешность =',abs(T-lippa)*100:1:2,' %')

else

writeln('      Относительная погрешность =',abs((T-lippa)/lippa)*100:1:2,' %');

writeln ('      при  x=',x:3:3,'     y=',y:3:3);

end

else exit;

end; 

procedure isk_k(t1,t3,t4,x1,y1,x3,y3,x4,y4,x,y:real);

var

tkv,lippa,hx,hy,dl,x2,y2,t2:real;

begin

hx:=x3-x4;hy:=y3-y1;

dl:=1/(hx*hy);

y2:=y1;x2:=x1+hx;

t2:=sqr(x2)-x2*y2-sqr(y2)+2*x2-y2;

if (x>=x1) and (y>=y1) and (y<=y3) and (x<=x3) then  begin

tkv:=dl*((x-x2)*(y-y4)*t1-(x-x1)*(y-y4)*t2+(x-x1)*(y-y1)*t3-(x-x2)*(y-y1)*t4);

lippa:=sqr(x)-sqr(y)-x*y+2*x-y;

clrscr;writeln;writeln;

writeln ('      T=',Tkv:3:3,'    t(точная)=',lippa:3:3);

if (lippa=0) then

writeln('      Относительная погрешность =',abs(tkv-lippa)*100:1:2,' %')

else

writeln('      Относительная погрешность =',abs((tkv-lippa)/lippa)*100:1:2,' %');

writeln ('      при  x=',x:3:3,'     y=',y:3:3);

end

else exit;

end; 

function tconstx(t0,x1,y1,t1,x2,y2,t2:real):real; 

var x0,y0:real;

begin

    if ((t0>t1) and (t0<t2)) or ((t0<t1) and (t0>t2))then begin

    x0:=(x2-x1)/(t2-t1)*t0-(t1*x2-t2*x1)/(t2-t1);

    tconstx:=x0;

    end

    else tconstx:=-100;

end; 

function tconsty(t0,x1,y1,t1,x2,y2,t2:real):real;

var x0,y0:real;

begin

    if ((t0>t1) and (t0<t2)) or ((t0<t1) and (t0>t2))then begin

    y0:=(y2-y1)/(t2-t1)*t0-(t1*y2-t2*y1)/(t2-t1);

    tconsty:=y0;

    end

    else tconsty:=-100;

end; 

procedure kvadrat(t1,t2,t3,t4,x1,y1,x2,y2,x3,y3,x4,y4,x,y:real);

var

tkv,lippa:real;

begin

if (x>=x1) and (y>=y1) and (y<=y3) and (x<=x3) then  begin

tkv:=(x-x2)*(y-y4)*t1-(x-x1)*(y-y4)*t2+(x-x1)*(y-y1)*t3-(x-x2)*(y-y1)*t4;

lippa:=sqr(x)-sqr(y)-x*y+2*x-y;

clrscr;writeln;writeln;

writeln ('      T=',Tkv:3:3,'    t(точная)=',lippa:3:3);

if (lippa=0) then

writeln('      Относительная погрешность =',abs(Tkv-lippa)*100:1:2,' %')

else

writeln('      Относительная погрешность =',abs((Tkv-lippa)/lippa)*100:1:2,' %');

writeln ('      при  x=',x:3:3,'     y=',y:3:3);

end

else exit;

end; 

type ma=array[1..120,1..2] of real;

type mp=array[1..5000] of real;

type mx=array[1..50,1..2] of real;

type md=array[1..100,1..2] of real; 

procedure pryamougol(vib:integer);

label G,g1,g2,g3,g4;

var

  i,j,n,k,k1,kf,k5,L,k2,k3,k4:integer;

  f,ff:integer;

  xx,yy,h1x0,y0,buf,buf1,buf2,h1,h2,h3,h4,kf1,kf2,kf3,kf4:real;

  m,mi,mix:^mx;

  p,pr:^ma;

  w,wx1:^mp;

  st:string;

  x:array [1..39] of real;

  y:array [1..39] of real;

  t:array [1..39] of real;

  pogr:array [1..19] of real;

  pogr_2:array [1..19] of real;

  a:masik; my:text;tt:real;

  tabl:array [1..19,1..5] of byte;

  r:array [1..19,1..5] of byte;

begin

  if (vib=1) then

  begin

  linia;

  clrscr;

     for i:=20 to 39 do

     begin

     if (i>=20) and (i<=23)

     then begin

     x[i]:=i-23;y[i]:=x[i]+3;

     end;

     if (i>=24) and (i<=26)

     then

       begin

     x[i]:=i-23;y[i]:=3;

        end;

     if (i>=27) and (i<=28)

      then

      begin

      y[i]:=29-i;x[i]:=(y[i]-10.5)/-2.5;

      end;

     if i=29 then

     begin

     x[i]:=4;y[i]:=-2.5*x[i]+10.5;

     end;

     if (i>=30) and (i<=32)

     then begin

     y[i]:=30-i;x[i]:=(y[i]-10.5)/-2.5;

     end;

     if (i>=33) and (i<=39) then

     begin

     x[i]:=37-i;y[i]:=-0.25*x[i]-0.75;

     end;

     t[i]:=sqr(x[i])-x[i]*y[i]-sqr(y[i])+2*x[i]-y[i];

     end;

     k:=0;

for j:=5 downto 1 do begin

yy:=-2+j;

for i:=1 to 8 do begin

xx:=-3+i;

if (yy<3) and (yy>-0.25*xx-0.75) and (yy<-2.5*xx+10.5) and (yy<xx+3) then

begin

k:=k+1;x[k]:=xx;y[k]:=yy;

end;end;end;

     gotoxy (2,2);

     write('Внутренние-внешние  точки');

     gotoxy (2,3);

     write (' --------------------------------------');

     gotoxy (2,4);

     write (' |   N  |   x    |   y    |   T   | P |');

     gotoxy (2,5);

     write (' --------------------------------------');

     for i:=1 to 19 do begin

     gotoxy(3,i+5);write ('|  ',i);

     gotoxy(10,i+5);write('|');

     gotoxy(13,i+5);write (x[i]:1:1);

     gotoxy(19,i+5);write('|');

     gotoxy(22,i+5);write (y[i]:1:1);

     gotoxy(28,i+5);write('|   *   | * |');

     end;

     gotoxy(2,25);

     write(' --------------------------------------');

     gotoxy(41,2);

     writeln(' --------------------------------------');

     gotoxy(41,3);

     writeln(' |   N  |  x   |   y    |  T      | P |');

     gotoxy(41,4);

     writeln(' --------------------------------------');

for i:=20 to 39 do begin

gotoxy(41,i-15);

write(' |  ',i);

gotoxy(49,i-15);write('|');

gotoxy(52,i-15);

write(x[i]:1:1);

gotoxy(56,i-15);write('|');

gotoxy(59,i-15);

write(y[i]:1:1);

gotoxy(65,i-15);write('|');

gotoxy(68,i-15);

write(t[i]:1:1);

gotoxy(75,i-15);write('|');

gotoxy(76,i-15);

write(' 0 |');

end;

gotoxy(41,25);

write(' --------------------------------------');

gotoxy(3,26);

write('                               Следующее->любая клава!!!');

readkey;

clrscr;

for i:=1 to 19 do

b[i]:=0;

for i:=1 to 19 do tabl[i][1]:=i;

tabl[1][2]:=22;tabl[1][3]:=2;tabl[1][4]:=23;tabl[1][5]:=6; {+}

tabl[2][2]:=1;tabl[2][3]:=3;tabl[2][4]:=24;tabl[2][5]:=7;

tabl[3][2]:=2;tabl[3][3]:=4;tabl[3][4]:=25;tabl[3][5]:=8;

tabl[4][2]:=3;tabl[4][3]:=27;tabl[4][4]:=26;tabl[4][5]:=9;

tabl[5][2]:=21;tabl[5][3]:=6;tabl[5][4]:=22;tabl[5][5]:=11;

tabl[6][2]:=5;tabl[6][3]:=7;tabl[6][4]:=1;tabl[6][5]:=12;

tabl[7][2]:=6;tabl[7][3]:=8;tabl[7][4]:=2;tabl[7][5]:=13;

tabl[8][2]:=7;tabl[8][3]:=9;tabl[8][4]:=3;tabl[8][5]:=14;

tabl[9][2]:=8;tabl[9][3]:=28;tabl[9][4]:=4;tabl[9][5]:=15;

tabl[10][2]:=20;tabl[10][3]:=11;tabl[10][4]:=21;tabl[10][5]:=39;

tabl[11][2]:=10;tabl[11][3]:=12;tabl[11][4]:=5;tabl[11][5]:=38;

tabl[12][2]:=11;tabl[12][3]:=13;tabl[12][4]:=6;tabl[12][5]:=37;

tabl[13][2]:=12;tabl[13][3]:=14;tabl[13][4]:=7;tabl[13][5]:=36;

tabl[14][2]:=13;tabl[14][3]:=15;tabl[14][4]:=8;tabl[14][5]:=17;