ПРИЛОЖЕНИЕ. ОПИСАНИЕ ПРИКЛАДНЫХ ПОДПРОГРАММ

(Подпрограммы даны в алфавитном порядке)

Подпрограмма ALFF

1. Вычисление косинуса угла между двумя векторами, заданными проекциями (s1,s2,s3), (n1,n2,n3), где s1 – проекция на ось OX, s2 – OY, s3 – OZ; n1,n2,n3 – соответственно.

2. Обращение к подпрограмме:

ALFF(sl,s2,s3,n1,n2,n3,a);

3. Описание параметров, пояснения:

s1,s2,s3 – real, проекции первого вектора на оси OX,OY,OZ;

n1,n2,n3 – real, проекции второго вектора на оси OX,OY,OZ;

а – real, значение косинуса угла между векторами.

4. Тело подпрограммы:

procedure ALFF( sl,s2,s3,n1,n2,n3 : Re; var a : Re);

begin

a:=(s1*n1+s2*n2+s3*n3)/Sqrt((Sqr(s1)+Sqr(s2)+Sqr(s3))*(Sqr(n1)+Sqr(n2)+Sqr(n3)));

end;{ – ALFF – }

Подпрограмма ALFO

1. Формирует матрицу преобразований

по известным координатам (X0,Y0,Z0) центра снимка и координатам (Хпр,Ynp,Znp) точки прицеливания на объекте.

2. Вызов подпрограммы:

ALFO(XYZ0,XYZ1,М);

3. Описание параметров:

XYZ0 – array [1..3] of real, координаты центра снимка записаны в матрице XYZ0 в последовательности X0,Y0,Z0;

XYZ1 – array [1..3] of real, координаты точки прицеливания записаны в матрице XYZ1 в последовательности Хпр,Ynp,Znp;

М – array [1..4, 1..4] of real, искомая матрица преобразования.

4. Тело подпрограммы:

procedure ALFO( XYZ0,XYZ1 : mr_3; var M : mr_4_4);

label

1,2;

var

sf,cf,sa,ca,x,y,xr,yr : Re;

ib,i,j : Int;

begin

for i:=l to 4 do

for j:=1 to 4 do M[i,j]:=0;

for ib:=l to 3 do

begin

M[ib,ib]:=-1;

M[4,ib]:=XYZ0[ib];

end;

if (XYZ0[1]=XYZ1[1])AND(XYZ0[2]=XYZ1[2]) then goto 1;

sf:=0;

for j:=l to 3 do

sf:=sf+Sqr(XYZ0[j]–XYZ1[j]);

sf:=Abs(XYZ0[3]–XYZ1[3])/Sqrt(sf);

cf:=Sqrt(1–Sqr(sf));

x:=XYZ1[1]–XYZ0[l];y:=XYZ1[2]–XYZ0[2];

xr:=Abs(x)/Sqrt(Sqr(x)+Sqr(y));yr:=Abs(y)/Sqrt(Sqr(x)+Sqr(y));

if (x<=0)AND(y<0) then

begin sa:=xr;ca:=yr, goto 2; end;

if (x<0)AND(y>=0) then

begin sa:=xr;ca:=-yr; goto 2; end;

if (x>=0)AND(y>0) then

begin sa:=-xr;ca:=-yr, goto 2; end;

sa:=-xr;ca:=yr;

2: M[1,1]:=-ca; M[1,2]:=sa; M[2,1]:=-sa*sf; M[2,2]:=-ca*sf;

M[2,3]:=cf; M[3,l]:=-sa*cf; M[3,2]:=-ca*cf; M[3,3]:=-sf;

M[4,4]:=l;

end;{ – ALFO – }

Подпрограмма ALLIPS

(обращается к подпрограмме KVADR)

1. Обеспечивает решение системы из двух уравнений вида

(X–Х11)/(Х11–Xf)=(Y–Y11)/(Y11–Yf)=(Z–Z11)/(Z11–Zf);

(X–X0)**2/a**2+(Y–Y0)**2/b**2+(Z–Z0)**2/c**2–l=0.

Первое уравнение описывает прямую, проходящую через точки (X11,Y11,Z11) и (Xf,Yf,Zf), второе - эллипсоид.

2. Обращение к подпрограмме:

ALLIPS(T,A11,AL,ANS2,INDEX);

3. Описание параметров:

TF – array [1..3] of real, TF=[Xf,Yf,Zf];

A11 – array [1..3] of real, A11=[X11,Y11,Z11];

AL – array [1..2, 1..3] of real;

ANS2 – array [1..2, 1..3] of real;

INDEX - integer, индикатор,

4. Тело подпрограммы:

procedure ALLIPS(Т,А11 : mr_3; AL : mr_2_3;

var Ans2 : mr_2_3; var Index : Int);

var

xz,yz,yy,xx,aa,ba,da : Re;

i,j : Int;

{Прим.: mr_3 – аrrау[1..3] of real,

mr_2_3 – array[1..2,1..3] of real,

Re – real,

Int – integer.}

begin

for i:=l to 2 do

for j:=l to 3 do

Ans2[i,j]:=0;

xx:=A11[3]-T[3];

xz:=(A11[1]-T[1])/xx;

yz:=(A11[2]-T[2])/xx;

xx:=A11[1]-AL[1,1]; уу:=А11[2]-АL[1,2];

AA:=Sqr(AL[2,3]*AL[2,1]*yz)+Sqr(AL[2,1]*AL[2,2])+

Sqr(AL[2,3]*AL[2,2]*xz);

ВА:=2*(–А11[3]*Sqr(AL[2,3]*AL[2,1]*yz)

+Sqr(AL[2,3]*AL(2,l])*yz*yy

–AL[l,3]*Sqr(AL[2,l]*AL[2,2])

–A11[3]*Sqr(AL[2,2]*AL[2,3]*xz)

+Sqr(AL[2,2]*AL[2,3])*xz*xx);

DA:=Sqr(AL[2,3]*AL[2,1]*(A11[3]*yz–yy))

+Sqr(AL[2,3]*AL[2,2]*(A11[3]*xz–xx))

+Sqr(AL[2,l]*AL[2,2])*(Sqr(AL[l,3])-Sqr(AL[2,3]));

KVADR(aa,ba,da,Index, Ans2[1,3],Ans2[2,3]);

if Index=2 then Exit;

Ans2[1,1]:=(Ans2[1,3]–A11[3])*xz+A11[1];

Ans2[1,2]:=(Ans2[1,3]–A11[3])*yz+A11[2];

Ans2[2,1]:=(Ans2[2,3]–A11[3])*xz+A11[1];

Ans2[2,2]:=(Ans2[2,3]–A11[3])*yz+A11[2];

end;{ – ALLIPS – }

Подпрограмма ALLOID

(обращается к ALLIPS, NA8FIR, SOME, PLOS)

1. Вычисляет ближайшую к некоторой точке (XF,YF,ZF) точку пересечения прямой и эллипсоида, ограниченного двумя отсекающими плоскостями. Эллипсоид имеет главные оси, параллельные координатным осям. Положение отсекающих плоскостей произвольное.

