FUNCTION EqNotGivenReal;
begin
  EqNotGivenReal:=true;
  if NotGivenReal(Arg)
then EqNotGivenReal:=false;
end;
FUNCTION Rad;
    BEGIN  Rad:=x*PI/180; END;

PROCEDURE Win;
Var viewport:viewporttype;
  Begin
     GetViewSettings(ViewPort);
     With ViewPort Do
         if y1<>14 then kol:=0;
  End;

FUNCTION Grad;
    BEGIN  Grad:=x*180/PI; END;
FUNCTION Step;
    BEGIN
       IF c=0 THEN Step:=0
              ELSE BEGIN
                 IF c<0 THEN  Step:=-EXP (LN (-c)*m)
                        ELSE  Step:=EXP (LN (c)*m);
              END;
    END;
FUNCTION ArcSin;
    BEGIN  ArcSin := ArcTan (Sin_X/SQRT (1-SQR (Sin_X)));  END;
FUNCTION ArcCos;
    BEGIN  ArcCos := ArcTan (STEP((1-SQR (Cos_X)),0.5)/Cos_X);END;



PROCEDURE Cps(VAR  c  : R10;              {   массив результатов   }
                                          { 1-Cр, 3-Rг, 4-Kг, 6-L0 }
                   t  : Real;             { температура            }
                   x  : Real;             { 1/альфа                }
                   a  : R6x11);           { термодин. коэф-ты      }

VAR d,qt,qt1,d1,t1 : Real;
    m,n,ind,i      : Integer;
    p              : R10;
BEGIN
    Variant(x,a,c[6],qt,ind,d,d1,qt1);
    m:=6; n:=m+1;
    c[3]:=Rgasa(a,d,qt,qt1,ind);
    Sostav(a,d,d1,qt,qt1,c[6],ind,n,p);
    c[1]:=p[n]; t1:=t/1000.0;
    FOR i:=m DOWNTO 1 DO c[1]:=c[1]*t1+p[i];
    c[4]:=c[1]/(c[1]-c[3]/426.9);
END;  { Cps }
{ ===============  вспомогательная программа определения ========  }
{ ========= L0,qt и варианта состава топливоздушной смеси  ======  }

PROCEDURE Variant(   x   : Real;           {   1/альфа              }
                     a   : R6x11;          { термодинам. коэф-ты    }
                 VAR L0  : Real;           { стехиометр. коэф-т     }
                 VAR qt  : Real;           { отн. cодержание топлива}
                 VAR ind : Integer;        { вариант состава смеси  }
                 VAR d   : Real;           { a[4,11]                }
                 VAR d1  : Real;           { 1-d                    }
                 VAR qt1 : Real);          { qt+1                   }

VAR r1,r2  : Real;
BEGIN
   d:=a[4,11];
   r1:=(a[1,11]/12.01+a[2,11]/4.032-a[3,11]/32.0);
   L0:=28.966/0.2095*r1;
   qt:=(1.0-a[4,11])*x/L0;
   IF qt<1.0e-5 THEN
   BEGIN
      IF d<1.0e-5 THEN ind:=1 ELSE ind:=2
   END
   ELSE
     IF a[2,11]<0.999 THEN
       IF (ABS(a[1,11]-0.85)<1.0e-3) AND (ABS(a[2,11]-0.15)<1.0e-3)
          AND(a[4,11]<1.0e-6) THEN ind:=3 ELSE ind:=4
     ELSE
       IF x<1.0 THEN ind:=5 ELSE ind:=6;
   d:=a[4,11]; d1:=1.0-d; qt1:=1.0+qt;
END;  { Variant }

{ ===============  вспомогательная программа определения Rг  =======}

FUNCTION Rgasa(     a   : R6x11;          { термодинам. коэф-ты    }
                    d   : Real;           { a[4,11]                }
                    qt  : Real;           { отн. cодержание топлива}
                    qt1 : Real;           { qt+1                   }
                    ind : Integer         { вариант состава смеси  }
                                 ):Real;  { значение Rг            }
VAR r     : Real;
    a1,a2 : Real;
