program Av_nav;
uses crt,graph;

const m=5; {количество столбцов}
      n=5; {количество строк}
      H1=600; {начальная высота}
      V1=340; {начальныя скорость}
      H2=6000; {конечная высота}
      V2=670; {конечная скорость}
      s=201;
      P=1.1*88.5;
      dH=(h2-h1)/m;
      dV=(v2-v1)/n;
      g=9.8051;
var i,j:integer;
    st:string[4];
    grDriver: Integer;
    grMode: Integer;
    ErrCode: Integer;
    stepx,stepy,h: real;
    down_:file of real;
    left_:file of real;
    diag_:file of real;
    dir_:file of byte;

function plotn(h:real):real;
{Расчет плотности}
begin
 if h<1000 then plotn:=1.16727-(h-500)*0.05561/500;
 if h<2000 then plotn:=1.11166-(h-1000)*0.10511/1000;
 if h<3000 then plotn:=1.00655-(h-2000)*0.97296/1000;
 if h<4000 then plotn:=0.909254-(h-3000)*0.089907/1000;
 if h<5000 then plotn:=0.819347-(h-4000)*0.082918/1000;
 if (h<6000) or (h=6000) then plotn:=0.736429-(h-5000)*0.076318/1000;

end;
function Va(h:real):real;
begin
 if h<1000 then va:=338.37-(h-500)*1.935/500;
 if h<2000 then va:=336.435-(h-1000)*3.903/1000;
 if h<3000 then va:=332.532-(h-2000)*3.948/1000;
 if h<4000 then va:=328.584-(h-3000)*3.995/1000;
 if h<5000 then va:=324.589-(h-4000)*4.044/1000;
 if (h<6000) or (h=6000) then va:=320.545-(h-5000)*4.093/1000;

end;
procedure reset_file;
begin
  assign(down_,'down.dat');
  assign(left_,'left.dat');
  assign(diag_,'diag.dat');
  assign(dir_,'dir.dat');
  rewrite(down_);
  rewrite(left_);
  rewrite(diag_);
  rewrite(dir_);
end;

procedure close_file;
begin
  close(down_);
  close(left_);
  close(diag_);
  close(dir_);
end;
procedure fill_file;
var k,dtxy,dty,q,sinn,o,mm,acr,dm,nx,x,alfa,cx,cy,dtx,e,c,v,h:real;b:byte;
begin
b:=0;
 for i:=1 to m*n do
   begin
     {c:=trunc(random(5))+1;}
     h:=h1+Trunc(i/n)*dH;
     v:=v1+Trunc(i/m)*dV;
     k:=dv/dh;
     o:=1/(1+V*k/g);
     q:=plotn(h)*sqr(v);
     sinn:=(1+sqrt(1-4*o*0.0639*m*g/(q*s)*(o*p/m*g-o*(0.0129*q*s/(m*g)+0.0639*m*g/(q*s)))));
     dtxy:=1/(k*sinn)*ln(V2/V1);
     write(diag_,dtxy);
   end;
for i:=1 to (m+1)*(n+1) do
begin
write(dir_,b);
end;
for i:=1 to m*n do
begin
h:=h1+Trunc(i/n)*dH;
v:=v1+Trunc(i/m)*dV;
alfa:=(m*g+plotn(h)*sqr(v)*s*0.25)/(P+5.1229*s*plotn(h)*sqr(v));
Cy:=-0.25+5.1229*alfa;
Cx:=-3.675e-3+5.77e-3*alfa;
x:=Cx*plotn(h)*sqr(v)*s/2;
Nx:=P*cos(alfa)-x;
dM:=dH/Va(h);
dtx:=(Va(h)*dM)/(g*Nx);

{aa:=trunc(random(4))+1;}
write(left_,dtx);
end;
for i:=1 to m*n do
begin
h:=h1+Trunc(i/n)*dH;
v:=v1+Trunc(i/m)*dV;
acr:=(Va(500)+Va(6000))/2;
MM:=V/acr;
o:=1;
q:=plotn(h)*sqr(v);
sinn:=(1+sqrt(1-4*o*0.0639*m*g/(q*s)*(o*p/m*g-o*(0.0129*q*s/(m*g)+0.0639*m*g/(q*s)))));
dty:=dH/(acr*MM*sinn);
{e:=trunc(random(3))+1;}
write(down_,dty);
end;
end;
function addrrdir(i,j:integer):integer;
begin addrrdir:=(i-1)*(n+1)+j-1; end;

function addrr(i,j:integer):integer;
begin addrr:=(i-1)*n+j-1 end;