2. Обращение к подпрограмме:

ALLOID(T,F,ALL,FS,XYZ,IND,NORM);

3. Описание параметров, пояснения:

Т – аrrау[1..3] of real. Координаты первой точки, через которую проходит прямая;

F – array[1..3] of real. Координаты второй точки, через которую проходит прямая;

ALL - аrrау[1..2,1..3] of real. Это матрица параметров в уравнении эллипсоида:

(Х–Х0)**2/а**2+(Y–Y0)**2/b**2+(Z–Z0)**2/с**2–1=0;

;

FS – аrrау[1..4,1..2] of real. Матрица коэффициентов плоскостей, ограничивающих тело эллипсоида: A1*X+B1*Y+C1*Z+D1=0 и A2*X+B2*Y+C2*Z+D2=0. Нормальный вектор к плоскостям должен быть направлен внутрь изображаемой части эллипсоида.

;

XYZ – аrrау[1..3] of real. Координаты точки решения;

IND – integer, индикатор,

NORM – array[1..3] of real. Матрица проекций нормального вектора к поверхности дважды усеченного эллипсоида в точке решения. Нормаль направлена внутрь тела.

4. Тело подпрограммы:

Procedure ALLOID(T,F : mr_3; ALL : mr_2_3; FS : mr_4_2;

var XYZ : mr_3; var Ind : Int; var NORM : mr_3);

var

P1 : mr_SM_3;

ANS : mr_2 3;

КТО,КАК : mr_4_1;

i,j : Int;

{Прим.: mr_3 – array[1..3] of real,

mr_2_3 – array[1..2,1..3] of real,

mr_4_2 – array[1..4,1..2] of real,

mr_SM_3 – array[1..4,1..3] of real,

mr_4_l – array[1..4,1] of real,

Int – integer.}

begin

for i:=l to 4 do KAK[i,l]:=0;

KTO:=KAK;KTO[3,l]:=l;KTO[4,l]:=-1;

ALLIPS(F,T,ALL,ANS,Ind);

if Ind=2 then Exit;

for i:=1 to 3 do

begin

P1[l,i]:=ANS[l,i];

P1[2,i]:=ANS[2,i];

end;

for i:=l to 4 do KAK[i,1]:=FS[i,l];

PLOS(T,F,KAK,XYZ,Ind);

for i:=l to 3 do P1[3,i]:=XYZ[i];

if Ind=0 then Exit;

for i:=l to 4 do KAK[i,1]:=FS[i,2];

PLOS(T,F,KAK,XYZ,Ind);

for i:=l to 3 do P1[4,i]:=XYZ[i];

if Ind=0 then Exit;

for i:=1 to 4 do KAK[i,1]:=0;

for i:=1 to 2 do

if ((FS[1,1]*P1[i,1]+FS[2,l]*P1[i,2]+FS[3,1]*P1[i,3]+FS[4,1])>=0)

AND

((FS[1,2]*P1[i,l]+FS[2,2]*P1[i,2]+FS[3,2]*P1[i,3]+FS[4,2])>=0)

then KAK[i,1]:=l;

for i:=3 to 4 do

begin

j:=5-i;

if ((FS[1,j]*P1[i,1]+FS[2,j]*P1[i,2]+FS[3,j]*P1[i,3]+FS[4,j])>=0)

AND

((Sqr((P1[i,1]–ALL[1,1])/ALL[2,1])+

Sqr((P1[i,2]–ALL[1,2])/ALL[2,2])+

Sqr((P1[i,3]–ALL[1,3])/ALL[2,3])-1)<=0)

then KAK[i,1]:=1;

end;

i:=4;

NA8FIR(P1,KTО,KAK,F,I,J);

if J=0 then

begin

Ind:=0;

Exit;

end;

for i:=l to 3 do XYZ[i]:=P1[J,i];

Ind:=1;

if KTO[J,1]=l then

begin

for i:=1 to 3 do NORM[i]:=FS[i,1];

Exit;

end;

if KTO[J,1]=-l then

begin

for i:=1 to 3 do NORM[i]:=FS[i,2]; Exit;

end;

for i:=l to 3 do

NORM[i]:=-(XYZ[i]–ALL[1,i])/Sqr(ALL[2,i]);

end;{ - ALLOID -}

Процедура AVTOZON

1. Формирует направляющие вектора отрезков прямых, соединяющих крайние точки двухмерной плоской выпуклой оболочки. Направляющие вектора ориентированы так, что достигается положительность значений функций каждой прямой внутри зоны. Операция производится над несколькими оболочками.

2. Обращение к подпрограмме:

AVTOZON (SKR,N,М,_KR).

3. Описание параметров, пояснения:

SKR – array [1..SM,1..2,1..MKT] of real. SKR – трехмерный массив, объединяющий MKT плоскостей, на каждой из которых задано SM точек посредством двух координат X,Y. Значения SM, MKT определяются вызывающим модулем. Порядок следования точек в SKR должен быть однозначным (по или против часовой стрелки внутри каждой зоны);

N – integer, число обрабатываемых крайних точек каждой зоны;

М – integer, число обрабатываемых плоскостей;

Прим.: N<=SM, М<=МКТ.

_KR – array [1..SM,1..2,1..MKT] of real, _KR – трехмерный массив направляющих векторов-отрезков, соединяющих крайние точки. Проекции направляющих векторов выбраны так, чтобы обеспечить для любой прямой, проходящей через точки i+1, i, положительность значений функции этой прямой во внутренней точке (Хb,Yb,Zb) зоны: (Xb–Xi+l)(Yi+l–Yi)–(Xi+1–Xi)(Yb–Yi+1)>0.

4. Тело подпрограммы:

procedure AVTOZON(SKR : mr_SM_2_MKT; N,M : Int;

var _KR : mr_SM 2 MKT); var i,j,k : Int;

{Прим. mr_SM_2_MKT-array[1..SM,1..2,1..MKT] of real,

Int – integer}

begin for i:=1 to (N-1) do

for j:=1 to 2 do

for k:=1 to M do

_KR[i,j,k]:=SKR[i+1,j,k]–SKR[i,j,k];

for j:=1 to 2 do

for k:=1 to M do

_KR[Nj,k]:=SKR[lj,k]–SKR[N,j,k];

for i:=l to M do

if ((SKR[3,1,i]–SKR[1,1,i])*_KR[1,2,i]

–(SKR[3,2,i]–SKR[1,2,i])*_KR[1,1,i])<0

then

for j:=1 to N do

for k:=1 to 2 do

_KR[j,k,i]:=-_KR[j,k,i];

end;{ - AVTOZON -}

Подпрограмма ВETTA

1. ВETTA рассчитывает косинус угла зеркальности, который определяется как угол между зеркально отраженным от поверхности лучом и направлением на приемник света.

2. Обращение к подпрограмме:

BETTA(n1,n2,n3,s1,s2,s3,r1,r2,r3,q).

3. Описание параметров, пояснения:

n1,n2,n3 – real, проекции нормали к поверхности соответственно на оси OX,OY,OZ. Нормаль – внешняя;