BEGIN
    CASE ind OF
      1  : r:=1.0;
      2  : r:=1.0+0.60779*d;
      3  : r:=(1.0+1.07757*qt)/qt1;
      4  : BEGIN
            a1:=(a[2,11]/4.032+a[3,11]/32.0);
            r:=(1.0+28.966*a1*qt+0.60779*d)/qt1;
           END;
      5  : r:=(1.0+7.18378*qt+0.60779*d)/qt1;
      6  : r:=(0.7905+14.368*qt+0.8173*d)/qt1;
    END;
  Rgasa:=29.27*r;

END;  { Rgasa }

{ ===============  вспомогательная программа определения   ========}
{ =================== массива составляющих теплоемкости ===========}

PROCEDURE Sostav(    a   : R6x11;          { термодинам. коэф-ты   }
                     d   : Real;           { a[4,11]               }
                     d1  : Real;           { 1.0-d                 }
                     qt  : Real;           { отн. cодержание топлив}
                     qt1 : Real;           { qt+1                  }
                     L0  : Real;           { стехиометр. коэф-т    }
                     ind : Integer;        { вариант состава смеси }
                     n   : Integer;        { кол-во элементов      }
                VAR  p   : R10  );         { искомый массив        }

VAR i        : Integer;
    r1,r2,r3 : Real;
BEGIN
FOR i:=1 TO n DO
    CASE ind OF
      1  : p[i]:=a[1,i];
      2  : Begin
           p[i]:=(a[1,i]*d1)+(a[4,i]*d);
           End;
      3  : p[i]:=(a[2,i]*qt+a[1,i])/qt1;
      4  : BEGIN
            r1:=(44.01*a[3,i]-32.0*a[5,i]);
            r2:=(9.008*a[4,i]-8.0*a[5,i]);
          r3:=(a[1,11]*r1/12.01+a[2,11]*r2/1.008+a[3,11]*a[5,i])*qt;
            p[i]:=(r3+a[1,i]*d1+a[4,i]*d)/qt1;
         {
            p[i]:=((a[1,11]*(44.01*a[3,i]-32.0*a[5,i])/12.01
                  +a[2,11]*(9.008*a[4,i]-8.0*a[5,i])/1.008
                  +a[3,11]*a[5,i])*qt+a[1,i]*d1+a[4,i]*d)/qt1;
         }
           END;
      5  : BEGIN
            r1:=(9.008*a[4,i]-8.0*a[5,i])/1.008*qt;
            p[i]:=(r1+a[1,i]*d1+a[4,i]*d)/qt1;
           {
            p[i]:=((9.008*a[4,i]-8.0*a[5,i])/1.008*qt
                  +a[1,i]*d1+a[4,i]*d)/qt1;
           }
           END;
      6  : p[i]:=((9.008*a[4,i]-8.0*a[5,i])/1.008*d1/L0
                 +d*a[4,i]+d1*a[1,i]+(qt-d1/L0)*a[6,i])/qt1;

     END;

END;  { Sostav }

{ ============== функция определения конечной температуры ==========}
{ ===== по начальной темп-ре,приращению энтальпии и к-ту альфа =====}

FUNCTION Ti(  di   : Real;               { приращение энтальпии  }
              t0   : Real;               { начальная температура }
              x    : Real;               {  1/ альфа             }
              a    : R6x11;              {  термодинам. коэф-ты  }
         VAR  c    : R10                { термодинам. свойства  }
                         ):Real;         { конечная температура  }

VAR d,d1,qt,qt1,t,t1,t2,z : Real;
    i,m,n,ind             : Integer;
    p                     : R10;
    i0,i1                 : Real;

BEGIN
  Variant(x,a,c[6],qt,ind,d,d1,qt1);
  m:=6; n:=m+1; t:=t0/1000.0;
  c[3]:=Rgasa(a,d,qt,qt1,ind);
  Sostav(a,d,d1,qt,qt1,c[6],ind,n,p);
  t2:=t+di/0.25*0.001; t1:=10*t2;
  i0:=p[n]/n;
  FOR i:=m DOWNTO 1 DO i0:=i0*t+p[i]/i;
  i0:=i0*t0;
  WHILE Abs(t2-t1)>1.0e-6 DO
    BEGIN
       t1:=t2; c[1]:=p[n]; i1:=c[1]/n;
       FOR i:=m DOWNTO 1 DO
       BEGIN
         z:=p[i];
         c[1]:=c[1]*t1+z;
         i1:=i1*t1+z/i;
       END;
       i1:=i1*t1*1000.0;
       t2:=t1-(i1-i0-di)/(1000.0*c[1]);
       if c[1]=0 then
          begin
            Putmessage(' Ошибка в функции определения температуры ');
            exit;
          end;
     END;
   c[4]:=c[1]/(c[1]-c[3]/426.9);
   Ti:=1000.0*t2;
