http://acm.pku.edu.cn/JudgeOnline/problem?id=1156

Код:
program PKU1156;
{$I-,S-,Q-,R-}

const
  inf = '';
  ouf = '';
  maxn = 710;
  none = 1000000;

type integer = longint;

var h: array[0 .. maxn, 0 .. maxn] of integer;
    q, f: array[1 .. maxn, 1 .. 2] of integer;
    a, b: array[1 .. maxn] of integer;
    l, r: array[1 .. 2] of integer;
    buf: array[0..1 shl 19] of integer;
    n, m, limit: integer;

function min(i, j: integer): integer;
begin
  if i < j then min := i else min := j;
end;

procedure prepare;
var i, j: integer;
begin
  fillchar(h, sizeof(h), 0);
  assign(input, inf);
  settextbuf(input, buf);
  reset(input);
  read(m, n, limit);
  for i := 1 to n do for j := 1 to m do read(h[i, j]);
  close(input);
end;

var time: longint;

procedure main;
var i, j, k, tmp: integer;
    ans, nowans: integer;
begin
  ans := 1;
  for i := 1 to m do begin
    for k := 1 to n do begin
      a[k] := none;
      b[k] := -none;
    end;
    for j := i to min(i + 99, m) do begin
      for k := 1 to n do begin
        if h[k, j] < a[k] then a[k] := h[k, j];
        if h[k, j] > b[k] then b[k] := h[k, j];
      end;
      l[1] := 1; r[1] := 0;
      l[2] := 1; r[2] := 0;
      for k := 1 to n do if b[k] - a[k] <= limit then begin
        while (l[1] <= r[1]) and (b[k] - a[q[l[1], 1]] > limit) do l[1] := l[1] + 1;
        while (l[2] <= r[2]) and (b[q[l[2], 2]] - a[k] > limit) do l[2] := l[2] + 1;
        tmp := k;
        while (l[1] <= r[1]) and (a[q[r[1], 1]] >= a[k]) do begin
          tmp := f[r[1], 1];
          r[1] := r[1] - 1;
        end;
        r[1] := r[1] + 1;
        q[r[1], 1] := k;
        f[r[1], 1] := tmp;
        tmp := k;
        while (l[2] <= r[2]) and (b[q[r[2], 2]] <= b[k]) do begin
          tmp := f[r[2], 2];
          r[2] := r[2] - 1;
        end;
        r[2] := r[2] + 1;
        q[r[2], 2] := k;
        f[r[2], 2] := tmp;
        if f[l[1], 1] > f[l[2], 2] then tmp := f[l[1], 1] else tmp := f[l[2], 2];
        if (l[1] <= r[1]) and (l[2] <= r[2]) then begin
          nowans := (j - i + 1) * (k - tmp + 1);
          if nowans > ans then ans := nowans;
        end;
        if (j - i + 1) * (n - tmp + 1) <= ans then break;
      end else begin
        l[1] := 1; l[2] := 1;
        r[1] := 0; r[2] := 0;
        if (j - i + 1) * (n - k) <= ans then break;
      end;
    end;
  end;
  writeln(ans);
end;

begin
  prepare;
  main;
end.