s1,s2,s3 – real, проекции вектора, направленного из точки поверхности на источник света;

r1,r2,r3 – real, проекции вектора, направленного из точки поверхности на приемник света;

q – real, косинус угла зеркальности.

4. Тело подпрограммы:

procedure ВЕТТА(n1,n2,n3,s1,s2,s3,r1,i2,r3 : Re; var q : Re );

begin

q:=(s1*n1+s2*n2+s3*n3)/(Sqr(n1)+Sqr(n2)+Sqr(n3)); q:=(r1*(2.0*n1*q–s1)+r2*(2.0*n2*q–s2)+r3*(2.0*n3*q–s3))/

Sqrt((Sqr(r1)+Sqr(r2)+Sqr(r3))*

(Sqr(2.0*n1*q–s1)+Sqr(2.0*n2*q–s2)+Sqr(2.0*n3*q–s3)));

end;{ - ВЕTTА - }

Подпрограмма CILIND

(обращается к PLOS, KVADR, NA8FIR, SOME, PRESS)

1. Подпрограмма вычисляет координаты точки пересечения прямой с поверхностью тела, ограниченного круговым цилиндром и торцевыми плоскими кругами. Из всех возможных пересечений выбирается ближайшая точка к некоторой критериальной (Xf,Yf,Zf), лежащей на прямой. Вычисляются параметры ненормированного нормального вектора, ориентированного внутрь тела. Положение цилиндра – произвольное и задается двумя осевыми точками на торцах.

2. Обращение к подпрограмме:

CILIND(F,S,R,T11,TF,GOT,WHAT,NORA).

3. Описание параметров, пояснения:

F – array [1..3] of real. F – матрица координат X, Y, Z осевой точки цилиндра на его первом торце;

S – array [1..3] of real. F – матрица координат X, Y, Z осевой точки цилиндра на его втором торце;

R – real. R – радиус цилиндра;

T11 – array [1..3] of real. T11 – матрица координат X11, Y11, Z11 первой точки, через которую проходит прямая;

TF – array [1..3] of real. TF – матрица координат X11, Y11, Z11 второй (критериальной) точки, через которую проходит прямая;

GOT – array [1..3] of real. GOT – матрица искомых координат точки, решения X, Y, Z;

WHAT – integer, индикатор. WHAT=1, если решение единственно, WHAT=0, если решений нет или их бесконечно много;

NORA – array [1..3] of real. В этой матрице записаны проекции ненормированной нормали к поверхности тела в точке решения (GOT) соответственно вдоль осей ОХ, OY, OZ. Нормаль направлена внутрь тела.

4. Ограничения и области допустимых значений.

Состояние Z11>=Zf(T11[3]>=TF[3]) недопустимо.

5. Тело подпрограммы:

procedure CILIND(F,S : mr_3;R : Re; T11,TF: mr_3;

var GOT : mr_3; var WHAT : Int; var NORA : mr_3);

var

ABC : mr_3;

XZ,YZ,XX,YY,Lola,Stom,A,B,C : Re;

P1 : mr_SM_3;

WHO,КАК,FIR,SEK : mr_4_l;

N,I,J,Jop : Int;

{Прим.: mr_3 – array[1..3) of real,

mr_SM_3 – array[1..4,1..3] of real,

mr_4_l – array[1..4,1] of real,

Re – real,

Int – integer.}

Begin

N:=4;

WHO[1,1]:=0;WHO[2,1]:=0;WHO[3,1]:=1;WHO[4,1]:=1;

for i:=l to 3 do ABC[i]:=S[i]–F[i];

Lola:=0;

for i:=1 to 3 do LoIa:=Lola+Sqr(ABC[i]);

Lola:=Sqrt(Lola);

for i:=l to 3 do ABC[i]:=ABC[i]/Lola;

XX:=T11[1]-F[1]; YY:=T11[2]–F[2];

XZ:=(T11[1]–TF[1])/(T11[3]–TF[3]);

YZ:=(T11[2]–TF[2])/(T11[3]–TF[3]);

Lola:=ABC[l]*XZ+ABC[2]*YZ+ABC[3];

Stom:=-T11[3]*(ABC[1],XZ+ABC[2],YZ)–ABC[3]*F[3]+

ABC[1]*XX+ABC[2]*YY;

A:=Sqr(XZ)+Sqr(YZ)+l–Sqr(Lola);

if A=0 then

begin

WHAT:=0;

Exit;

end;

B:=2*(-Sqr(XZ)*T11[3]+XZ*XX–Sqr(YZ)*T11[3]+

YZ*YY–F[3]–Lola*Stom);

C:=Sqr(XZ*T11[3]–XX)+Sqr(YZ*T11[3]–YY)+

Sqr(F[3])–Sqr(Stom)–Sqr(R);

KVADR(A,B,C,WHAT,P1[1,3],P1[2,3]);

if WHAT=2 then

begin

WHAT:=0;

Exit;

end;

for i:=1 to 3 do

FIR[i,1]:=ABC[i];

FIR[4,1]:=ABC[1]*F[1]–ABC[2]*F[2]–ABC[3]*F[3];

for i:=l to 4 do SEK[i,1]:=-FIR[i,1];

SEK[4,1]:=ABC[1]*S[1]+ABC[2]*S[2]+ABC[3]*S[3];

PLOS(T11,TF,FIR,GOT,WHAT);

if WHAT=0 then Exit;

for i:=l to 3 do P1[3,i]:=GOT[i];

PLOS(T11,TF,SEK,GOT,WHAT);

for i:=1 to 3 do P1[4,i]:=GOT[i];

for i:=1 to 2 do

begin

DIRECT(T11,TF,P1[i,3],GOT);

for j:=1 to 3 do P1[i,j]:=GOT[j];

end;

for i:=1 to 2 do

if ((P1[i,1]*FIR[1,1]+P1[i,2]*FIR[2,1]+

P1[i,3]*FIR[3,1]+FIR[4,1])>=0)

AND

((P1[i,1],SEK[1,1]+P1[i,2]*SEK[2,1]+

P1[i,3]*SEK[3,1]+SEK[4,1])>=0)

then KAK[i,1]:=l

else KAK[i,1]:=0;

for i:=3 to 4 do