END;  {  Ti }
{ ============== функция определения приращения энтальпии ==========}
{ ===== при изменении темп-ры от t0 до t при заданном альфа ========}

FUNCTION Di(  t0   : Real;               { начальная температура }
              t    : Real;               { конечная температура  }
              x    : Real;               {  1/ альфа             }
              a    : R6x11              {  термодинам. коэф-ты  }
                         ):Real;         { приращение энтальпии  }

VAR L0,d,d1,qt,qt1,i0,i1,z : Real;
    i,m,n,ind              : Integer;
    p                      : R10;

BEGIN
  Variant(x,a,L0,qt,ind,d,d1,qt1);
  m:=6; n:=m+1;
  Sostav(a,d,d1,qt,qt1,L0,ind,n,p);
  d:=t0/1000.0; d1:=t/1000.0;
  i0:=p[n]/n; i1:=i0;
  FOR i:=m DOWNTO 1 DO
    BEGIN
      z:=p[i]/i;
      i0:=i0*d+z;
      i1:=i1*d1+z;
    END;
  Di:=(i1*d1-i0*d)*1000.0;

END; {  Di  }


{ ============== функция определения критической температуры ===== }
{ ========== по температуре торможения и коэф-ту  альфа ========== }

FUNCTION Tkr( t1   : Real;               { температура торможения  }
              x    : Real;               {  1/ альфа               }
              a    : R6x11;              { термодинам. коэф-ты     }
        VAR   c    : R10                { термодинам. свойства    }
                         ):Real;         { критическая температура }

VAR d,d1,qt,qt1,t01,t2,i1,i2,df,t3,au,z : Real;
    p                                   : R10;
    i,m,n,ind,l1                        : Integer;

BEGIN
  Variant(x,a,c[6],qt,ind,d,d1,qt1);
  m:=6; n:=m+1; t01:=t1/1000.0; l1:=m-1;
  c[3]:=Rgasa(a,d,qt,qt1,ind);
  Sostav(a,d,d1,qt,qt1,c[6],ind,n,p);
  t2:=t01*0.86; t3:=10*t2;
  i1:=p[n]/n;
  FOR i:=m DOWNTO 1 DO i1:=i1*t01+p[i]/i;
  i1:=i1*t01;
  WHILE ABS(t3-t2)>1.0e-6 DO
    BEGIN
      t2:=t3; c[1]:=p[n]; i2:=c[1]/n; df:=m*p[n];
      FOR i:=m DOWNTO 1 DO
      BEGIN
        z:=p[i];
        c[1]:=c[1]*t2+z;
        i2:=i2*t2+z/i;
      END;
      au:=c[1]-c[3]/426.9;
      i2:=i2*t2;
      c[4]:=c[1]/au;
      FOR i:=l1 DOWNTO 1 DO df:=df*t2+i*p[i+1];
      df:=1.17123448*c[3]*((t2*df+c[1])-
          df*c[1]*t2/au)/au+1000.0*c[1];
      i2:=1000.0*(c[3]*c[4]*t2/(853.8)+i2-i1);
      t3:=t2-i2/df;
    END;
    Tkr:=1000.0*t3;

 END;  {  Tkr  }

{ ========= функция определения отношения давлений ============ }
{ ========= в адиабатическом процессе по начальному =========== }
{ ============ и конечному значению температуры =============== }

FUNCTION Pit( t1 :  Real;               {  начальная температура }
              t2 :  Real;               {  конечная температура  }
              x  :  Real;               {  1/альфа               }
              a  :  R6x11               {  термодинам. коэф-ты   }
                         ):Real;        {  отношение давлений    }

