Найдите отдельное количество отрицательных и положительных элементов массива.

var
  D : array [1..15] of Integer;
begin
  /// Заполняем ///
  for var i := 1 to 15 do
    D[i] := Random(-20, 18);
  /// Выводим в столбик ///
  WriteLn('Массив D:');
  for var i := 1 to 15 do
    WriteLn(D[i]:4);
  /// Выводим в строку ///
  Write('Массив D:');
  for var i := 1 to 15 do
    Write(D[i]:4);
  WriteLn;
  /// Задание 1. Найдите отдельное количество отрицательных и положительных элементов массива. ///
  var P := 0;
  var O := 0;
  for var i := 1 to 15 do
    case sign(D[i]) of
    +1 : P += 1;
    -1 : O += 1;
    end;
  WriteLn('Отрицательных элементов массива ', O);
  WriteLn('Положительных элементов массива ', P);
  /// Задание 2. Найдите произведение элементов, имеющих значение меньше -2 (минус два). ///
  var P2 := 1;
  var k := 0;
  for var i := 1 to 15 do
    if D[i] < -2 then
      begin P2 *= D[i]; k += 1; end;
  if k = 0 then
    WriteLn('Нет элементов < 2')
  else
    WriteLn('Произведение элементов < 2 равно ', P2);
  /// Задание 3. Найдите максимальный элемент массива из элементов, стоящих на местах, номера которых кратны пяти. ///
  WriteLn('Максимальный из элементов, стоящих на местах, номера которых кратны 5 : ', max(D[5], max(D[10], D[15])));
  /// Задание 4. Замените отрицательные элементы, стоящие на нечётных местах на последний элемент массива. ///
  for var i := 1 to 15 do
    if odd(i) and (D[i] < 0) then
      D[i] := D[15];
  Write('Замена отрицательных на нечётных местах на последний:');
  for var i := 1 to 15 do
    Write(D[i]:4);
  WriteLn;
  /// Задание 5. Если в массиве имеются нулевые элементы, то найдите сумму элементов массива, имеющих значение, кратное трем, иначе выведите на экран положительные элементы массива. ///
  var c0 := 0;
  for var i := 1 to 15 do
    if D[i] = 0 then
      c0 += 1;
  if c0 > 0 then
    begin
      WriteLn('В массиве нулевых элементов есть!');
      var S := 0;
      for var i := 1 to 15 do
        if D[i] mod 3 = 0 then
          S += D[i];
      WriteLn('Сумма кратных трём равна ', S);
    end
  else
    begin
      WriteLn('В массиве нетуть нулевых элементов.');
      if P = 0 then
        WriteLn('Положительных тоже нет. Выяснили это уже в первом ответе.')
      else
        begin
          Write('Все положительные элементы:');
          for var i := 1 to 15 do
           if D[i] > 0 then
             Write(D[i]:4);
         WriteLn;
       end;
    end;
end.