Function getleft(i,j:integer):real;
var a:real;
begin
seek(left_,addrr(i,j));
read(left_,a);
getleft:=a;
end;

Function getdiag(i,j:integer):real;
var a:real;
begin
seek(diag_,addrr(i,j));
read(diag_,a);
getdiag:=a;
end;

Function getdown(i,j:integer):real;
var a:real;
begin
seek(down_,addrr(i,j));
read(down_,a);
getdown:=a;
end;

Function getdir(i,j:integer):byte;
var a:byte;
begin
seek(dir_,addrrdir(i,j));
 read(dir_,a);
getdir:=a;
end;

Procedure Putleft(i,j:integer;x:real);
begin
seek(left_,addrr(i,j));
write(left_,x);
end;
Procedure Putdown(i,j:integer;x:real);
begin
seek(down_,addrr(i,j));
write(down_,x);
end;
Procedure Putdiag(i,j:integer;x:real);
begin
seek(diag_,addrr(i,j));
write(diag_,x);
end;
Procedure Putdir(i,j:integer;x:byte);
begin
seek(dir_,addrrdir(i,j));
write(dir_,x);
end;

function min(a,b,c,d:real):byte;
begin
if D=1 then min:=1;
if ((b<a) OR (A=B)) and (b<c) then min:=4;
if ((c<a) ) and ((c<b) OR (B=C) ) then min:=2;
end;
function diagon(K,L:INTEGER):byte;
begin
IF K<N THEN
 if GETDIAG(k,l)<(GETLEFT(k+1,l)+getdown(k,l))  then diagon:=1;
IF  L<M then
 if getdiag(k,l)<(getleft(k,l)+getdown(k,l+1)) then diagon:=1;
end;
Procedure q;
var k,l:integer;
begin
gotoxy(1,1);
for k:=n downto 1
do begin
for l:=1 to m do write(getdown(k,l),' ');
writeln;
end;
readln;
end;

begin
clrscr;
randomize;
{заполнение массива}
writeln('Иницилизация массива');
reset_file;
fill_file;
{влево - 4
вниз- 2
диаг -1}
{расчет траектории}
{q;}
for i:=1 to m do begin putdir(n+1,i,4);{q;}end;
for i:=1 to n do begin putdir(i,m+1,2);{q;}end;
for i:=1 to n
do for j:=1 to m
do begin
q;
gotoxy(10,10);
write(i,' ',j,'   ');
putdir(i,j,min(getdiag(i,j),getleft(i,j),getdown(i,j),diagon(I,J)));
end;

{gotoxy(1,1);
for i:=1 to n+1
do begin
for j:=1 to m+1 do write(getdir(i,j),' ');
writeln;
end;
readln;}
i:=1;j:=1;

while not ((i=n+1) and (j=m+1))
do begin
gotoxy(10,15);
 write(i,' ',j,'   ');

case trunc(getdir(i,j)) of
     1:begin putdir(i,j,9);i:=i+1;j:=j+1;end;
     2:begin putdir(i,j,8);i:=i+1;end;
     4:begin putdir(i,j,6);j:=j+1;end;
end
end;
{вывод результатов}
grDriver := Detect;
grMode := VGAHi;
InitGraph(grDriver, grMode,'c:/tp/bgi');
setcolor(14);
line(40,460,40,5);
line(40,460,625,460);
stepx:=580/m;
stepy:=450/n;
h:=40+stepx;
for i:=1 to m do
begin
  line(trunc(h),458,trunc(h),462);
  h:=h+stepx;
end;
h:=10+stepy;
for i:=1 to m do
begin
  line(38,trunc(h),42,trunc(h));
  h:=h+stepy;
end;

setcolor(red);
for i:=1 to n do
    for j:=1 to m+1 do
    if getdir(i,j)=8 then
    begin
    line(40+trunc(stepx*(j-1)),10+trunc(stepy*(n-i)),40+trunc(stepx*(j-1)),10+trunc(stepy*(n-i+1)));
    end;
for i:=1 to n+1 do
    for j:=1 to m do
    if getdir(i,j)=6 then
    begin
    line(40+trunc(stepx*(j)),10+trunc(stepy*(n-i+1)),40+trunc(stepx*(j-1)),10+trunc(stepy*(n-i+1)));
    end;
for i:=1 to n do
    for j:=1 to m do
    if getdir(i,j)=9 then
    begin
    line(40+trunc(stepx*j),10+trunc(stepy*(n-i)),40+trunc(stepx*(j-1)),10+trunc(stepy*(n-i+1)));
    end;
Readln;
close_file;
CloseGraph;
end.