VAR L0,d,d1,r,qt,qt1,t01,t02,z : Real;
    ind,m,n,i,l1               : Integer;
    p                          : R10;
    i1,i2                      : Real;
    m1,m2                      : Real;
BEGIN
   Variant(x,a,L0,qt,ind,d,d1,qt1);
   m:=6; n:=m+1; l1:=m-1;
   r:=Rgasa(a,d,qt,qt1,ind);
   Sostav(a,d,d1,qt,qt1,L0,ind,n,p);
   i1:=p[n]/m; i2:=i1; t01:=t1/1000.0; t02:=t2/1000.0;

   FOR i:=l1  DOWNTO 1 DO
   BEGIN
     z:=p[i+1]/i;
     i1:=i1*t01+z;
     i2:=i2*t02+z;
   END;
   i1:=i1*t01;
   i2:=i2*t02;
   m1:=Ln(abs(t2/t1));
   m2:=i2-i1+p[1]*m1;
   Pit:=Exp(m2*426.9/r);
   {
   Pit:=Exp((i2-i1+p[1]*Ln(t2/t1))*426.9/r);
   }
END; { Pit }

{ ===== функция определения конечной температуры t2 ============= }
{ == в адиабатическом процессе по заданному значению============= }
{======================================= начальной темп-ры t1,=== }
{ == отношению конечного и начального давлений и  коэф-ту альфа = }

FUNCTION Tpi( pr   : Real;               { отношение давлений    }
              t1   : Real;               { начальная температура }
              x    : Real;               {  1/ альфа             }
              a    : R6x11;              {  термодинам. коэф-ты  }
         VAR  c    : R10                { термодинам. свойства  }
                         ):Real;         { конечная температура  }

VAR d,d1,qt,qt1,i1,i2, L0,df,t2,t3 : Real;
    i,m,n,l1,ind                   : Integer;
    p                              : R10;
    t01,t02                        : Real;

BEGIN
  Variant(x,a,c[6],qt,ind,d,d1,qt1);
  m:=6; n:=m+1; l1:=m-1;
  c[3]:=Rgasa(a,d,qt,qt1,ind);
  Sostav(a,d,d1,qt,qt1,c[6],ind,n,p);
  t01:=t1/1000.0;
  t02:=t01*Sqrt(Sqrt(pr));
  i1:=p[m+1]/m;
  FOR i:=l1 DOWNTO 1 DO i1:=i1*t01+p[i+1]/i;
  i1:=i1*t01; t3:=t02; t02:=10*t3;
  WHILE Abs(t3-t02)>1.0e-6 DO
    BEGIN
       df:=p[m+1]; i2:=p[m+1]/m; t02:=t3;
       FOR i:=l1 DOWNTO 1 DO
       BEGIN
         i2:=i2*t02+p[i+1]/i;
         df:=df*t02+p[i+1];
       END;
       df:=df+p[1]/t02;
       i2:=i2*t02-i1+p[1]*Ln(abs(t02/t01));
       t3:=t02-(i2-c[3]*Ln(pr)/426.9)/df;
    END;
   c[1]:=df*t3;
   c[4]:=c[1]/(c[1]-c[3]/426.9);
   Tpi:=1000.0*t3;
END;  {  Tpi  }



{Здесь нужно разместить общие процедуры и функции
  (если они есть), заголовки которых вы описали выше.}

FUNCTION Mkr(k:Real):Real;     (* к-т в уравн.расхода     *)
VAR kp1  :Real;
    r1,r2: Real;
BEGIN
  kp1:=k+1;
  r1:=Ln(2.0/kp1);
  r2:=Exp((kp1/(k-1))*r1);
  Mkr:=Sqrt(k*r2);
{
  Mkr:=Sqrt(k*Exp((kp1/(k-1))*Ln(2.0/kp1)));
}
END; (* Mkr *)

FUNCTION Fq(p,t,g,q,k,r:Real):Real; (* площадь в ур-и расхода   *)
BEGIN

  Fq:=g*Sqrt(t)/(Mkr(k)*q*p);

END; (* Fq *)

FUNCTION Qf(p,t,g,f,k,r:Real):Real;  (* плотность в ур-и расхода *)
BEGIN

  Qf:=g*Sqrt(t)/(Mkr(k)*f*p);

