var c:array[0..500,0..500]of longint;
    a:array[0..500,0..500]of longint;
    b:array[0..500,0..500]of longint;
    d:array[1..1000]of longint;
    i,j,num:longint;m,n:longint;
begin
     read(m,n);if (n=0)or(m=0) then begin writeln('0');halt;end;
     for i:=1 to m do
     for j:=1 to n do read(a[i,j]);
     fillchar(b,sizeof(b),0);
     fillchar(d,sizeof(d),0);
     for i:=2 to m do begin c[i,0]:=maxlongint;
                            c[i,n+1]:=maxlongint;end;
     for i:=1 to n do c[1,i]:=a[1,i];
     for i:= 2 to m do begin
         for j:=1 to n do
             if c[i,j-1]<=c[i-1,j] then begin b[i,j]:=1;
                                             c[i,j]:=a[i,j]+c[i,j-
1];end
                                  else begin b[i,j]:=2;
                                             c[i,j]:=a[i,j]+c[i-1,j];
end;
         for j:=n downto 1 do begin
             if (b[i,j]=2)and(c[i,j+1]<=c[i-1,j]) then begin
                                                        b[i,j]:=3;
                                                        c[i,j]:=a[i,j]
+c[i,j+1];
                                                        end;
             if (b[i,j]=1)and(c[i,j+1]<=c[i,j-1]) then begin
                                                        b[i,j]:=3;
                                                        c[i,j]:=a[i,j]
+c[i,j+1];
                                                        end;
             end;
         end;
     j:=maxlongint;
    for i:=1 to n do
        if c[m,i]<=j then begin j:=c[m,i];num:=i;end;
   j:=m;d[1]:=num;i:=1;
   while b[j,num]<>0 do begin
         case b[j,num] of
         1:dec(num);
         2:dec(j);
         3:inc(num);end;
         inc(I);d[i]:=num;
         end;
   for j:=i downto 1 do writeln(d[j]);
   readln;
end.

you should make the array smaller and change a and c into
extended!!!