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

function имя_функции(список_формальных_параметров ) :
			тип_результата;
	label
		список_меток;
	const
		список_констант;
	type
		список_типов;
	var
		список_переменных;
	begin
		//Тело функции.
	end;

function fun_1 ( x : real ) : real;
function fun_2 ( a, b : integer ) : real;

function fun_2 ( a, b : integer ) : real;
	begin
		fun_2 :=( a+b ) / 2;
	end;

y:=fun_1 ( 1. 2 8 );
z :=fun_1 (1.28)/2+ fun_2 ( 3, 8 );

//Функция, которая определяет простое число.
function prostoe (N: word ) : boolean;
	var i : word;
	begin
		prostoe := true;
		for i :=2 to N div 2 do
		if N mod i = 0 then
		begin
			prostoe := false;
			break;
		end;
	end;
//Функция, которая определяет совершенное число.
function soversh (N: word ) : boolean;
	var i : word; S : word;
	begin
		soversh := false;
		S : = 0;
		for i :=1 to N div 2 do
			if N mod i =0 then S:=S+i;
			if S=N then soversh := true;
	end;
var X: word; K, kol_p, kol_s, i : byte; Sum, Pro : real;
begin //Начало основной программы.
	//Ввод количества элементов в последовательности.
	write ( ’K= ’ ); readln (K);
	Sum: = 0; //Переменная для накапливания суммы.
	Pro : = 1; //Переменная для вычисления произведения.
	kol_p : = 0; //Счётчик простых чисел.
	kol_s : = 0; //Счётчик совершенных чисел.
	for i :=1 to K do
	begin
		//Ввод элемента последовательности.
		Writeln ( ’X= ’ ); readln (X);
		if prostoe (X) then //Если число простое,
		begin
			//выполнить операцию умножения,
			Pro:=Pro *X;
			//увеличить счётчик простых чисел.
			kol_p:=kol_p +1;
		end;
		if soversh (X) then //Если число совершенное,
		begin
			//выполнить операцию умножения,
			Sum:=Sum+X;
			//увеличить счётчик совершенных чисел.
			kol_s := kol_s +1;
		end;
	end;
	//Если были найдены совершенные числа,
	if kol_s<> 0 then
	begin
		Sum:=Sum/ kol_s; //вычислить среднее арифметическое.
		writeln ( ’Среднее арифметическое совершенных чисел  ’,
				Sum : 5 : 2 );
	end
	else //иначе вывести сообщение:
		writeln ( ’Совершенных чисел в последовательности нет. ’ );
	if kol_p<>0 then //Если были найдены простые числа,
	begin
		//вычислить среднее геометрическое.
		Pro:= exp (1/ kol_p _ ln ( Pro ) );
		writeln ( ’Среднее геометрическое простых чисел  ’, Pro : 5 : 2 );
	end
	else //иначе вывести сообщение:
		writeln ( ’Простых чисел в последовательности нет ’ );
end;

//Функция для вычисления количества цифр в числе M.
function cifra_ kol (M: longint ) : byte;
	begin
		cifra_ kol : = 1;
		while M div 10 > 0 do
		begin
			cifra_ kol := cifra_ kol +1;
			M:=M div 1 0;
		end;
	end;
//Функция возвращает значение "истина", если число M,
//состоящее из kol цифр, палиндром,
//и значение "ложь", в противном случае.
function palindrom (M: longint; kol : byte ) : boolean;
	var i : byte; j : longint;
begin
	j : = 1;
//Возведение числа 10 в степень kol-1 (разрядность числа).
	for i :=1 to kol -1 do
	j := j * 10;
	palindrom := true; //Пусть число - палиндром.
	for i :=1 to kol div 2 do
	begin
//Выделение старшего разряда M div j (первая цифра).
//Выделение младшего разряда M mod 10 (последняя цифра).
	//Если первая и последняя цифры не совпадают,
	if M div j <> M mod 10 then
	begin
		palindrom := false; //то, число не палиндром.
		break; //Досрочный выход из цикла.
	end;
	//Изменение числа
	M:=M -(M div j ) * j; //Удаление первой цифры числа.
	M:=M div 10; //Удаление последней цифры числа.
	j := j div 100; //Уменьшение разрядности.
	end;
end;
//Основная программа.
var X: longint; pr : boolean;
begin
	write ( ’X= ’ ); readln (X); //Ввод элемента последовательности.
	pr := false; //Пусть в последовательности нет палиндромов.
	while X<>0 do //Пока не ноль,
	begin
	if palindrom (X, cifra_ kol (X) ) then
	begin
		pr := true; //Найдено число палиндром,
		break; //досрочный выход из цикла.
		end;
		//Ввод следующего элемента последовательности.
		write ( ’X= ’ ); readln (X);
	end;
	if pr then writeln ( ’Последовательность ’,
		’содержит число-палиндром. ’ )
	else writeln ( ’Последовательность не содержит палиндромов. ’ );
end.