END; (* Qf *)

FUNCTION Gpr(p,t,g:Real):Real;       (* опр.привед.расхода      *)
BEGIN
  Gpr:=g*101.3*Sqrt(t/288.0)/p;
END; (* Gpr *)

FUNCTION Kg(t,q:Real):Real;          (* опр. показат.адиабаты   *)
BEGIN
Kg:=1.4*(1.0+q)/(1.0+4.43435*q);
{
  IF q=0.0 THEN Kg:=1.4
  ELSE IF t<1400.0 THEN Kg:=1.33
       ELSE IF t<=1600.0 THEN Kg:=1.30
            ELSE Kg:=1.25;
}
END; (* Kg *)

FUNCTION Lmq(q,k:Real):Real;
  (* опр.привед. скорости по плотности тока *)
  (* для диапазона лямбда <= 1.0            *)
CONST eps=9.536743e-7;

VAR   km1,kp1,dkm1,dk,lm,lm1,c,t,r0,qm,qm1,lm2 : Real;

BEGIN

  IF q<=eps THEN Lmq:=0.0
  ELSE
    IF q>=(1.0-2.0*eps) THEN Lmq:=1.0
    ELSE
      BEGIN
        km1:=k-1.0; kp1:=k+1.0; dkm1:=1.0/km1; dk:=km1/kp1;
        c:=Exp(dkm1*Ln(kp1/2.0));
        lm1:=2.0*Arctan(q/Sqrt(1.0-q*q))/Pi;

        REPEAT
          lm:=lm1; lm2:=lm*lm;
          t:=1.0-dk*lm2; r0:=Exp(dkm1*Ln(t));
          qm:=c*lm*r0; qm1:=c*r0*(1.0-2.0*lm2/(t*kp1));
          lm1:=lm-(qm-q)/qm1;
        UNTIL Abs(lm-lm1)<=1.0e-4;

        Lmq:=lm1;

      END;

END; (* Lmq *)

FUNCTION LMQ2(q,k: Real): Real;
   {  определение   приведенной скорости по плотности    }
   {  тока для диапазона лямбда >1.0                     }
   {  входные параметры :                                }
   {              q- плотность тока                      }
   {              k- показатель адиабаты                 }
CONST eps=9.536743e-7;
VAR km1,kp1,dkm1,dkp1,dk,c,
    lm1,lm2,t,r0,qm,qm1,lm : Real;
    rr1,rr2,rr3            : Real;

  BEGIN
    IF q<eps THEN lmq2:=Sqrt((k+1.0)/(k-1.0))

    ELSE
       IF q>=(1.0-2.0*eps) THEN lmq2:=1.0
       ELSE
         BEGIN
           km1:=k-1.0;
           kp1:=k+1.0;
           dkm1:=1.0/km1;
           dkp1:=1.0/kp1;
           dk:=km1/kp1;
           c:=Exp(dkm1*Ln(kp1/2.0));

           rr3:=(1.0-(2.0*q-1.0)*(2.0*q-1.0));
           rr1:=(0.5-Arctan((2.0*q-1.0)/
                Sqrt(rr3))/Pi);
           rr2:=(Sqrt((kp1/km1))-1.0);
           lm1:=1.0+rr1*rr2;
{
           lm1:=1.0+(0.5-Arctan((2.0*q-1.0)/
   Sqrt(1.0-(2.0*q-1.0)*(2.0*q-1.0)))/Pi)*(Sqrt((kp1/km1))-1.0);
}
           REPEAT

              lm:=lm1; lm2:=lm*lm;
              t:=1.0-dk*lm2;
              r0:=Exp(dkm1*Ln(t));
              qm:=c*lm*r0;
              qm1:=c*r0*(1.0-2.0*lm2/(kp1*t));
              lm1:=lm-(qm-q)/qm1;
           UNTIL ABS(lm-lm1)<=1.0e-4;

             Lmq2:=lm1;
         END;
  END; { LMQ2}
  (* выч. плотности тока по привед. скорости *)
FUNCTION Qlm(la,k:Real):Real;
VAR km1,kp1 : Real;
BEGIN

  km1:=k-1.0; kp1:=k+1.0;
  Qlm:=la*Exp(Ln(0.5*kp1*(1.0-la*la*km1/kp1))/km1);

