Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Антропов.docx
Скачиваний:
4
Добавлен:
08.09.2019
Размер:
1.9 Mб
Скачать

3.2 Блок-схема программы PotyagVv

3.3 Программа PotyagVv

Program PotyagVV;

Uses CRT,Graph,Dos;

Const NN=25;

LABEL 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,

22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,

met1,met2,met3,met4,met5,met6,met7,met8,met9;

TYPE Dl=ARRAY [1..NN] OF INTEGER;

Uk=ARRAY [1..NN] OF REAL;

Rds=ARRAY [1..NN] OF INTEGER;

DlRez=ARRAY [1..NN] OF INTEGER;

UkRez=ARRAY [1..NN] OF REAL;

DRd=ARRAY [1..NN] OF INTEGER;

PUk=ARRAY [1..NN] OF REAL;

VAR FV:text;

FO:text;

FC:text;

FE:text;

FA:text;

NAME:string;

S,st1,st2,st3:String;

i,j,k,n,m,z,d,di,x1,y1,x2,y2,amax,amin,Lob,Vrem,Op,kk,Pr,p,

ObKolVag,Vag8,Vag6,Vag4,Wvf,Ns,Nr,m1,Kdv:integer;

LM:Word;

LUklon,Uklon,DeltaUkl,Uslov,bmin,bmax,SkorDl,TyagDl,TyagTr,

OsudsoLo,OsudsoVa,Put,Skor,SkorPr,UdSopLoc,UdSopSos,SopLoc,

SopSos,SopPo,UdSopPo,Tyag,UdTyag,SilOs,Ksi,LocMas,MasSos,Dk,Mn,

MasPoez,DlSos,DlLoc,DlPoez,TokElek,RasEner,TyagPr,SkorKr,sn,f2n,SkorZad,UklUch,Usk,UskZad,DeltaUsk,DeltaTyaga,Kpr,SosMasPr,X0,

DlinOb,PutProm,UdSopTor,TorSila,SkorTor,PrUkl,TorDel,TorSilaUd,

UklOb,PutTek,Prom,Unl,Inf,Pnd,fn,kpd,cofi,lsras,Dsr,bzub,rs,

rrp,Xs,Xrp,delta,mu:real;

L:Dl;

Ukl:Uk;

Rad:Rds;

RezL:DlRez;

RezUkl:UkRez;

DlRds:DRd;

PrUklRez:PUk;

u:real;

c:char;

{ Сигнал ошибки }

Procedure Zvuck1;

begin

Sound(4600);

Delay(200);

NoSound;

end;

{ Сигнал смены окна }

Procedure Zvuck2;

begin

Sound(800);

Delay(100);

NoSound;

end;

{ Информационное окно }

PROCEDURE okno1;

Const

LU=#201;

RU=#187;

LD=#200;

RD=#188;

H=#205;

V=#186;

Var

k:integer;

begin

X1:=2; Y1:=2; X2:=78; Y2:=17;

TextBackground(LightBlue);

TextColor(Yellow);

Window(X1,Y1,X2,Y2);

Write(LU);

For k:=X1+1 to X2-1 do Write(H);

Write(RU);

For k:=Y1+1 to Y2-1 do

begin

GotoXY(1,k-Y1+1);

Write(V);

GotoXY(X2-X1+1,WhereY);

Write(V);

end;

Write(LD);

Window(X1,Y1,X2,Y2+1);

GotoXY(2,Y2-Y1+1);

For k:=X1+1 to X2-1 do Write(H);

Write(RD);

Window(X1+1,Y1+1,X2-1,Y2-1);

ClrScr;

end;

{ Диалоговое окно }

PROCEDURE okno2;

Const

LU=#201;

RU=#187;

LD=#200;

RD=#188;

H=#205;

V=#186;

Var

k:integer;

begin

X1:=2; Y1:=19; X2:=78; Y2:=24;

TextBackground(Cyan);

TextColor(Blue);

Window(X1,Y1,X2,Y2);

Write(LU);

For k:=X1+1 to X2-1 do Write(H);

Write(RU);

