40分求助

Var
    a,suml,sumr,sumu,f:array[0..2500,0..2500]of longint;
    n,m,i,j,ans:longint;

Function max(x,y:longint):longint;
begin
    if x>y then exit(x)
        else exit(y);
end;

Function min(x,y:longint):longint;
begin
    if x<y then exit(x)
        else exit(y);
end;

Begin
    readln(n,m);
    for i:=1 to n do
        begin
            for j:=1 to m do
                read(a[i,j]);
            readln;
        end;
    for i:=1 to n do
        begin
            for j:=1 to m do
                if a[i,j]=0 then
                    begin
                        suml[i,j]:=suml[i,j-1]+1;
                    end;
            for j:=m downto 1 do
                if a[i,j]=0 then
                    begin
                        sumu[i,j]:=sumu[i-1,j]+1;
                        sumr[i,j]:=sumr[i,j+1]+1;
                    end;
        end;
    fillchar(f,sizeof(f),127);
    f[0,0]:=0;
    ans:=-maxlongint;
    for i:=1 to n do
        for j:=1 to m do
            if a[i,j]=1 then
                begin
                    f[i,j]:=min(f[i-1,j-1],min(suml[i,j-1],sumu[i-1,j]))+1;
                    ans:=max(ans,f[i,j]);
                end;
    fillchar(f,sizeof(f),127);
    for i:=1 to n do
        for j:=m downto 1 do
            if a[i,j]=1 then
                begin
                    f[i,j]:=min(f[i-1,j+1],min(sumr[i,j+1],sumu[i-1,j]))+1;
                    ans:=max(ans,f[i,j]);
                end;
    if ans=-maxlongint then writeln(0) else writeln(ans);
End.