END; (* Qlm *)
 (* вычисление Пи по приведенной скорости   *)
FUNCTION Pilm(la,k:Real):Real;
VAR km1 : Real;
BEGIN

  km1:=k-1.0;
  Pilm:=Exp(ln(1.0-la*la*km1/(k+1.0))*k/km1);

END; (* Pilm *)
 (* вычисление приведенной скорости по Пи *)
FUNCTION Lmpi(p,k:Real):Real;
VAR km1 : Real;
BEGIN

  km1:=k-1.0;
  IF p>1 THEN p:=1.0/p;
  km1:=Sqrt((1.0-Exp(Ln(p)*km1/k))*(k+1.0)/km1);

  Lmpi:=km1;

END; (* Lmpi *)
 (* вычисление газовой постоянной по q топлива *)
FUNCTION Rg(q:Real):Real;
BEGIN

 Rg:=287.0*(1.0+1.0862*q)/(1.0+q);
{
IF q=0 THEN Rg:=287.3
ELSE  Rg:=288.3
}
END;   (* Rg *)
 (* определение значения выражения (знак В)*А  *)
FUNCTION Sign(A,B:Real):Real;
BEGIN
 IF B>=0.0 THEN Sign:=ABS(A)*1.0
           ELSE Sign:=ABS(A)*(-1.0)
END;    (* Sign *)

{FUNCTION Step(c,m:Real):Real;   (* вычисление а**b *)
BEGIN
  IF c=0 THEN Step:=1.0
         ELSE Step:=Exp(Ln(c)*m);
END;     (* Step*)}

(* ======================= линейная интерполяция ==================*)
PROCEDURE LINF1( N   : Integer;              (* количество точек          *)
                 A   : Mpar;                 (* массив значений функции   *)
                 XN  : Mpar;                 (* массив значений аргумента *)
                 X   : Real;                 (* пи сопла                  *)
            VAR  Z   : Real );               (* значение мю или фи        *)

VAR BX,n_a : Byte;

PROCEDURE POISK( N   : Integer;              (* количество точек          *)
                 XN  : Mpar;                 (* массив значений аргумента *)
                 X   : Real;                 (* пи сопла                  *)
                 E   : Real;                 (* точность поиска           *)
            VAR  n_a : Byte;                 (* номер ближайшего элемента *)
            VAR  B   : Byte );               (* признак поиска по характ. *)
VAR i  : Integer;
BEGIN
  IF (X<(XN[1]-E)) THEN BEGIN n_a:=1; B:=0; Exit; END;
  IF (X>(XN[N]+E)) THEN BEGIN n_a:=N; B:=0; Exit; END;
  FOR i:=1 TO N DO
  BEGIN
    IF (ABS(X-XN[i])<=E) THEN
    BEGIN
      n_a:=i; B:=0; Exit;
    END
    ELSE
    BEGIN
      IF (X>XN[i]) THEN
      BEGIN
        n_a:=i; B:=1;
      END;
    END;
  END;
END;  { POISK }

PROCEDURE LINTF1( X1  :  REAL;       (* вычисление значения функции *)
                  X2  :  REAL;
                  Y1  :  REAL;
                  Y2  :  REAL;
                  X   :  REAL;
            VAR   Y   :  REAL);
BEGIN

Y:=Y1+(Y2-Y1)/(X2-X1)*(X-X1);
END;  { LINTF1 }

BEGIN  { LINF1 }
  POISK(N,XN,X,0.001,n_a,BX);
  IF BX=0 THEN Z:=A[n_a]
  ELSE
  BEGIN
    LINTF1(XN[n_a],XN[n_a+1],A[n_a],A[n_a+1],X,Z);
  END;

END; { LINF1 }

PROCEDURE msa_pr(Mode: Integer;
                 pINReal13:Real{; pINInt : IntParamsPtr});