if (Sqr(P1[i,1]–F[l])+Sqr(P1(i,2]–F[2])+Sqr(P1[i,3]–F(3])

-Sqr(ABC[l]*(P1[i,1]–F[1]+ABC[2]*(P1[i,2]–F[2])+

ABC[3]*(P1[i,3]–F[3]))–Sqr(R))<=0

then KAK[i,1]:=l

else KAK[i,1]:=0;

NA8FIR(P1,WHO,KAK,TF,N,Jop);

if Jop=0 then

begin

WHAT:=0;

Exit;

end;

for i:=1 to 3 do GOT[i]:=P1[Jop,i];

WHAT:=1;

if WHO[Jop,1]=l then

begin

NORA: = ABC;

Exit;

end;

Lola:=0;

for i:=1 to 3 do

Lola:=Lola+ABC[i]*(GOT[i]–F[i]);

for i:=1 to 3 do

NORA[i]:=GOT[i]–F[i]–ABC[i]*Lola;

end;{ - CILIND - }

Подпрограмма DIRECT

1. По заданному уравнению прямой и известной координате Z некоторой точки на прямой находит две остальные координаты точки. Прямая задается посредством координат двух известных точек (X1,Y1,Z1) и (Х2,Y2,Z2).

2. Обращение к подпрограмме:

DIRECT(A,В,Z,XYZ);

3. Описание параметров:

А – array [1..3] of real, матрица координат первой точки (X1,Y1,Z1), через которую проходит прямая;

В – array [1..3] of real, матрица координат второй точки (Х2,Y2,Z2).

Z – real, известная координата Z на прямой;

XYZ – array [1..3], матрица координат точки на прямой.

4. Ограничения и область допустимых значений: Z1≠Z2.

5. Тело подпрограммы:

procedure DIRECT(A,B : mr_3; Z : Re; var XYZ : mr_3);

{ Прим.: mr_3 – array[1..3] of real, Re – real, Int – integer}

var

i : Int;

begin

XYZ[1]:=(Z–A[3])*(A[1]–B[1])/(A[3]–B[3])+A[1];

XYZ[2]:=(Z-A[3])*(A[2]–B[2])/(A[3]–B[3])+A[2];

XYZ[3]:=Z;

end;{ - DIRECT - )

Подпрограмма Е2

1. Вычисляет освещенность точки поверхности, обладающей диффузными и зеркальными (бликовыми) свойствами при освещении точечным источником (Солнцем) и полусферическим облучателем (небом).

2. Обращение к подпрограмме:

E2(b,ca,cb,n,cg,a,r,ed,ez,et,t);

3. Описание параметров, пояснения:

b – real, освещенность точки поверхности, b=[0,1];

са – real, косинус угла между внешней нормалью к поверхности и направлением на Солнце;

cb – real, косинус угла между направлением на приемник света и зеркально отраженным лучом;

n – integer, показатель ширины диаграммы зеркального отражения, n=[1,200];

cg – real, косинус угла между внешней нормалью к поверхности и направлением вертикально вверх (в зенит неба);

а – real, коэффициент яркости поверхности (диффузные свойства), а=[0,1];

r – real, коэффициент зеркального отражения поверхности, r=[0,1];

ed – real, относительный диапазон освещенности поверхности, обладающей только диффузными свойствами (а=1);

ez – real, относительный диапазон освещенности поверхности, обладающей только зеркальными свойствами (r=1);

et – real, относительный диапазон освещенности в тени;

t – real, признак освещенности точки поверхности, t=1 – на свету, t=0 – в тени.

Примечание: ed,ez,et нормируются друг к другу так, чтобы ed+ez+et=1.

4. Тело подпрограммы:

procedure E2(var b: Re;ca,cb: Re;n: Int;cg,a,r,ed,ez,et,t : Re);

function Step(cb : Re; n : Int): Re;

var

с : Re;

begin

c:=l; if n>0 then

repeat

c:=c*cb; Dec(n); until n=0; Step:=c; end;

begin

if cb>0.05 then b:=(t*ez*r*Step(cb,n)+a*ct*0.5*(l+cg)+ed*ca*a*t)

else b:=a*et*0.5*(1+cg) +ed*ca*a*t;

end;{ - E2 -}

Подпрограмма KONYS

(обращается к PICA, DIRECT, NASFIR)

1. Определяет ближайшую к фокусу (XF,YF,ZF) точку пересечения прямой (светового луча) и конуса, ограниченного двумя плоскостями, а также нормальный вектор в установленной точке.

2. Обращение к подпрограмме

KONYS(T,F,KON,FS,XYZ,Ind,Norm).

3. Описание параметров, пояснения:

Т – аrrау[1..3] of real. T=[X1,Y11,Z11] – матрица координат первой точки, через которую проходит прямая светового луча;

F – аrrау[1..3] of real. F=[XF,YF,ZF] – матрица координат второй точки, через которую проходит прямая светового луча;

KON – аrrау[1..2,1..3] of real.

– матрица коэффициентов уравнения конуса (см. описание в подпрограмме PICA);

FS – аrrау[1..4,1..2] of real.

– коэффициенты уравнений первой A1*X+B1*Y+C1*Z+D1=0 и второй A2*X+B2*Y+C2*Z+D2=0 плоскостей, секущих конус, причем нормаль к поверхности плоскостей должна быть направлена внутрь видимой части конуса;

XYZ – array [1..3] of real, координаты решения;

IND – integer, индикатор,

NORM – array[1..3] of real. Матрица проекций нормального вектора N на оси OX,OY,OZ. Нормаль внутренняя.

4. Ограничения и области допустимых значений.

Проверка содержательной части входных параметров отдельно не производится.

5. Тело подпрограммы:

procedure KONYS( T,F : mr_3; KON : mr_2_3; FS : mr_4_2;

var XYZ : mr_3; var Intd : Int; var NORM : mr_3);

var P : mr_SM_3;

КТО,КАК : mr_4_l;

i,j,k : Int;

{Прим.: mr_3 – array[1..3] of real, mr_2_3 – array[1..2,1..3] of real, mr_4_2 – array[1..4,1..2] of real, mr_SM_3 – array[1..4,1..3] of real, mr_4_l – array[1..4,l] of real, Int – integer.}

begin for i:=l to 4 do KAK[i,l]:=0;

KTO:=KAK;

KTO[3,1]:=1;KTO[4,l]:s=1;

PICA(T,F,KON,P[1,3],P[2,3],Ind);

if Ind=0 then Exit;

for i:=1 to 2 do

begin

DIRECT(T,F,P[i,3],XYZ);

for j:=1 to 3 do P[i,j]:=XYZ[j];

end;

for i:=1 to 2 do

begin

for j:=1 to 4 do KAK[j,1]:=FS[j,i];

PLOS(T,F,KAK,XYZ,Ind);

if Ind=0 then Exit;

j:=i+2;

for k:=1 to 3 do P[j,k]:=XYZ[k];

end;

for i:=1 to 4 do KAK[i,1]:=0;

for i:=1 to 2 do

if (FS[1,1]*P[i,1]+FS[2,1]*P[i,2]+FS[3,1]*P[i,3]+FS[4,1]>=0)

AND (FS[1,2]*P[i,1]+FS[2,2]*P[i,2]+FS[3,2]*P[i,3]+FS[4,2]>=0)

then KAK[i,1]:=1;

for i:=3 to 4 do

if (Sqr(P[i,1]–KON[1,1])/KON[2,l]+

Sqr(P[i,2]–KON[1,2])/KON[2,2]+

Sqr(P[i,3]–KON[1,3])/KON[2,3])<=0

then

KAK[i,1]:=1;

i:=4;

NA8FIR(P,KTO,KAK,F,i,j);

if j=0 then

begin

Ind:=0;

Exit;

end;

for i:=1 to 3 do XYZ[i]:=P[j,i];

Ind:=1;

if КТО [j,1]<>0 then

for i:=1 to 3 do NORM[i]:=FS[i,1]

else for i:=1 to 3 do NORM[i]:=(XYZ[i]–KON[1,i])/KON[2,i];

end;{ - KONYS - }

Подпрограмма КОROB

(обращается к PLOS, SOME, YESNO)

1.Определяет координаты точки пересечения прямой и выпуклого шестигранника, а также вектор внешней нормали в точке пересечения. Прямая задается двумя точками (X1,Y1,Z1) и (Х2,Y2,Z2). Среди всех возможных пересечений выбирается ближайшее к точке (Х2,Y2,Z2). Шестигранник задается матрицей KUBB, где каждый столбец описывает отдельную грань (плоскость), а в свою очередь плоскость описывается четырьмя коэффициентами А,В,С,D в уравнении АХ+BY+CZ+D=0. Знаки коэффициентов предварительно выбраны так, чтобы нормаль к каждой грани была направлена внутрь шестигранника.

Область допустимых значений: Z1 не равно Z2.

2. Обращение к подпрограмме:

KOROB(T1,Т2,KUBB,XYZ,NORM,ANT).

3. Описание параметров:

Т1 – array [1..3] of real, T1[X1,Y1,Z1] – матрица координат первой точки, через которую проходит прямая;

Т2 – array [1..3] of real, Т2[Х2,Y2,Z2] – матрица координат второй точки, через которую проходит прямая;

KUBB – array [1..4, 1..6] of real, матрица, описывающая шестигранник;

XYZ – array [1..3] of real, матрица координат (X,Y,Z) ближайшего к точке (Х2,Y2,Z2) пересечения прямой и шестигранника;

NORM – аrrау [1..3] of real, матрица проекций вектора внешней нормали в точке пересечения на оси OX, OY, OZ;

ANT – integer, индикатор,

4. Тело подпрограммы:

procedure KOROB(Т1,Т2 : mr_3; KUBB : mr_4_6;

var XYZ,NORM : mr_3; var Ant: Int);

var

SOV : array[1..6,1..3] of Re;

BUF : mr_SM_3;

WHO : array[1..6] of Int;

KUBA: mr_4_l;

i,j,k,jor,an1,nom : Int;

{Прим.: mr_3 – array[1..3] of real,

mr_4_6 – array[1..4,1..6] of real,

mr_SM_3 – array[1..4,1..3] of real,

mr_4_l – array[1..4,1] of real,

Int – integer, Re – real.}

begin

j:=0;

for i:=1 to 6 do

begin

KUBA[1,1]:=KUBB[1,i];

KUBA[2,1]:=KUBB[2,i];

KUBA[3,1]:=KUBB[3,i];

KUBA[4,1]:=KUBB[4,i];

PLOS(T1,T2,KUBA,XYZ,ANT);

if Ant=1 then

begin

YESNO(XYZ,KUBB,An1);

if An1=1 then

begin

j:=j+1;

WHO[j]:=i;

for k:=1 to 3 do

SOV[j,k]:=XYZ[k];

end;

if j=0 then

begin

Ant:=0; Exit;

end;

Ant:=1;

for i:=1 to 4 do

for k:=l to 3 do

BUF[i,k]:=SOV[i,k];

SOME(BUF,T2,j,Jor);

for i:=1 to 3 do

XYZ[i]:=SOV[Jor,i];

j:=WHO[Jor];

for i:=1 to 3 do

NORM[i]:=KUBB[i,j];

end;{ - KOROB - }

Подпрограмма KRILO

(обращается к PLOS, YNZONA)

1. Определяет координаты и нормальный вектор в точке пересечения луча и плоского выпуклого многоугольника. Многоугольник задается уравнением плоскости и списком (по или против часовой стрелки) координат крайних точек, причем берутся только две координаты X и Y, или Y и Z, или Z и X.

2. Обращение к подпрограмме:

KRILO(P2,NOR_,Т,F,Р,YN,XYZ,Proek);

3. Описание параметров:

Р2 – array [l..SM_2,1..2] of real, матрица координат крайних точек, число столбцов 2, строк – любое (N).

или или .

Точки записаны по (против) часовой стрелке обхода вершин многоугольника;

NOR_ – array [l..SM_2,1..2], матрица проекций нормали к отрезкам, соединяющим две соседние вершины многоугольника. Число столбцов 2, строк N. В первой строке записан вектор, соединяющий первую и вторую точки из Р2. Оси, на которые проецируется вектор, соответствуют осям, предусмотренным в Р2, т. е.

если , то ;

T – array [1..3] of real, координаты центра рецептора, T=[X Y Z];

F – array [1..3] of real, координаты точки фокуса, F = [Xf Yf Zf];

P – array [1..4] of real, описание плоскости, в которой лежит многоугольник, где АХ+BY+CZ+D=0;

YN – integer, индикатор,

XYZ – array [1..3] of real, координаты точки решения пересечения прямой и многоугольника;

Proek – integer, указатель наименования координат крайних точек,

если

4. Тело подпрограммы:

procedure KRILO(P2,NOR_ : mr_SM_2; N : Int;T,F : mr_3; P : mr_4_l;

var YN : Int; var XYZ : mr_3; Proek : Int);

var

T2 : array[1..2] of Re;

i,j,k1,k2 : Int;

{Прим.: mr_3 – array[1..3] of real,

mr_4_l – array[1..4,1] of real,

mr_SM_2 – array[l..SM,1..2] of real,

Int – integer, Re – real.}

begin

if Proek=l then begin k1:=1;k2:=2; end;

if Proek=2 then begin K1:=2;K2:=3; end;

if Proek=3 then begin k1:=3;K2:=1; end;

PLOS(T,F,P,XYZ,YN);

if YN=0 then Exit;

T2[1]:=XYZ[k1];T2[2]:=XYZ[k2];

YNZONA(P2,NOR_,N,T2[1],T2[2],YN);

end;{ - KRILO - }

Подпрограмма KVADR

1. Решает квадратное уравнение общего вида А*Х**2+В*Х+С=0.

2. Обращение к подпрограмме:

KVADR(A,B,C,Ind,X1,X2).

3. Описание параметров, пояснения:

А – real, коэффициент А.

В – real, коэффициент В.

С – real, коэффициент С.

А1 – real, значение первого решения.

А2 – real, значение второго решения.

Ind – real, индикатор:

4. Тело подпрограммы:

procedure KVADR(A,B,C : Re; var Intd : Int; var X1,X2 : Re);

var

V: Re;

begin

V:=Sqr(B)–4*A*C;

if (V<0)or(A=0) then

begin

Intd:=2;

Exit;

end

else

begin

V:=Sqrt(V);

X1:=(–b+V)/(2*A);

X2:=(–B–V)/(2*A);

end;

if V=0 then Intd:=0

else Intd:=1;

end;{ - KVADR - }

Подпрограмма MMGG

1. Вычисляет произведение двух матриц A[K,L]*B[L,M]. Результат помещается в матрицу С[К,М].

2. Обращение к подпрограмме:

MMGG(A,B,K,L,M,C);

3. Описание параметров, пояснения:

А – array[1..K,1..L] of real. Левый множитель матричного произведения А*В=С;

В – array[1..L,1..M] of real. Правый множитель матричного произведения А*В=С;

С – array[1..K,1..M] of real. Результат матричного произведения А*В=С;

K,L,M – byte, размерности матриц. Максимальное значение каждой размерности – 256.

4. Ограничения и области допустимых значений:

Размерности матриц должны соответствовать описаниям, максимальные значения L, М, К – 256.

5. Тело подпрограммы:

procedure MMGG(MA,MB : mr_SM_SM; k,l,m : By; var MC : mr_SM_SM);

var

i,j,n : Int;

{Прим.: mr_SM_SM – array[1..SM,1..SM] of real,

by – byte,

Int – integer.}

begin

for i:=1 to k do

for j:=l to m do

MC[i,j]:=0;

for i:=1 to k do

for j:=l to m do

for n:=l to 1 do

MC[i,j]:=MC[i,j]+MA[i,n]*MB[nj];

end;{ - MMGG - }

Подпрограмма NA8FIR

(обращается к PRESS, SOME)

1. Эта подпрограмма из множества точек, которые не все принадлежат объемной фигуре, выбирает сначала принадлежащие поверхности фигуры, а из последних – ближайшую точку по отношению к некоторой заданной (критериальной). В качестве объемных фигур подразумевается эллипсоид или цилиндр, ограниченные двумя плоскостями.

2. Обращение к подпрограмме:

NA8FIR(T,WHO,КАК,TF,N,JOР).

3. Описание параметров:

Т – array [1..SM_3,1..3] of real, исходная матрица точек пересечения луча со всеми поверхностями, ограничивающими объемную фигуру.

Число столбцов в матрице Т равно 3. В первую и вторую строку записывают координаты пересечения с первой и второй плоскостью. После выполнения процедуры матрица преобразуется;

WHO – array [1..4] of real, матрица имеет столько же строк, что и Т: например, если WHO[l,1]=1, то в первой строке матрицы Т записано решение, принадлежащее некоторой поверхности тела, если WHO[l,1]=0, то решения нет и строка из Т имеет машинное заполнение;

КАК – array [1..4] of real, матрица имеет столько же строк, что и Т. КАК определяет принадлежность точки – строки из Т поверхности объемного тела. Например, если КАК[1,1]=1, то первая точка из Т лежит на поверхности тела, если КАК[1,1]=0, то точка лежит вне тела, но на продолжении одной из его боковых поверхностей;

TF – аrrау [1..3] of real, точка фокуса. TF=(Xf,Yf,Zf);

N – integer, на входе – размерность первых матриц Т, WHO, КАК по числу строк, на выходе – число рабочих строк тех же матриц. Рабочие строки – это те, которые соответствуют точкам, лежащим на поверхности тела;

JOP – integer, выходной показатель, JOP=0, если решений нет, JOP=1 – решение находится в первой строке преобразованной матрицы Т, JOP=N – решение находится в N-й строке преобразованной матрицы Т.

4. Тело подпрограммы:

procedure NA8FIR(var Т: mr_SM_3; var WHO,КАК : mr_4_l;

TF : mr_3; var N,Jop : Int);

label

var

ii,jj,i,k,j : Int;

BUF : mr_SM_3;

{Прим.: mr_3 – array[1..3] of real,

mr_SM_3 – array[1..4,1..3] of real,

mr_4_l – array[1..4,1] of real,

Int - integer.}

begin

Jop:=0;

if SUMMR_4_1(KAK)=0 then Exit;

k:=l;

1: for i:=k to N do

if KAK[i,1]=0 then

begin

PRESSMR_4_1(KAK,i,N);N:=N+1;

PRESSMR_4_1(WHO,i,N);N:=N+1;

for ii:=1 to 4 do

for jj:=1 to 3 do

BUF[ii,jj]:=T[ii,jj];

PRESSMR_SM_3(BUF,i,N);

for ii:=1 to 4 do

for jj:=1 to 3 do

T[ii,jj]:=BUF[ii,jj];

goto 1;

end

else

begin

k:=k+1;

goto 1;

end;

for i:=1 to 4 do

for j:=1 to 3 do

BUF[i,j]:=T[i,j];

SOME(BUF,TF,N,Jop);

for i:=1 to 4 do

for j:=1 to 3 do

T[i,j]:=BUF[i,j];

end;{ - NA8FIR - }

function SUMMR_4_1(Mat : mr_4_l):Re;

var

i,j : Int;

S : Re;

begin

S:=0;

for i:=1 to 4 do

S:=S+Mat[i,1];

SUMMR_4_1:=S;

end;{ - SUMMR_4_1 -}

procedure PRESSMR_SM_3(var A : mr_SM_3; L : Int; var N : Int);

var

i,j : Int;

begin

N:=N–1;

for i:=1 to N do

if i>=L then

A[i]:=A[i+l];

end;{ - PRESSMR_SM_3 - }

procedure PRESSMR_4_1(var A : mr_4_l; L : Int; var N : Int);

var

i,j : Int;

begin

N:=N–1;

for i:=l to N do

if i>=L then

A[i,1]:=A[i+1,1];

end;{ - PRESSVEC4_1 - }

Подпрограмма OPTIMA

(обращается к OBMEN,PRESS)

1. Обеспечивает построение выпуклой двухмерной оболочки-многоугольника над множеством точек на плоскости.

2. Обращение к подпрограмме:

OPTIMA(A,n,Indic);

3. Описания параметров, пояснения:

А – array[1..NT,1..2] of real. Массив точек, над которыми строится выпуклая оболочка.

Значение SM определяет число строк в матрице А. Порядок следования строк – произвольный. На выходе А переформируется так, что первые N строк описывают вершины выпуклой оболочки по или однозначно против часовой стрелки;

N – integer. На входе это число первых строк – точек матрицы А, над которыми строится оболочка, N<=SM. На выходе первые N строк в матрице А по/против час. стрелки описывают вершины выпуклой оболочки;

Indic – integer. Индикатор: I=1, если построение оболочки прошло успешно; I=0, если над фигурой невозможно построить выпуклую оболочку (точки принадлежат прямой).

4. Ограничения и области допустимых значений:

Значения А и n после обращения к подпрограмме изменяются.

5. Тело подпрограммы:

procedure OPTIMA(var А : mr_SM_2; var n.lndik : Int);

label

1,4,5;

var

ij,r,s,k,m,ans,stand : Int;

{Прим.: mr_SM_2 – array[1..SM,1..2] of real,

int – integer.}

begin

indik:=1;

s:=0;j:=1;

1: k:=0;

for i:=2 to n do

begin

m:=0;

for r:=2 to n do

begin

ans:=SIGN((A[r,1]–A[j,1])*(A[i,2]–A[j,2])–

(A[i,1]–A[j,1]*(A[r,2]–A[j,2]));

if ans=0 then goto 4;

m:=m+1;

if m=l then stand:=ans;

if ans<>stand then goto 5;

end;

if m=0 then goto 5;

s:=s+1; k:=i;

OBMEN(A,n);

if s=n then Exit;

goto 1;

5: end;

if k=0 then

begin

PRESSMR_SM_2(A,j,n);

if n=2 then

begin

Indik:=0;

Exit;

end;

goto 1;

end;

end;{ - OPTIMA - }

procedure PRESSMR_SM_2(var A : mr_SM_2; L : Int; var N : Int);

var

i,j : Int;

begin

N:=N–1;

for i:=1 to N do

if i>=L then

A[i]:=A[i+1];

end;{ - PRESSMR_SM_2 - }

procedure OBMEN(var A : mr_SM_2; var nr : Int);

var

В : array[1..2] of Re;

i,j : Int;

begin

for i:=1 to 2 do B[i]:=A[1,i];

for i:=1 to nr–1 do

for j:=1 to 2 do

A[i,j]:=A[i+1,j);

for i:=1 to 2 do

A[nr,i]:=b[i];

end;{ - OBMEN - }

Подпрограмма PICA

(обращается к подпрограмме KVADR).

1. Определяет координаты Z1 и Z2 двух точек пересечения прямой с конусом: F(X,Y,Z)=0, где F(X,Y,Z)=(X–Х0)**2/А+(Y–Y0)**2/B+(Z–Z0)**2/C, одно из трех чисел А, В, С равно –1, а остальные два – положительны.

2. Обращение к подпрограмме:

PICA(T1,Т2,KON,Z1,Z2,INDI);

3. Описание параметров:

Т1 – array[1..3] of real, Т1=(X11,Y11,Z11] – матрица координат первой точки (центра рецептора), через которую проходит прямая (световой луч);

Т2 – array[1..3] of real, Т2=(Xf,Yf,Zf] – матрица координат второй точки (точки фокуса), через которую проходит прямая (световой луч);

KON – array [1..2,1..3] of real, см. выше уравнение конуса. В первой строке X0,Y0,Z0, во второй – А,В,С соответственно;

Z1 – real, координата первого решения;

Z2 – real, координата второго решения;

INDI – integer, индикатор, если INDI=1, если есть решения, INDI=0, если решений нет или их бесконечно много.

4. Тело подпрограммы:

procedure PICA(Т1,Т2 : mr_3; KON : mr_2_3;

var Z1,Z2 : Re; var Indi : Int);

var

XYZ : mr_3;

NORM : array[1..2] of Re;

A : Int;

begin

NORM[1]:=(T1[3]–T2[3]);

NORM[2]:=(T1[2]–T2[2])/NORM[1];

NORM[1]:=(T1[1]–T2[1])/NORM[1];

XYZ[1]:=KON[2,2]*KON[2,3]*Sqr(NORM[1])+

KON[2,1]*KON[2,3]*Sqr(NORM[2])+

KON[2,1]*KON[2,2];

XYZ[2]:=2*(KON[2,2]*KON[2,3]*NORM[1]*((T1[1]–KON[1,1])–

T1[3]*NORM[1])+KON[2,1]*KON[2,3]*NORM[2]*((T1[2]–

KON[l,2])–T1[3]*NORM[2])–KON[2,1]*KON[2,2]*KON[1,3]);

XYZ[3]:=KON[2,1]*KON[2,3]*Sqr(T1[3]*NORM[2]–(T1[2]–KON[1,2]))+

KON[2,2]*KON[2,3]*Sqr(T1[3]*NORM[1]–(T1[1]–KON[1,1]))+

KON[2,1]*KON[2,2]*Sqr(KON[1,3]);

KVADR(XYZ[1],XYZ[2],XYZ[3],A,Z1,Z2);

if A=2 then Indi:=0

else Indi:=1;

end;{ - PICA - }

Процедура PLOS

(Обращается к процедуре DIRECT)

1. Определяет координаты пересечения прямой и плоскости. Прямая задается двумя точками с координатами соответственно X1, Y1, Z1 и Х2, Y2, Z2. Плоскость задается параметрами А, В, С, D в уравнении АХ+BY+CZ+D=0. Область допустимых значений: Z1¹Z2.

2. Обращение к подпрограмме:

PLOS(T1,Т2,Р,XYZ,FLAG).

3. Описание параметров:

Т1 – array [1..3] of real, Т1 – матрица координат первой точки (X1,Y1,Z1), через которую проходит прямая;

Т2 – array [1..3] of real, Т2 – матрица координат второй точки (X2,Y2,Z2), через которую проходит прямая;

Р – array[1..4] of real, Р – матрица-столбец, элементы которой А, В, С, D (сверху вниз);

XYZ – array[1..3] of real, XYZ – матрица координат точки пересечения прямой и плоскости, где координаты соответственно X, Y, Z;

FLAG – integer, индикатор, FLAG=1, если пересечение единственно, FLAG=0, если решений нет или их бесконечное множество.

4. Тело подпрограммы:

procedure PLOS(Т1,Т2 : mr_3; Р : mr_4_l; var XYZ : mr_3;

var Flag : Int);

var

Znam : Re;

{Прим.: mr_3 – array[1..3] of real,

mr_4_l – array[1..4,1] of real,

Int - integer.}

begin

Znam:=P[1,1]*(T1[1]–T2[1])+P[2,1]*(T1[2]–T2[2])+P[3,1]*

(T1[3]–T2[3]);

if Znam=0 then

begin

Flag:=0; Exit;

end;

Flag:=1;

XYZ[3]:=T1[3]+(T1[3]–T2[3])*

(-P[1,1]*T1[1]–P[2,1]*T1[2]–P[3,1]*T1[3]–P[4,1])/Znam;

DIRECT(T1,T2,XYZ[3],XYZ);

end;{ - PLOS - }

Подпрограмма PL3T

1. Определяет коэффициенты уравнения плоскости АХ+BY+CZ+D=0 по координатам трех точек.

2. Обращение к подпрограмме:

PL3T(T0,Т1,Т2,Р).

3. Описание параметров:

Т0 – array[1..3] of real, в этой матрице записаны координаты X, Y, Z первой точки;

Т1 – array[1..3] of real, соответственно для второй точки;

Т2 – array[1..3] of real, соответственно для третьей точки;

Р – array[1..4] of real, матрица-столбец коэффициентов A, В, С, D уравнения плоскости.

4. Тело подпрограммы:

procedure PL3T(А,В,С : mr_3; var Р : mr_4_l);

var

i: Int;

{Прим.: mr_3 – array[1..3] of real,

mr_4_l – array[1..4,1] of real,

Int – integer.}

begin

for i:=1 to 3 do

begin

B[i]:=B[i]–A[i];

C[i]:=C[i]–A[i];

end;

P[1,1]:=B[2]*C[3]–C[2]*B[3];

P[2,1]:=-B[1]*C[3]+C[1]*B[3];

P[3,1]:=B[1]*C[2]–C[1]*B[3];

Р[4,1]:=-А[1]*Р[1,1]+А[2]*Р[2,1]–А[3]*Р[3,1];

end;{ - PL3T - }

Процедура PLOS

(Обращается к процедуре DIRECT)

1. Определяет координаты пересечения прямой и плоскости. Прямая задается двумя точками с координатами соответственно X1,Y1,Z1 и Х2,Y2,Z2. Плоскость задается параметрами А, В, С, D в уравнении АХ+BY+CZ+D=0. Область допустимых значений: Z1¹Z2.

2. Обращение к подпрограмме:

PLOS(T1,Т2,Р,XYZ,FLAG);

3. Описание параметров:

Т1 – array[1..3] of real, Т1 – матрица координат первой точки (X1,Y1,Z1), через которую проходит прямая;

Т2 – array[1..3] of real, Т2 – матрица координат второй точки (Х2,Y2,Z2), через которую проходит прямая;

Р – array[1..4] of real, Р – матрица-столбец, элементы которой А, В, С, D (сверху вниз);

FLAG – integer, индикатор, FLAG=1, если пересечение единственно, FLAG=0, если решений нет или их бесконечное множество.

4. Тело подпрограммы:

procedure PLOS(Т1,Т2 : mr_3; Р : mr_4_l; var XYZ : mr_3;

var Flag : Int);

var

Znam : Re;

{Прим.: mr_3 – array[1..3] of real,

mr_4_l – array[1..4,1] of real,

Int - integer.}

begin

Znam:=P[l,l]*(T1[1]–T2[1])+P[2,l]*(T1[2]–T2[2])+P[3,1]*

(T1[3]–T2[3]);

if Znam=0 then

begin

Flag:=0; Exit;

end;

Flag:=1;

XYZ[3]:=T1[3]+(T1[3]–T2[3])*

(-P[1,1]*T1[1]–P[2,1]*T1[2]–P[3,1]*T1[3]-P[4,1])/Znam;

DIRECT(T1,T2,XYZ[3],XYZ);

end;{ - PLOS - }

Подпрограммы PRESSMR_SM_3, PRESSMR_4_1,PRESSMR_SM_2

Это служебные подпрограммы, используемые, в частности, подпрограммой OPTIMA. См. описание подпрограммы OPTIMA.

Подпрограмма SOME

1. Среди множества точек, лежащих на одной прямой, выбирает одну, которая является ближайшей к некоторой критериальной точке, также лежащей на той же прямой. Исходное множество точек записано в матрицу размером N*3, где N – целое число. Каждая строка этой матрицы – координаты X, Y, Z одной из точек. Из всех N точек может анализироваться лишь L первых точек (L<=N).

2. Обращение к подпрограмме:

SOME(AB,TF,MAB,JOP);

3. Описание параметров:

АВ – array[1..N,1..3] of real, размерность этой матрицы определяется описанием вызывающего модуля. АВ – это матрица N*3 координат N точек;

TF – array [1..3] of real, TF – матрица-строка координат X, Y, Z критериальной точки;

MAB – integer, число рабочих строк в матрице АВ, рабочие строки – это те L первых строк, среди которых имеется решение;

JOP – integer, номер строки в матрице АВ, который соответствует искомой точке.

4. Тело подпрограммы:

procedure SOME(AB : mr_SM_3;TF : mr_3; mab : Int; var Jop : Int);

var

plo,pla : Re;

i : Int;

begin

Jop:=1;

pla:=Abs(TF[3]–AB[1,3]);

for i:=2 to mab do

begin

plo:=Abs(TF[3]–AB[i,3]);

if plo<pla then

begin

pla:=plo;

Jop:=i;

end;

end;{ - SOME - }

Подпрограмма YESNO

1. Определяет факт принадлежности некоторой точки (X,Y,Z) поверхности или внутренней области выпуклого шестигранника, нормали к плоскостям-граням которого направлены внутрь тела.

2. Обращение к подпрограмме:

YESNO (A,PL,KRIT).

3. Описание параметров, пояснения:

А – array[1..3] of real. А – матрица координат X, Y, Z точки, проверяемой на принадлежность к шестиграннику;

PL – array [1..4,1..6] of real. PL – матрица, описывающая шестигранник:

Каждый столбец описывает соответствующие коэффициенты i-й (i=1(1)6) плоскости в ее уравнениях AiX+BiY+CiZ+D=0.

KRIT – integer, индикатор, KRIT=1, если точка принадлежит шестиграннику, KRIT=0 – если не принадлежит.

4. Ограничения и области допустимых значений: точка считается лежащей вне шестигранника, если значение функции ближайшей плоскости в этой точке менее 0,003. Значение подобрано экспериментально, оно отлично от нуля для компенсации неточности представления чисел в ЭВМ.

5. Тело подпрограммы:

procedure YESNO(А : mr_3; PL : mr_4_6; var Krit : Int);

var

В : Re;

i: Int;

{Прим.: mr_3 – array[1..3] of real,

mr_4_6 – array[1..4,1..6] of real,

Re – real,

Int – integer.}

begin

Krit:=l;

for i:=l to 6 do

begin

B:=PL[1,i]*A[1]+PL[2,i]*A[2]+PL[3,i]*A[3]+PL[4,i];

if В<-0.003 then

begin

Krit:=0;

Exit;

end;

end;{ YESNO - }

Подпрограмма YNZONA

1. Определяет факт принадлежности заданной точки внутренней области выпуклой двухмерной зоны, заданной координатами крайних точек.

2. Обращение к подпрограмме:

YNZONA(A,NOR_,N,X,Y,YN);

3. Описание параметров, пояснения:

А – array[1..2,1..NN] of real. Матрица крайних точек выпуклой двухмерной зоны. В каждой строке записаны два числа: соответственно координаты X,Y точки. В матрице до строки N включительно записаны координаты крайних точек, начиная со строки N+1 – машинное заполнение. N<=NN;

NOR_ – array[1..2,1..NN] of real. Матрица проекций направляющих векторов прямых, соединяющих 1 и 2, 2 и 3,...,N и N+1 точки. Первый столбец матрицы – проекция на ось ОХ, второй – на OY. N<=NN;

N – integer, число первых обрабатываемых строк матриц A,NOR_;

X – real, координата X анализируемой точки;

Y – real, координата Y анализируемой точки;

YN – integer, индикатор. YN=1, если анализируемая точка внутри зоны, YN=0 – если, вне зоны.

4. Ограничения и области допустимых значений:

Точка считается лежащей вне зоны, если значение функции (X–Xi)(Yi–Yi)– (Y–Yi)(Xi–Xi) ближайшей прямой, проходящей через i-ю и i+1-ю вершины, меньше 0,003. Значение подобрано экспериментально, оно отлично от нуля для компенсации неточности представления чисел в ЭВМ.

5. Тело подпрограммы:

procedure YNZONA(A,NOR_ : mr_SM_2; N : Int; X,Y : Re;

var YN : Int);

var

i: Int;

{Прим.: mr_SM_3 – array[1..2,1..3] of real,

Int – integer, Re – real.}

begin

YN:=1;

for i:=l to N do

if ((X–A[i,1])*NOR_[i,2]–(Y–A[i,2])*NOR_[i,1])<-0.003 then

begin

YN:=0;

Exit;

end;

end;{ - YNZONA - }