ГОСТ 8.563.3-97; Страница 5

Procedure Qcalc;

var

I, IBeg, IFin: byte; Code: integer;

Bet, Bet4, Ec, Rd, Psi, Rk, LI, L2, Alfa, Qcb, ARe, RO, KCb, Qc, Vcv, Log: real;

HsS: string[10];

label

1,3;

const

RocSubs: array[1..31] of real = (0.6682, 1.2601, 1.8641, 2.488,

       2.4956, 3.147, 3.174, 3.898, 4.755,

       5.812, 1.09, 1.1733, 1.776, 3.469,

       4.294, 1.587, 2.045, 1.1649, 1.8393,

       1.4311, 2.718, 0.787, 998.23,

       1.33116, 1.20445, 0.16631, 0.8385,

       1.6618, 0.08375, 0.716, 1.1649);

HsSubsl: array[1..31] of real = (37.12, 65.43, 93.85, 122.8, 123.6, 0.0,

       0.0, 0.0, 0.0,0.0, 54.47, 59.04, 86.88,

       0.0, 0.0, 0.0, 52.70, 11.77, 0.0, 23.61,

       0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,

       11.88, 16.11, 0.0);

HsSubs2: array[1..31] of real = (33.43, 59.87, 86.37, 113.4, 114.1, 0.0,

       0.0, 0.0, 0.0, 0.0, 52.62, 55.34, 81.29,

       0.0, 0.0, 0.0, 48.94, 11.77, 0.0, 21.75,

       0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,

       10.04, 13.32, 0.0);

CalcTpNg = ‘TpNg.exe’; CalcTpSubs = ‘TpSubs.exe’;

begin { QCalc }

{Расчет физических свойств среды}

assign(Fl. ‘IRD’); rewrite(Fl);

if NSubA[NNit] = 0 then begin

writeln(Fl, NMethKA[NNit]);

ifNMethKA[NNit] >= 2 then begin

IBeg:= 1;

repeat

I Fin := IBeg + 3;

for I := IBeg to IFin do write(Fl, YR[I]:14,BL);

writeln(Fl);

IBeg := IFin + 1

until IBeg > 16;

end

else

writeln(Fl, Roc:14, Bl, Ya:14, Bl, Yy:14);

end

else

       writeln(Fl, NSubA[NNIT]);

writeln(Fl, P:14, Bl, T:14);

close(Fl);

TextColor(7);

gotoxy( 19,9);

writeln(‘|        |’);

gotoxy(19,10);