var s:string;
BEGIN
   MainMode:=Mode;

   if  (Mode=1002) or (Mode=2)  then
             begin
               rezim_ust:=2;
               win; if (kol=0) then beg:=TRUE
                             else beg:=FALSE;
             end
                else
                  begin kol2:=0; beg:=false;
                   rezim_ust:=1; t_i1:=0.0; t_i2:=0.0;
                   t_sum1:=0.0{pINReal^[13]}; t_sum2:=0.0;
                   end;
{}
  if abs((t_sum2+t_i2)-PinReal13)<0.01 then beg:=false;

    if beg then begin
            t_sum1:={pINReal^[13]}0.0; t_i1:=0.0;
            t_sum2:=0.0; t_i2:=0.0;
                 end;

{   t_sum1:=t_sum1+pINReal^[13]/pINint^[1];}

 IF (Mode>999) THEN
   Begin
     win;
     if kol=0 then for i:=0 to 2 do ris[i]:=False;
     kol:=kol+1;
     if kol>1 then for i:=0 to 2 do
              begin
{
               case i of
                  0: setviewport(8,14,629-14,340,clipoff);
                  1: setviewport(8,14,round(getmaxx/2),314,clipoff);
                  2: setviewport(round(getmaxx/2)+3,14,
                                getmaxx-11,314,clipoff);
                end;
}
              x_o[i]:=x_old[i];    y_o[i]:=y_old[i];
               x_pt[i]:=x_point[i]; y_pt[i]:=y_point[i];
             end;
     End
  Else
      Begin kol:=0; for i:=0 to 2 do ris[i]:=true; ii[num]:=0;
            end;

END;

Procedure max3(y1,y2,y3:integer; var max,min:integer);

 procedure max2(y1,y2:integer; var max:integer);
    begin if y1>y2 then max:=y1 else max:=y2; end;
 procedure min2(y1,y2:integer; var min :integer);
    begin if y1<y2 then min:=y1 else min:=y2 end;

 var s:integer;
 Begin
   max2(y1,y2,s);  max2(s,y3,max);
   min2(y1,y2,s);  min2(s,y3,min);
 End;

PROCEDURE PutTextXY(x,y : Integer; s : String; Col:Byte);
VAR i,j,k : Byte;
    cl    : Word;
BEGIN
  cl:=GetColor; Gdel22;
  SetColor(Col); OutTextXY(x,y,s);
  SetColor(cl);
END; { PutTextXY }

PROCEDURE kom_pik(G_:Real; pINName3 : String; var Pik_:Real);
VAR f:text;
    x1r,y1r,x2r,y2r:real;
BEGIN
     assign(f,Layout.SpecialDirName + pInName3 +'.rl');
     {$I-}  ReSet(f); {$I+}
     IF IOResult<>0 THEN BEGIN sound(300); Delay(200); Nosound;
                         putmessage(' Tie line is not found ');
                           Exit;
                         END
      ELSE
        BEGIN
           while not eof(f) do
             begin
               readln(f,x1r,y1r,x2r,y2r);
               if (G_<=x1r) and (G_>=x2r) then
                     begin
                        Pik_:=(y2r-y1r)*(G_-x1r)/(x2r-x1r)+y1r;
                     end;
            end; close(f);
        END;
END;

PROCEDURE ris_komp(nknr,num,kol,riskom,rezim:integer;
                   pINName2, pInName3 : String;
                   pSpecialData : pSpecialObject;
                   par1,par2,par3:real);
VAR f,f5:text;
    x1r,y1r,x2r,y2r:real;
    max,min,y,x_,y_,x1,y1,x_n,y_n: integer;
    xl,yl,xp,yp:integer;
    c,prt:boolean;
    j:integer; s1,s2:string;
