Procedure plosh (x1,y1,z1,x2,y2,z2,x3,y3,z3:real; var S:real;);
var
a,b,c,p:real
begin
    a:=sqrt(sqr(y2-y3)+sqr(x2-x3)+sqr(z2-z3));
    b:=sqrt(sqr(y1-y3)+sqr(x1-x3)+sqr(z1-z3));    
    c:=sqrt(sqr(y1-y2)+sqr(x1-x2)+sqr(z1-z2));
         p:=(a+b+c)/2;
    S:=p*sqrt((p-a)*(p-b)*(p-c));
end;

a:=sqrt(sqr(y2-y3)+sqr(x2-x3)+sqr(z2-z3));

Var S: real;
               x: Array [1..5] of Real;
               y: Array [1..5] of Real;
               z: Array [1..5] of Real;
           i,n,m: Integer;

{процедура вычисления площади треугольника}
procedure plosh(x_1,y_1,z_1,x_2,y_2,z_2,x_3,y_3,z_3:real);
var
a,b,c,p,t:real;
begin
 a:=sqrt(sqr(y_2-y_3)+sqr(x_2-x_3)+sqr(z_2-z_3));
 b:=sqrt(sqr(y_1-y_3)+sqr(x_1-x_3)+sqr(z_1-z_3));
 c:=sqrt(sqr(y_1-y_2)+sqr(x_1-x_2)+sqr(z_1-z_2));
 p:=(a+b+c)/2;
 t:=p*sqrt((p-a)*(p-b)*(p-c));
end;

{заносим в массив координаты вершин}
for i:=1 to 5 do
begin
 if i:=1 or 5 then
  begin
   write('X',i,' -> '); readln(x[i]);
   write('Y',i,' -> '); readln(y[i]);
   write('Z',i,' -> '); readln(z[i]);
  end;
 else
  begin
   write('X',i,' -> '); readln(x[i]);
   write('Y',i,' -> '); readln(y[i]);
   z[i]:=z[1]
   writeln;
  end;
 end;
end;
{начинаем перебор всех вариантов сочетания вершин, создающих треугольник}
for i:=1 to 5 do
for n:=1 to 5 do
for m:=1 to 5 do
begin
 if ((i<>n) and ((n<>m) and (i<>m))) then
 begin
plosh(x[i],y[i],z[i],x[n],y[n],z[n],x[m],y[m],z[m]);
 end;
end;

Const
 { Это число точек в основании }
 basisPoints = 4;
 Epsilon = 0.0001;

Type
 { Описываем тип Точка - с тремя координатами }
 TAxis = (axisX, axisY, axisZ);
 TPoint =
   Record
     Case Boolean Of
       True : (x, y, z: Real);
       False: (arr: Array[TAxis] Of Real);
   End;

 { и тип Пирамида - с основанием (basis) и отдельной точкой (other)}
 TPyramide =
   Record
     basis: Array[1 .. basisPoints] Of TPoint;
     other: TPoint;
   End;


Var
 pyramide: TPyramide;


{ Площадь треугольника вычисляем по формуле Герона,
 но сам треугольник задаем не отдельными координатами,
 а вершинами }
Function Plosh(p1, p2, p3: TPoint): Real;
 Var
   a, b, c, p: Real;
 Begin
   a:=sqrt(sqr(p2.y-p3.y)+sqr(p2.x-p3.x)+sqr(p2.z-p3.z));
   b:=sqrt(sqr(p1.y-p3.y)+sqr(p1.x-p3.x)+sqr(p1.z-p3.z));
   c:=sqrt(sqr(p1.y-p2.y)+sqr(p1.x-p2.x)+sqr(p1.z-p2.z));
   p:=(a + b + c)/2;
   Plosh := Sqrt(p*(p-a)*(p-b)*(p-c))
 End;


Procedure SwapReal( Var a, b: Real );
 Var T: Real;
 Begin
   T := a; a := b; b := T;
 End;

Procedure SwapInt( Var a, b: Integer );
 Var T: Integer;
 Begin
   T := a; a := b; b := T;
 End;