For k:=Y1+1 to Y2-1 do

begin

GotoXY(1,k-Y1+1);

Write(V);

GotoXY(X2-X1+1,WhereY);

Write(V);

end;

Write(LD);

Window(X1,Y1,X2,Y2+1);

GotoXY(2,Y2-Y1+1);

For k:=X1+1 to X2-1 do Write(H);

Write(RD);

Window(X1+1,Y1+1,X2-1,Y2-1);

ClrScr;

end;

{ Процедура диалога при вводе данных }

Procedure Okna(var s1,s2,s3:string);

begin

Okno2;

Writeln(s1);

Writeln(s2);

Writeln(s3);

Okno1;

end;

{ Процедура индикации ошибки при вводе }

Procedure Vvod;

begin

okno2;

zvuck1;

TextColor(Red);

Writeln(' Внимание:');

TextColor(Blue);

Writeln(' Параметр вне диапазона. Повторите ввод,');

Writeln(' нажав клавишу <N>');

okno1;

end;

{ Процедура ввода целых чисел }

PROCEDURE str1(var x:integer);

begin

repeat

u:=0;

c:=readkey

until ( c in ['y','Y','n','N','Q','q']);

case c of

'n','N': begin

write(' Введите новое значение ');

readln(x);

Okna(st1,st2,st3);

end;

