Разработка в среде Turbo Pascal программы формирования и обработки элементов одномерного массива

var s: array[1..4, 1..9] of integer;
    x: array[1..36] of integer;
    a, b, i, j, k, t, min: integer;
    sg: real;
    f: boolean;
begin
  {формирование матрицы s}
  randomize;
  for i := 1 to 4 do
    for j := 1 to 9 do
      s[i, j] := -10 + random(17);
  {печать матрицы s}
  writeln('Matrix S:');
  for i := 1 to 4 do
    begin
      for j := 1 to 9 do write(s[i, j]:4);
      writeln
    end;
  {копирование матрицы S в массив X}
  for i := 1 to 4 do
    for j := 1 to 9 do
      x[(i - 1) * 9 + j] := s[i, j];
  {печать массива x}
  writeln('Array X:');
  for i := 1 to 36 do write(x[i]:4);
  writeln;
  {вычисление среднего геометрического каждых третьих элементов последней четверти массива x}
  t := 1; {произведение элементов}
  k := 0; {количество элементов}
  for i := 28 to 36 do
    if (i - 28) mod 3 = 2 {на самом деле, будут приняты во внимание элементы 30, 33 и 36}
      then begin
        t := t * x[i];
        inc(k) {естественно, в конце концов будет k=3}
      end;
  {вычисление среднего геометрического по формуле sg = корень k-й степени из t}
  if t > 0
    then sg := exp(ln(t) / k)
    else if t < 0
      then sg := -exp(ln(-t) / k)
      else sg := 0;
  {печать среднего геометрического каждых третьих элементов последней четверти массива x}
  writeln('Average geometrical every third element of last quarter of array X = ', sg:0:7);
  {определение наименьшего из чётных по значению элементов массива x}
  min := 7; {любое, главное, больше 6, то есть, больше наибольшего}
  for i := 1 to 36 do
    if not odd(x[i]) and (x[i] < min)
      then min := x[i];
  {печать результата}
  if min = 7 {минимум среди чётных не найден?}
    then writeln('Even even elements aren''t found in array X') {чётных нет, минимум не найден}
    else writeln('Minimum even element of array X = ', min); {чётные есть, печать минимума}
  {упорядочение принадлежащих [a/2; b/2] элементов первой половины массива X по НЕУБЫВАНИЮ квадратов значений}
  {остальные элементы остаются на своих местах}
  write('a = '); {ввод a}
  readln(a);
  repeat {ввод b с проверкой}
    write('b >= a;  b = ');
    readln(b)
  until b >= a;
  a := a div 2;
  b := b div 2;
  f := false;
  {сортировка обменом по заданному условию}
  for i := 1 to 17 do
    if (x[i] >= a) and (x[i] <= b)
      then for j := i + 1 to 18 do
        if (x[j] >= a) and (x[j] <= b) and (sqr(x[j]) < sqr(x[i]))
          then begin
            f := true;
            t := x[i];
            x[i] := x[j];
            x[j] := t
          end;
  {печать результата сортировки}
  if f {обмены были?}
    then begin {обмены были, печатаем отсортированный массив}
      writeln('Elements of first half of array X of range [a/2, b/2] are sorted:');
      for i := 1 to 36 do write(x[i]:4);
      writeln
    end
    else writeln('In first half of array X there are no elements from range [a/2, b/2]'); {обменов не было, печатать массив нет смысла}
  {ожидание реакции пользователя перед закрытием программы}
  write('Press <Enter> to exit');
  readln
end.