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

j:=j+1;

pr^[j][1]:=tconstx(h1,x[i],y[i],t[i],x[r[i][5]],y[r[i][5]],t[r[i][5]]);

pr^[j][2]:=tconsty(h1,x[i],y[i],t[i],x[r[i][5]],y[r[i][5]],t[r[i][5]]);

j:=j+1;

pr^[j][1]:=tconstx(h1,x[i],y[i],t[i],x[r[i][4]],y[r[i][4]],t[r[i][4]]);

pr^[j][2]:=tconsty(h1,x[i],y[i],t[i],x[r[i][4]],y[r[i][4]],t[r[i][4]]);

j:=j+1;

pr^[j][1]:=tconstx(h1,x[i],y[i],t[i],x[r[i][2]],y[r[i][2]],t[r[i][2]]);

pr^[j][2]:=tconsty(h1,x[i],y[i],t[i],x[r[i][2]],y[r[i][2]],t[r[i][2]]);

end;

for i:=20 to 39 do

begin

j:=j+1;

pr^[j][1]:=tconstx(h1,x[i],y[i],t[i],x[i+1],y[i+1],t[i+1]);

pr^[j][2]:=tconsty(h1,x[i],y[i],t[i],x[i+1],y[i+1],t[i+1]);

end;

j:=j+1;

pr^[j][1]:=tconstx(h1,x[20],y[20],t[20],x[39],y[39],t[39]);

pr^[j][2]:=tconsty(h1,x[20],y[20],t[20],x[39],y[39],t[39]);

j:=j+1;

pr^[j][1]:=tconstx(h1,x[20],y[20],t[20],x[21],y[21],t[21]);

pr^[j][2]:=tconsty(h1,x[20],y[20],t[20],x[21],y[21],t[21]);

for i:=1 to j-1 do begin

   for k:=1 to j-1 do begin

       IF pr^[k][1]>pr^[k+1][1] then begin

          buf1:=pr^[k][1];buf2:=pr^[k][2];

          pr^[k][1]:=pr^[k+1][1];pr^[k][2]:=pr^[k+1][2];

          pr^[k+1][1]:=buf1;pr^[k+1][2]:=buf2;

     end;

   end;

end;

New (p);k:=0;

for i:=1 to j do begin

if (pr^[i][1]=-100) then continue

else begin

k:=k+1;p^[K][1]:=pr^[i][1];p^[K][2]:=pr^[i][2];

end;end;

Dispose(pr);

New (mi);k4:=0;

for i:=1 to k do

if (abs(p^[i][2]-3)<0.01) or  (abs(p^[i][2]+0.25*p^[i][1]+0.75)<0.01) or

(abs(p^[i][2]-p^[i][1]-3)<0.01)

or (abs(p^[i][2]+2.5*p^[i][1]-10.5)<0.01) then begin

k4:=k4+1;mi^[k4][1]:=p^[i][1];mi^[k4][2]:=p^[i][2];

end

else begin

if (abs(p^[i][1]-trunc(p^[i][1]))<0.01) or

(abs(p^[i][2]-trunc(p^[i][2]))<0.01) then begin

k4:=k4+1;mi^[K4][1]:=p^[i][1];mi^[K4][2]:=p^[i][2];

end;end;

Dispose(p);

New(m);K5:=0;

for i:=1 to k4 do

if i=1 then goto G2

else

if (abs(mi^[i][2]-3)<0.01) or  (abs(mi^[i][2]+0.25*mi^[i][1]+0.75)<0.01) or

(abs(mi^[i][2]-mi^[i][1]-3)<0.01)

or (abs(mi^[i][2]+2.5*mi^[i][1]-10.5)<0.01) then begin

k5:=k5+1;m^[k5][1]:=mi^[i][1];m^[k5][2]:=mi^[i][2];

end

else begin

if (abs(mi^[i][1]-mi^[i-1][1])<0.001) or (abs(mi^[i][2]-mi^[i-1][2])<0.001)

then continue

else begin

g2:

k5:=k5+1;m^[k5][1]:=mi^[i][1];m^[k5][2]:=mi^[i][2];

end;end;

for i:=1 TO K5 DO BEGIN

gotoxy(2,2+i);

write (' x=',m^[i][1]:1:3);

gotoxy(15,2+i);writeln('y=',m^[i][2]:1:3);

END;

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

Dispose(mi);

readkey;

clrscr;

init_graph;

ris;dizkretizaciya; setcolor(14);

line(100,100,120,100);

Str(h1:1:3,st);setcolor(15);

outtextxy(125,97,'- изотерма T='+st);

setcolor(12);

readkey;

for i:=1 to k5 do

if i=1 then goto g4

else begin

setcolor(14);

if (abs(m^[i][1]-m^[i-1][1])<=sqrt(2)+0.02) then begin

line(gx(m^[i][1],50),gy(m^[i][2],50),gx(m^[i-1][1],50),gy(m^[i-1][2],50));

g4:

setcolor(14);

circle(gx(m^[i][1],50),gy(m^[i][2],50),1);

end;end;

dispose(m);

setcolor(9);

line(20,70,50,70);setcolor(15);

outtextxy(55,67,'- точная изотерма T='+st);

readkey;

New(w);New(wx1);

yy:=-2;f:=0;

repeat

xx:=-3;yy:=yy+0.01;

repeat

buf:=sqr(xx)-sqr(yy)-xx*yy+2*xx-yy;

if (yy<=3) and

   (yy>=-0.25*xx-0.75) and

          (yy<=xx+3) and

                    (yy<=-2.5*xx+10.5) then begin 

if abs(buf-h1)<=0.03 then begin

f:=f+1;w^[f]:=yy;

wx1^[f]:=xx;

end;end;

xx:=xx+0.01;

until (xx>=5.02);

until (yy>=3.005);

for i:=1 to f-1 do begin

   for j:=1 to f-1 do begin

       IF wx1^[j]>wx1^[j+1] then begin

          buf1:=wx1^[j];buf2:=w^[j];

          wx1^[j]:=wx1^[j+1];w^[j]:=w^[j+1];

          wx1^[j+1]:=buf1;w^[j+1]:=buf2;

     end;

   end;

end;

for i:=1 to f do

putpixel (gx(wx1^[i],50),gy(w^[i],50),9);

dispose(w);dispose(wx1);readkey;

closegraph;

end

else begin

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

end;end;end;end; 

procedure menu;

Label M;

var

vibor:char;u,v:integer;

begin

u:=0;v:=0;

M:

clrscr;

writeln ('          Меню:1.Создание рисунков/сетки/температур  во внутренних точках;');

writeln ('               2.Нахождение температуры в любой точке области');

writeln ('               3.Семейство изотерм Выход-любая  клава');

write('          Введите действие:');

readln(vibor);

case vibor of

'1':begin

pryamougol(1);u:=1;goto M;

end;

'2':begin

if u=1 then begin

     pryamougol(2);v:=1;goto M;end

     else begin

     writeln('             Ошибка!!!Нажми 1-й пункт');

     readkey;goto M;

     end;

end;

'3':begin

    if u=1  then begiN

            if v=1 then begin

            pryamougol(3);goto M;end

            else begin

            writeln('             Ошибка!!!Нажми 2-й пункт'); readkey;goto M;

            end;

    end

    else begin

    writeln('             Ошибка!!!Нажми 1-й пункт');    readkey;goto M; end;

end;else exit;end;end; 

begin

clrscr;menu;end.