Удалить из массива последнюю группу элементов

const
  nmax=100;
type
  arr=array[1..nmax] of integer;
var
  x:arr;
  n,i,mx,mn:integer;
  m_size,kfirst,klast:integer;
 
procedure CreateArray(var a:arr);
var
  i:integer;
begin
  repeat
    write('Размер масcива до ',nmax,' n: ');
    readln(n);
  until n in [1..nmax];
  writeln('Исходный массив:');
  for i:=1 to n do
    begin
      a[i]:=-10+random(30);
      write(a[i]:4);
    end;
  writeln;
end;
 
procedure FindSequence(a:arr; var kf,kl:integer);
{ (C) Puporev }
var
  i,j,k:integer;
begin
  i:=2;
  while i<=n do
    if a[i]*a[i-1]<0 then
      begin
        j:=i;k:=0;
        while (a[j]*a[j-1]<0)and(j<=n) do
          begin
            j:=j+1;
            k:=k+1;
          end;
        if k>0 then
        begin
          kl:=j-1;
          kf:=i-1;
        end;
        i:=i+k+1;
      end
    else
      i:=i+1;
end;
 
procedure FindMinMax(a:arr; m:integer; var max,min:integer);
var
  i:integer;
begin
  max:=a[1];
  min:=a[1];
  for i:=2 to m do
    begin
      if a[i]<min then
        min:=a[i];
      if a[i]>max then
        max:=a[i];
    end;
end;
 
procedure delelements(var a:arr; k1,k2:integer; var m:integer);
var
  k,j,i:integer;
begin
  m:=n;
  k:=k2-k1+1;
  for i:=1 to k do
    begin
      for j:=k1 to m-1 do
        a[j]:=a[j+1];
      m:=m-1;
    end;
end;
 
begin
  randomize;
  CreateArray(x);
  findminmax(x,n,mx,mn);
  writeln('Max = ',mx,', min = ',mn);
  findSequence(x,kfirst,klast);
  writeln('Последний знакочередующийся интервал с ',kfirst,' по ',klast);
  delelements(x,kfirst,klast,m_size);
  writeln('Удаление элементов с ',kfirst,' по ',klast);
  if m_size=0 then
    write('Все элементы удалены')
  else
    for i:=1 to m_size do
      write(x[i]:4);
  writeln;
  findminmax(x,m_size,mx,mn);
  writeln('Max = ',mx,', min = ',mn);
  readln;
end.