BEGIN
 IF (kol<>0) and (riskom in [0,2]) THEN
 BEGIN
{   IF riskom=2 THEN}
{   if kol=1 then}
      case num of
       0: setviewport(8,14,629-14,340,clipoff);
       1: setviewport(8,14,round(getmaxx/2),314,clipoff);
       2: setviewport(round(getmaxx/2)+3,14,getmaxx-11,314,clipoff);
      end;


   IF ris[num] then  { стирание предыдущего положения }
     IF (x_o[num]<>x_old[num]) and (y_o[num]<>y_old[num]) then
               begin
                  putimage(x_old[num],y_old[num],poin[num]^,0);
                  freemem(poin[num],size[num]);
               end
          else
             begin Sound(450); Delay(100); Nosound end;

 IF kol=1 THEN
   If ris[num]=false Then  { рисование характеристики }
    Begin setlinestyle(0,0,1) ;
      GetViewSettings(ViewPort);
      With ViewPort do
        ComDataPtr(pSpecialData)^.Grafkomp(num,nknr);
      ris[num]:=true;
    end;
                              { рабочая линия }
 if rezim=2 then
  begin
     assign(f,Layout.SpecialDirName + pInName3+'.rl');
     {$I-}  ReSet(f); {$I+}
     IF IOResult<>0 THEN BEGIN sound(300); Delay(200); Nosound;
                           putmessage(' Tie line is not found ');
                           Exit;
                         END
      ELSE
        BEGIN
           while not eof(f) do
             begin setcolor(green);
               readln(f,x1r,y1r,x2r,y2r);
               ComDataPtr(pSpecialData)^.GtamN(x1r,y1r,x1,y1,prt);
               ComDataPtr(pSpecialData)^.GtamN(x2r,y2r,x_n,y_n,prt);
               line(x1,y1,x_n,y_n); setcolor(white);
            end;

       END;  close(f);
    assign(f,Layout.SpecialDirName + pInName2+'.rlr');
     {$I-}  ReSet(f); {$I+}
     IF IOResult<>0 THEN BEGIN sound(300); Delay(200); Nosound;
             putmessage(' Designed tie line is not found ');
                           Exit;
                         END
      ELSE
        BEGIN j:=1;
           while not eof(f) do
             begin setcolor(Yellow);
               readln(f,x1r,y1r);
               if j>1 then
                begin
                 ComDataPtr(pSpecialData)^.GtamN(x1r,y1r,x1,y1,prt);
                 ComDataPtr(pSpecialData)^.GtamN(x2r,y2r,x_n,y_n,prt);
                 line(x1,y1,x_n,y_n); setcolor(white);
                end;
                j:=j+1;
                x2r:=x1r; y2r:=y1r;
            end;
       END;
   close(f);
  end;         { нарисована раб.линия }

                             { нахождение точек }
     ComDataPtr(pSpecialData)^.GTamN(par1,par3,x_,y,c);
     ComDataPtr(pSpecialData)^.GTamN(par1,par2,x_,y_,c);

      if x_o[num]<x_ then begin xl:=x_o[num]-10{5}; xp:=x_+10 end
                else begin xl:=x_-10; xp:=x_o[num]+10{5} end;
      max3(y_o[num],y_,y,max,min);
      yl:=min-10{8}; yp:=max+10{8};

         if (xl>640) or (xl<0) then xl:=xp-100;
         if (xp>640) or (xp<0) then xp:=xl+100;
         if (yl>480) or (yl<0) then yl:=yp-100;
         if (yp>480) or (yp<0) then yp:=yl+100;

      size[num]:=imagesize(xl,yl,xp,yp);  { запоминание области }
      getmem(poin[num],size[num]);
      GetImage(xl,yl,xp,yp,poin[num]^);

     if kol>1 then
      begin
        setlinestyle(1,0,1); setcolor(LightMagenta);
        line(x_pt[num],y_pt[num],x_,y_);
        if rezim=1 then
          begin
            assign(f,Layout.SpecialDirName + pInName2+'.rlr');
            append(f);
            ComDataPtr(pSpecialData)^.gundotN
                                    (x_pt[num],y_pt[num],x1r,y1r);
            ComDataPtr(pSpecialData)^.gundotN(x_,y_,x2r,y2r);
            if ii[num]<kol then begin writeln(f,x1r,y1r);
                             ii[num]:=kol;
                           end;
            close(f);
          end;
      end else ii[num]:=kol;

      if (kol<2) and (rezim=1) then
               begin
                 assign(f,Layout.SpecialDirName + pInName2+'.rlr');
                 rewrite(f); close(f);
               end;

      PutTextXY(x_-3,y_-5,'*',Blue);
   if nknr=1 then  PutTextXY(x_-4,y+5,'+',Green);

      x_point[num]:=x_; y_point[num]:=y_;
      x_old[num]:=xl; y_old[num]:=yl;
  END;
END;