'y','Y': writeln(' Сохраняется старое

значение');'q','Q':u:=1;

end;

end;

{ Процедура ввода вещественных чисел }

PROCEDURE str2(var z:real);

begin

u:=0;

repeat

c:=readkey

until( c in ['y','Y','n','N','q','Q']);

case c of

'n','N':begin

write(' Введите новое значение ');

readln(z);

Okna(st1,st2,st3);

end;

'y','Y':writeln(' Сохраняется старое значение');

'q','Q':u:=1;

end;

end;

{ Основная программа }

BEGIN

TextBackGround(Black);

LM:=LastMode;

met1: ClrScr;

{ Создание окон ввода профиля пути }

st1:=' Нажмите клавишу:<Y> - чтобы оставить старое значение; ';

st2:=' <N> - чтобы внести новое значение; ';

st3:=' <Q> - для прекращения ввода.';

Okna(st1,st2,st3);

{ Открытие файла профиля пути }

assign(fv,'C:\PodstaAs\AsPotyag\profil.dat');

reset(fv);

read(fv,n);

i:=1;

while not EOF(fv) and (i<=n) do

begin

readln(fv,l[i],rad[i],DlRds[i],ukl[i]);

inc(i)

end;

close(fv);

{ Ввод профиля пути }

TextColor(Red);

GotoXY(25,1);

Writeln('Ввод профиля пути');

Window(4,4,76,16);

TextColor(Yellow);

1: writeln(#10,' Количество участков n <',n,'>: ');

str1(n);

If u>0 then goto met2;

amin:=1; amax:=20;

if (n<amin) or (n>amax) then

begin

Vvod;

Goto 1;

end;

For i:=1 to n do

begin

ClrScr;

2: writeln(#10,' Длина участка L',i,'<',l[i]:5,'>: ');

str1(l[i]);

If u>0 then goto met2;

amin:=200; amax:=20005;

if (L[i]<amin) or (L[i]>amax) then

begin

Vvod;

goto 2;

end;

3: writeln(#10,' Радиус кривой Rad ',i,'< ',rad[i]:5,'>: ');

str1(rad[i]);

If u>0 then goto met2;

amin:=0; amax:=5000;

if (Rad[i]<amin) or (Rad[i]>amax) then

begin

Vvod;

goto 3;

end;

4: writeln(#10,' Длина криволинейного участка пути DlRds',i,

'< ',DlRds[i]:5,'>: ');

str1(DlRds[i]);

If u>0 then goto met2;

amin:=0; amax:=5000;

if (DlRds[i]<amin) or (DlRds[i]>amax) then

begin

Vvod;

goto 4;

end;

5: writeln(#10,' Уклон ',i,' участка < ',ukl[i]:3:2,'>: ');

str2(ukl[i]);

If u>0 then goto met2;

bmin:=-15.0; bmax:=15.0;

if (Ukl[i]<bmin) or (Ukl[i]>bmax) then

begin

Vvod;

goto 5;

end;

readln;

end;

Okno1;

met2: TextColor(Red);

Writeln(#10,' Ввод исходных данных профиля пути завершен.');

TextColor(Yellow);

Okno2;

Writeln;

Writeln(' Нажмите клавишу - "Y" чтобы продолжить работу',

' программы');

Writeln(' или - "N" чтобы вернуться в режим повторного',

' ввода данных');

Repeat

c:=readkey

until (c in ['n','N','y','Y']);

Case c of

'y','Y': begin end;

'n','N': goto met1;

end;

{'Создание файла исходных данных профиля пути '}

Write;

Assign(FV,'C:\PodstaAs\AsPotyag\profil.dat');

Rewrite(FV);

Writeln(FV,n:12);

For i:=1 to n do Writeln(FV,l[i]:10,rad[i]:10,DlRds[i]:10,

ukl[i]:10:2);

Close(FV);

{ Ввод данных состава }

met3: ClrScr;

st1:=' Нажмите клавишу:<Y> - чтобы оставить старое значение; ';

st2:=' <N> - чтобы внести новое значение; ';

st3:=' <Q> - для прекращения ввода.';

Okna(st1,st2,st3);

TextColor(Red);

GotoXY(25,1);

Writeln('Ввод данных о составе поезда ');

Window(4,4,76,15);

TextColor(Yellow);

assign(fc,'C:\PodstaAs\AsPotyag\DanPoezd.dat');

reset(fc);

readln(fc,ObKolVag,Vag8,Vag6,Vag4);

readln(fc,MasSos,SkorZad,UskZad);

close(fc);

6:writeln(#10,' Общее количество вагонов ObKolVag <',

ObKolVag:5,'>: ');

str1(ObKolVag);

If u>0 then goto met4;

bmin:=0; bmax:=80;

if (ObKolVag<bmin) or (ObKolVag>bmax) then

begin

Vvod;

Goto 6;

end;

7: writeln(#10,' Количество 8-осных вагонов Vag8 <',Vag8:5,'>: ');

str1(Vag8);

If u>0 then goto met4;

bmin:=0; bmax:=ObKolVag;

if (Vag8<bmin) or (Vag8>bmax) then

begin

Vvod;

Goto 7;

end;

8: writeln(#10,' Количество 6-осных вагонов Vag6 <',Vag6:5,'>: ');

str1(Vag6);

If u>0 then goto met4;

bmin:=0; bmax:=ObKolVag-Vag8;

if (Vag6<bmin) or (Vag6>bmax) then

begin

Vvod;

Goto 8;

end;

9: writeln(#10,'Количество 4-осных вагонов Vag4 <',Vag4:5,'>: ');

str1(Vag4); If u>0 then goto met4;

bmin:=0; bmax:=ObKolVag-Vag8-Vag6;

if (Vag4<bmin) or (Vag4>bmax) then

begin

Vvod;

Goto 9;

end;

10:writeln(#10,'Укажите массу состава MasSos <',MasSos:5:0,'>: ');

str2(MasSos);

If u>0 then goto met4;

bmin:=0; bmax:=9000;

if (MasSos<bmin) or (MasSos>bmax) then

begin

Vvod;

Goto 10;

end;

11:writeln(#10,' Укажите заданную скорость движения состава SkorZad <',SkorZad:5:2,'> [км/ч]: ');

str2(SkorZad);

If u>0 then goto met4;

bmin:=0; bmax:=160;

if (SkorZad<bmin) or (SkorZad>bmax) then

begin

Vvod;

Goto 11;

end;

12:writeln(#10,' Укажите ускорение движения состава UskZad <',

UskZad:1:4,'> [м/с2]: ');

str2(UskZad);

If u>0 then goto met4;

bmin:=0; bmax:=2;

if (UskZad<bmin) or (UskZad>bmax) then

begin

Vvod;

Goto 12;

end;

{ Создание файла исходных данных состава }

met4: Okno1;

TextColor(Red);

Writeln;

Writeln(' Ввод данных поезда завершен');

TextColor(Yellow);

Okno2;

Writeln;

Writeln(' Нажмите клавишу - "Y" чтобы продолжить работу',

' программы');

Writeln(' или - "N" чтобы вернуться в режим повторного',

' ввода данных');

Repeat

c:=readkey

until (c in ['n','N','y','Y']);

Case c of

'y','Y': begin end;

'n','N': goto met3;

end;

Write;

Assign(FC,'C:\PodstaAs\AsPotyag\DanPoezd.dat');

Rewrite(FC);

Writeln(FC,ObKolVag:11,Vag8:11,Vag6:11,Vag4:4);

Writeln(FC,MasSos:11:1,SkorZad:11:2,UskZad:11:4);

Close(FC);

{ Ввод данных электровоза }

met5: Okna(st1,st2,st3);

Okno1;

Writeln;

TextColor(Red);

Writeln(' Ввод данных электровоза');

TextColor(Yellow);

assign(fe,'C:\PodstaAs\AsPotyag\Electra.dat');

reset(fe);

readln(fe,mu,Kdv,DlLoc,LocMas);

close(fe);

13:writeln(#10,' Укажите передаточное отношение тягового редуктора электровоза mu <',

mu:3:2,'>: ');

str2(mu);

If u>0 then goto met6;

bmin:=0; bmax:=5;

if (mu<bmin) or (mu>bmax) then

begin

Vvod;

Goto 13;

end;

14:writeln(#10,' Укажите количество тяговых двигателей на электровозе Kdv <',

Kdv:2,'> : ');

str1(Kdv);

If u>0 then goto met6;

bmin:=0; bmax:=20;

if (Kdv<bmin) or (Kdv>bmax) then

begin

Vvod;

Goto 14;

end;

15:writeln(#10,' Укажите длину локомотива DlLoc <',

DlLoc:4:1,'> [м]: ');

str2(DlLoc);

If u>0 then goto met6;

bmin:=0; bmax:=250;

if (DlLoc<bmin) or (DlLoc>bmax) then

begin

Vvod;

Goto 15;

end;

16:writeln(#10,' Укажите массу локомотива в тоннах LocMas <',

LocMas:4:1,'> [т]: ');

str2(LocMas);

If u>0 then goto met6;

bmin:=0; bmax:=10000;

if (LocMas<bmin) or (LocMas>bmax) then

begin

Vvod;

Goto 16;

end;

met6: Okno1;

TextColor(Red);

Writeln;

Writeln(' Ввод данных электровоза завершен.');

TextColor(Yellow);

Okno2;

Writeln(' Нажмите клавишу - "Y" чтобы продолжить работу',

' программы');

Writeln(' или - "N" чтобы вернуться в режим повторного',

' ввода данных');

Repeat

c:=readkey

until (c in ['n','N','y','Y']);

Case c of

'y','Y': begin end;

'n','N': goto met5;

end;

assign(fe,'C:\PodstaAs\AsPotyag\Electra.dat');

rewrite(fe);

writeln(fe,mu:11:2,Kdv:11,DlLoc:11,LocMas:11:2);

close(fe);

met7: Okna(st1,st2,st3);

Okno1;

Writeln;

TextColor(Red);

GotoXY(25,1);

Writeln('Ввод данных электродвигателя ');

Window(4,4,76,15);

TextColor(Yellow);

assign(fa,'C:\PodstaAs\AsPotyag\ElDvig.dat');

reset(fa);

readln(fa,Unl,Inf,Pnd,fn,p,Ns,Dk,sn);

readln(fa,kpd,cofi,lsras,Dsr,bzub,rs,rrp);

readln(fa,Xrp,m1,delta,Wvf,Xs,X0,f2n,Mn);

close(fa);

17:writeln(#10,' Укажите номинальное линейное напряжение питания Unl <',Unl:4:2,'> [ B ]: ');

str2(Unl);

If u>0 then goto met8;

bmin:=0; bmax:=3000;

if (Unl<bmin) or (Unl>bmax) then

begin

Vvod;

Goto 17;

end;

18:writeln(#10,' Укажите номинальный фазный ток двигателя Inf <',

Inf:4:2,'> [ A ]: ');

str2(Inf);

If u>0 then goto met8;

bmin:=0; bmax:=1000;

if (Inf<bmin) or (Inf>bmax) then

begin

Vvod;

Goto 18;

end;

19:writeln(#10,' Укажите мощность продолжительного режима двигателя Pnd <',

Pnd:4:2,'> [кBA]: ');

str2(Pnd);

If u>0 then goto met8;

bmin:=0; bmax:=1300;

if (Pnd<bmin) or (Pnd>bmax) then

begin

Vvod;

Goto 19;

end;

20:writeln(#10,' Укажите число полюсов двигателя p <',

p:2,'>: ');

str1(p);

If u>0 then goto met8;

bmin:=0; bmax:=6;

if (p<bmin) or (p>bmax) then

begin

Vvod;

Goto 20;

end;

21:writeln(#10,' Укажите номинальную частоту питающего напряжения fn <',fn:3:2,'> [Гц]: ');

str2(fn);

If u>0 then goto met8;

bmin:=0; bmax:=250;

if (fn<bmin) or (fn>bmax) then

begin

Vvod;

Goto 21;

end;

22:writeln(#10,' Укажите коэффициент полезного действия двигателя kpd <', kpd:2:3,'> : ');

str2(kpd);

If u>0 then goto met8;

bmin:=0; bmax:=0.99;

if (kpd<bmin) or (kpd>bmax) then

begin

Vvod;

Goto 22;

end;

23:writeln(#10,' Укажите коэффициент мощности двигателя cofi <',

cofi:2:3,'> : ');

str2(cofi);

If u>0 then goto met8;

bmin:=0; bmax:=1.0;

if (cofi<bmin) or (cofi>bmax) then

begin

Vvod;

Goto 23;

end;

24:writeln(#10,' Укажите число витков фазы двигателя Wvf <', Wvf:3,'> : ');

str1(Wvf);

If u>0 then goto met8;

bmin:=0; bmax:=999;

if (Wvf<bmin) or (Wvf>bmax) then

begin

Vvod;

Goto 24;

end;

25:writeln(#10,' Укажите расчетную длину статора двигателя lsras <', lsras:2:3,'> [м]: ');

str2(lsras);

If u>0 then goto met8;

bmin:=0; bmax:=2.0;

if (lsras<bmin) or (lsras>bmax) then

begin

Vvod;

Goto 25;

end;

26:writeln(#10,' Укажите диаметр расточки статора двигателя Dsr <',

Dsr:2:3,'> [м]: ');

str2(Dsr);

If u>0 then goto met8;

bmin:=0; bmax:=1.0;

if (UskZad<bmin) or (UskZad>bmax) then

begin

Vvod;

Goto 26;

end;

27:writeln(#10,' Укажите число пазов статора двигателя Ns <',

Ns:4,'> : ');

str1(Ns);

If u>0 then goto met8;

bmin:=0; bmax:=200;

if (Ns<bmin) or (Ns>bmax) then

begin

Vvod;

Goto 27;

end;

29:writeln(#10,' Укажите диаметр колеса электровоза Dk <',

Dk:3:2,'> : ');

str2(Dk);

If u>0 then goto met8;

bmin:=0; bmax:=2.0;

if (Nr<bmin) or (Nr>bmax) then

begin

Vvod;

Goto 29;

end;

30:writeln(#10,' Укажите ширину коронки зубца статора bzub <',

bzub:2:3,'> [м]: ');

str2(bzub);

If u>0 then goto met8;

bmin:=0; bmax:=0.1;

if (bzub<bmin) or (bzub>bmax) then

begin

Vvod;

Goto 30;

end;

31:writeln(#10,' Укажите активное сопротивление фазы статора двигателя Rs <',

Rs:2:4,'> [Ом]: ');

str2(Rs);

If u>0 then goto met8;

bmin:=0; bmax:=0.1;

if (Rs<bmin) or (Rs>bmax) then

begin

Vvod;

Goto 31;

end;

32:writeln(#10,' Укажите активное приведенное сопротивление фазы ротора Rrp <', Rrp:2:4,'>[Ом]:');

str2(Rrp);

If u>0 then goto met8;

bmin:=0; bmax:=0.1;

if (Rrp<bmin) or (Rrp>bmax) then

begin

Vvod;

Goto 32;

end;

33:writeln(#10,' Укажите индуктивное сопротивление фазы статора Xs <', Xs:2:4,'> [Ом]: ');

str2(Xs);

If u>0 then goto met8;

bmin:=0; bmax:=0.3;

if (Xs<bmin) or (Xs>bmax) then

begin

Vvod;

Goto 33;

end;

34:writeln(#10,'Укажите приведенное индуктивное сопротивление фазы ротора Xrp<', Xrp:2:4,'>[Ом]:');

str2(Xrp);

If u>0 then goto met8;

bmin:=0; bmax:=0.3;

if (Xrp<bmin) or (Xrp>bmax) then

begin

Vvod;

Goto 34;

end;

35:writeln(#10,' Укажите количество фаз тягового двигателя m1 <',

m1:2,'> : ');

str1(m1);

If u>0 then goto met8;

bmin:=0; bmax:=6;

if (m1<bmin) or (m1>bmax) then

begin

Vvod;

Goto 35;

end;

36:writeln(#10,' Укажите величину рабочего зазора двигателя delta <', delta:2:1,'> [мм]: ');

str2(delta);

If u>0 then goto met8;

bmin:=0; bmax:=5.0;

if (delta<bmin) or (delta>bmax) then

begin

Vvod;

Goto 36;

end;

37:writeln(#10,'Укажите величину реактивного сопротивления контура ');

writeln(#10,' намагничивания двигателя X0 <', X0:2:5,'> [Oм]: ');

str2(X0);

If u>0 then goto met8;

bmin:=0; bmax:=10.0;

if (X0<bmin) or (X0>bmax) then

begin

Vvod;

Goto 37;

end;

38:writeln(#10,' Укажите величину номинального скольжения ротора двигателя sn <', sn:2:4,'>: ');

str2(sn);

If u>0 then goto met8;

bmin:=0; bmax:=1.0;

if (sn<bmin) or (sn>bmax) then

begin

Vvod;

Goto 38;

end;

39:writeln(#10,' Укажите величину номинальной частоты ротора двигателя f2n <', f2n:2:2,'>: ');

str2(f2n);

If u>0 then goto met8;

bmin:=0; bmax:=10.0;

if (f2n<bmin) or (f2n>bmax) then

begin

Vvod;

Goto 39;

end;

40:writeln(#10,' Укажите величину номинального момента двигателя Mn <', Mn:6:2,'> [Нм]: ');

str2(Mn);

If u>0 then goto met8;

bmin:=0; bmax:=20000.0;

if (Mn<bmin) or (Mn>bmax) then

begin

Vvod;

Goto 40;

end;

met8: Okno1;

TextColor(Red);

Writeln;

Writeln(' Ввод данных тягового электродвигателя завершен.');

TextColor(Yellow);

Okno2;

Writeln(' Нажмите клавишу - "Y" чтобы продолжить работу',

' программы');

Writeln(' или - "N" чтобы вернуться в режим повторного',

' ввода данных');

Repeat

c:=readkey

until (c in ['n','N','y','Y']);

Case c of

'y','Y': begin end;

'n','N': goto met7;

end;

Assign(fa,'C:\PodstaAs\AsPotyag\ElDvig.dat');

Rewrite(fa);

writeln(fa,Unl:11:1,Inf:11:1,Pnd:11:1,fn:11:1,p:11,Ns:11,Dk:11:2,sn:11:2);

writeln(fa,kpd:11:3,cofi:11:3,lsras:11:3,Dsr:11:3,bzub:11:3,rs:11:7,rrp:11:7);

writeln(fa,Xrp:11:7,m1:11,delta:11:4,Wvf:11,Xs:11:7,X0:11:7,f2n:11:2,Mn:11:2);

Close(fa);

{ Спрямление }

St1:='';

St2:=' Результат спрямления ';

St3:='';

Okna(St1,St2,St3);

Assign(fv,'C:\PodstaAs\AsPotyag\Profil.dat');

Reset(fv);

Readln(fv,n);

i:=1;

While not EOF(fv) and (i<=n) do

begin

readln(fv,L[i],Rad[i],DlRds[i],Ukl[i]);

inc(i);

end;

{ for i:=1 to n do

writeln(L[i]:5,Rad[i]:5,DlRds[i]:5,Ukl[i]:5:2);

readln;}

Close(fv);

RezL[1]:=L[1];

PrUklRez[1]:=Ukl[1];

PrUklRez[1]:=0;

Writeln(#10);

Writeln(' В ',1,' спрямленный участок вошел ',1,

' участок профиля ');

Writeln(' Длина участка ',RezL[1]:6);

Writeln(' Уклон участка ',RezUkl[1]:3:3);

Writeln(' Приведенный уклон ',PrUklRez[1]:3:3);

Readln;

i:=2; LUklon:=0; Lob:=0; k:=2; m:=2; z:=2;

Okno1;

ClrScr;

Repeat

LUklon:=LUklon+L[i]*Ukl[i];

Lob:=Lob+L[i];

Uklon:=LUklon/Lob;

If DlRds[i]<=0 then

PrUklRez[i]:=0.0

else

If DlPoez<=DlRds[i] then

PrUklRez[i]:=700/Rad[i]

else

PrUklRez[i]:=(700/Rad[i]*DlRds[i])/DlPoez;

For j:=k to i do

begin

DeltaUkl:=abs(Uklon-Ukl[j]);

If DeltaUkl<0.01 then DeltaUkl:=0.01;

Uslov:=2000/DeltaUkl;

If (Uslov>=L[j]) then

begin

If j=i then

begin

di:=i;

RezUkl[m]:=Uklon;

RezL[m]:=Lob;

PrUklRez[m]:=PrUklRez[m]+PrUklRez[j];

end;

end

else

begin

m:=m+1;

ClrScr;

Writeln(#10);

Writeln(' В ',m-1,' спрямленный участок вошли',

' участки профиля с ',z,' по ',i-1);

LUklon:=0;

Lob:=0;

z:=i;

i:=di;

k:=i+1;

Writeln(' Длина участка ',RezL[m-1]:6);

Writeln(' Уклон участка ',RezUkl[m-1]:3:3);

Writeln(' Приведенный уклон ',PrUklRez[m-1]:3:3);

Writeln;

Readln;

PrUklRez[m]:=0;

Goto met9;

end;

end;

PrUkl:=0;

met9: i:=i+1;

until i>n-1;

ClrScr;

Writeln(#10);

Writeln(' В ',m,' спрямленный участок вошли участки профиля с ', z,' по ', n-1);

Writeln(' Длина участка ',RezL[m]:6);

Writeln(' Уклон участка ',RezUkl[m]:3:3);

Writeln(' Приведенный уклон ',PrUklRez[m]:3:3);

Readln;

RezL[m+1]:=L[n];

RezUkl[m+1]:=0;

PrUklRez[m+1]:=Ukl[n];

ClrScr;

Writeln(#10);

Writeln(' В ',m+1,' спрямленный участок вошел участок ',

n,' профиля ');

Writeln(' Длина участка ',RezL[m+1]:6);

Writeln(' Уклон участка ',RezUkl[m+1]:3:3);

Writeln(' Приведенный уклон ',PrUklRez[m+1]:3:3);

{ Создание файла спрямленного профиля пути }

Assign(fo,'C:\PodstaAs\AsPotyag\SprProfA.dat');

Rewrite(fo);

Writeln(fo,m+1:12);

For i:=1 to m+1 do

writeln(fo,RezL[i]:12,RezUkl[i]:10:2,PrUklRez[i]:10:2);

Close(fo);

TextMode(LM);

END.