Если максимум и минимум матрицы чётные, то разделить их на два, иначе поменять местами первый и предпоследний столбец

var
  a: array[1..20,1..20] of integer;
  n,m,i,j,imin,jmin,imax,jmax,t: integer;
begin
  repeat
    write('Ââåäèòå ðàçìåðû ìàòðèöû n, m: ');
    readln(n,m);
  until (n in [1..20]) and (m in [1..20]);
  writeln('Ââåäèòå ýëåìåíòû ìàòðèöû:');
  for i:=1 to n do
    for j:=1 to m do
    begin
      write('a[',i,',',j,']=');
      readln(a[i,j]);
    end;
  writeln('Ìàòðèöà:');
  for i:=1 to n do
  begin
    for j:=1 to m do
      write(a[i,j]:4);
    writeln;
  end;
  imin:=1; jmin:=1; imax:=1; jmax:=1;
  for i:=1 to n do
    for j:=1 to m do
    begin // îïðåäåëÿåì ìèíèìóì
      if a[i,j]<a[imin,jmin] then begin
        imin:=i; jmin:=j;
      end; // îïðåäåëÿåì ìàêñèìóì
      if a[i,j]>a[imax,jmax] then begin
        imax:=i; jmax:=j;
      end;
    end;
  writeln('max = a[',imax,',',jmax,']=',a[imax,jmax]);
  writeln('min = a[',imin,',',jmin,']=',a[imin,jmin]);
  if odd(a[imin,jmin]+1) and odd(a[imax,jmax]) then
  begin // åñëè îíè ÷åòíûå òî...
    a[imin,jmin]:=2*a[imin,jmin];
    a[imax,jmax]:=2*a[imax,jmax];
  end else
  for i:=1 to n do
  begin // èíà÷å - ìåíÿåì ñòîëáöû
    t:=a[i,1];
    a[i,1]:=a[i,m-1];
    a[i,m-1]:=t;
  end;
  writeln('Ïðåîáðàçîâàííàÿ ìàòðèöà:');
  for i:=1 to n do
  begin
    for j:=1 to m do
      write(a[i,j]:4);
    writeln;
  end;
end.