Подскажите, в чем проблема? - Turbo Pascal - Ответ 13664173

program DiskrModel;
uses crt,graph;
type ta1=array[1..10] of integer ;
  ta2=array[1..12,1..10] of integer;
var i,j,kevnt,matr,dtime,nnq1,tnow,ttbeg,nnrns:integer;
nrns,dtimz,tsob,ttfin,m,k1,k2,k3:integer;
  f,f1:file of ta2;
  a,b,a1,atrib,dt,a2:ta1;
  a3:ta2;
  fx :  TEXT;
  j1,rep_count,rp,rp1 : integer;
procedure grup;{Перегрупировка событий по времени}
var l,k,h,i,j,n:integer;
begin writeln(fx,'Перегруппировка событий по времени');
  seek(f,0);
  read(f,a3);
  n:=1;
  while a3[matr+2,n]=1 do begin
  for k:=1 to nnq1-1 do for l:=1 to matr+2 do  begin
  a3[l,k]:=a3[l,k+1];
  a3[l,k+1]:=0;
  end;
  n:=n+1;
  end;
  h:=nnq1 div 2;
  j:=0; while h<>0 do begin
  for j:=h+1 to nnq1 do begin i:=j-h;
  for k:=1 to matr+2 do a[k]:=a3[k,j];
  repeat
  for k:=1 to matr+2 do b[k]:=a3[k,i];
  if (a[matr+2]<b[matr+2]) and (a[matr+2]>0) then begin
  for k:=1 to matr+2 do a3[k,i+h]:=b[k];
  i:=i-h; end;
  until (i<=0) or (a[matr+2]>=b[matr+2]) or (a[matr+2]=0);
  for k:=1 to matr+2 do a3[k,i+h]:=a[k];
  end; h:=h div 2; end;
  seek(f,0);
  write(f,a3);
  writeln(fx,'Вывод нового календаря');
  for i:=1 to nnq1 do begin for j:=1 to matr+2 do
  write(a3[j,i],' ');
  write(' ');
  end;
  writeln;
  end;
procedure schdl(kevnt,dtime:integer;a4:ta1);{Процедура планирования}
  var  i,j:integer;
  begin  for i:=1 to matr do a2[i]:=a1[i];
  writeLn(fx,'Атрибуты события ',a1[1]);
  a2[matr+1]:=kevnt;
  writeln(fx,'код события',kevnt);
  a2[matr+2]:=tnow+dtime;
  writeln(fx,'время события',tnow+dtime);
  seek(f,0);
  write(f,a3);
  j:=1;
  while a3[matr+1,j]<>0 do j:=j+1;
  for i:=1 to matr+2 do a3[i,j]:=a2[i];
  seek(f,0);
  write(f,a3);
  writeln(fx,'вывод календаря');
  for i:=1 to nnq1 do begin for j:=1 to matr+2 do
  write(fx,a3[j,i],' ');
  write(fx,' ');
  end;
  writeln(fx);
  grup;
  end;
procedure rmove;{Извлечение первой записи}
  var i,j:integer;
  begin  seek(f,0);
  read(f,a3);
  tsob:=a3[matr+2,1];
  i:=a3[matr+1,1];
  writeln(fx,'код извлечённого события ',i);
  writeln(fx,'время извлечённого события', a3[matr+2,1]);
    for j:=1 to matr+3 do a3[j,1]:=0;
    for j:=1 to matr do atrib[j]:=a3[j,1];
    seek(f,0);
    write(f,a3);
    writeln(fx,'вывод календаря');
  for i:=1 to nnq1 do begin for j:=1 to matr+2 do
    write(fx,a3[j,i],'');
    write(fx,' ');
    end;
    writeln(fx);
    grup;
    end;
procedure intlc;
  var l0,ml0,ni,nl,busy,ex1:integer;
  begin
  tnow:=ttbeg;
  write(fx,'Время очередного прогона', tnow);
  writeln(fx);
  nrns:=nrns+1;
  write(fx,'Номер очередного прогона',nrns);
  writeln(fx);
  dt[1]:=1; dt[2]:=2; dt[3]:=3;
  write(fx,'Вызов подпрограммы планирования');
  kevnt:=1;
  i:=kevnt;
  dtimz:=dt[1]+k3*random(k2);
  schdl(1,dtimz,a1);
  end;
 
  procedure event(i:integer);{Процедура поиска процедуры обработки}
  begin case i of 1: begin
  writeln(fx,'Произошло событие с кодом',i,'с временем',tnow);
     kevnt:=2;
     i:=kevnt;
     dtimz:=round(dt[2]*exp(k1));
     schdl(2,dtimz,a1);
     end;
  2:begin writeln(fx,'Произошло событие с кодом',i,'c временем',tnow);
     kevnt:=3;
     i:=kevnt;
     schdl(3,dt[3],a1);
     end;
  3: writeln(fx,'Произошло событие с кодом',i,'c временем',tnow);
     end;
     end;
procedure otputn;{Процедура отчета по прогону}
  var nrns: integer;
  begin write(fx,'Номер прогона ',' ',nrns);
  write(fx,'прогон завершен') end;
procedure otput;{Процедура итогового отчета по прогонам}
  var sd,sdd : array [1..940] of word;
 x0,y0,i3,i33,i33_,i331,i22,j2,jj:word;
 x,y,m1:real;
  graphdriver,graphmode:integer;
  switch:boolean;
  s : string;
  begin write(fx,'Имитация закончена');
  graphdriver:=detect;
  initgraph(graphdriver,graphmode,'');
  x0:=20;
  y0:=getmaxY div 2;
  switch:=true;
  for j2:=0 to rep_count do begin cleardevice;
  str(rp,s);
  setbkcolor(blue);
  setcolor(white);
  line(x0,20,x0,getmaxY-20);
  line(x0,y0,getmaxX-20,y0);
  moveto(x0,y0);
  for i3:=1 to getmaxX-40 do begin m1:=20;
  x:=random(k3)+1;
  y:=(1/m1)*exp(-x/m1);
  sd[i3] := round(y*k2);
  end;
  i33_:=10;
  jj:=1;
  while i33_<200 do begin i33_:=i33_+rp;
  sdd[jj] :=0;
  for i33:=1 to getmaxX do begin if (sd[i33] = i33_)
  then sdd[jj] := sdd[jj]+1;
  end;jj:=jj+1;
  end;jj:=x0;
  for i3:=1 to round(200/rp) do begin setcolor(10);
  rectangle(jj,y0,jj+10,y0-round(sd[i3]*k1));
  jj:=jj+10;
  end;
  readln;
  end;
  closegraph;
  end;
procedure slam;
  var  i,j:integer;
  begin intlc;
  rmove;
  i:=kevnt;
  tnow:=tnow+dt[i];
  event(i);
  if (tnow<ttfin)and(a2[matr+1]>0) then begin rmove;
  otputn;
  end;
  if nrns<nnrns then intlc else otput;
  end;
  begin clrscr;
  matr:=1;
  nnq1:=1;
  ttfin:=180;
  ttbeg:=1;
  nrns:=0;
  k1:=5;
  k2:=13;
  k3:=50;
  nnrns:=10;
  m:=20;
  assign(f,'C:\Users\Admin\Desktop\f1.bat');
  rewrite(f);
  assign(fx,'C:\Users\Admin\Desktop\report.txt');
  rewrite(fx);
  rp:=1;
  rep_count:=0;
  for j1:=1 to 6 do slam;
  end.