{ Эта процедура распределяет номера вершинам основания }
Procedure CheckPolygon;

 Function isAxisEqual(axis: TAxis): Boolean;
   Var
     i: Integer;
     value: Real;
   Begin
     isAxisEqual := False;
     value := pyramide.basis[1].arr[axis];
     For i := 2 To basisPoints Do
       If Abs(pyramide.basis[i].arr[axis] - value) > Epsilon
         Then Exit;
     isAxisEqual := True;
   End;

 Var
   mainAxisX, mainAxisY: TAxis;

   angle: Array[1 .. basisPoints] Of Real;
   DynamicArr: Array[1 .. basisPoints] Of TPoint;
   indexes: Array[1 .. basisPoints] Of Integer;
   max, minX: Real; i, j, maxIndex, minIndex: Integer;
   changed: Boolean;

 Begin
   MainAxisX := axisX; MainAxisY := axisY;

   If isAxisEqual( axisY ) Then
     MainAxisY := AxisZ
   Else
     If isAxisEqual( axisX ) Then
       Begin
         MainAxisX := axisY; MainAxisY := axisZ;
       End;

   minX := maxInt;
   For i := 1 To basisPoints Do
     If minX > pyramide.basis[i].X Then
       Begin
         minX := pyramide.basis[i].X; minIndex := i
       End;

   indexes[1] := minIndex; j := 0;
   For i := 2 To basisPoints Do
     Begin
       Inc(j);
       If j = minIndex Then
         Inc(j);
       indexes[i] := j;
     End;

   For i := 1 To basisPoints Do
     If i <> minIndex Then
       Begin
         If (pyramide.basis[i].arr[mainAxisY] - pyramide.basis[minIndex].arr[MainAxisY]) = 0
           Then angle[i] := 0
           Else angle[i] :=
             ArcTan((pyramide.basis[i].arr[MainAxisX]-pyramide.basis[minIndex].arr[MainAxisX])/
                    (pyramide.basis[i].arr[MainAxisY]-pyramide.basis[minIndex].arr[MainAxisY]))*
                              (180 / Pi);
       End;

   For i := 2 To basisPoints Do
     Begin
       changed := False;
       max := angle[i];
       For j := i To basisPoints Do
         If max < angle[j] Then
           Begin
             max := angle[j];
             maxIndex := j;
             changed := True;
           End;
       If changed Then
         Begin
           SwapInt(indexes[maxIndex], indexes[i]);
           SwapReal(angle[maxIndex], angle[i])
         End;
     End;

   For i := 1 To basisPoints Do
     Move( pyramide.basis[ indexes[i] ], DynamicArr[i], SizeOf(TPoint) );
   Move( DynamicArr, pyramide.basis, basisPoints*SizeOf(TPoint) );
 End;



Var
 s: Real;
 i, j: Integer;

Begin
 { заносим в массив координаты вершин основания пирамиды }
 For i := 1 To basisPoints Do
   With pyramide.basis[i] Do
     Begin
       WriteLn( 'Вершина основания #', i );
       Write( 'X = ' ); ReadLn(X);
       Write( 'Y = ' ); ReadLn(Y);
       Write( 'Z = ' ); ReadLn(Z);
     End;

 WriteLn( 'Верхняя точка пирамиды:' );
 With pyramide.other Do
   Begin
     Write( 'X = ' ); ReadLn(X);
     Write( 'Y = ' ); ReadLn(Y);
     Write( 'Z = ' ); ReadLn(Z);
   End;

 { Устанавливает порядок прохождения вершин основания }
 CheckPolygon;

 s := 0;
 For i := 1 To basisPoints Do
   With pyramide Do
     Begin
       { считаем сумму площадей боковых граней }
       If i <> basisPoints Then j := Succ(i) Else j := 1;
       s := s + Plosh(basis[i], basis[j], other);

     End;

 { Этот способ нахождения площади основания - для тех оснований, которые являются выпуклыми многоугольниками из basisPoints вершин }
 For i := 2 To Pred(basisPoints) Do
   s := s + Plosh(pyramide.basis[1], pyramide.basis[i], pyramide.basis[Succ(i)]);

 WriteLn( 'Площадь пирамиды s = ', s:10:3 )

End.