program p1029;
const height = 100;
      width = 500;
var m,n,i,j,k,l,ind:integer;
    s,t,tr,tl:array[1..width] of longint;
    mn:longint;
    res:array[1..height,1..width] of 0..2;
    rl,rr:array[1..width] of 0..2;
    answer:array[1..height*width] of 0..2;

function min(a,b:longint):longint;
begin
  if (a < b) then min := a else min := b;
end;

begin
  readln(m,n);
  for i:=1 to n do begin read(s[i]); res[1][i] := 0; end;
  for i:=1 to height do for j:=1 to width do res[i][j] := 0;

  for i:=2 to m do
  begin
    for j:=1 to n do read(t[j]);
    tl[1] := s[1]+t[1]; rl[1] := 0;
    for j:=2 to n do
    begin
      if s[j] < tl[j-1] then begin tl[j] := s[j] + t[j]; rl[j] :=0;
end
                        else begin tl[j] := tl[j-1] + t[j]; rl[j] :=
1; end;
    end;
    tr[n] := s[n]+t[n]; rr[n] := 0;
    for j:=1 to n-1 do
    begin
      if s[n-j] < tr[n-j+1] then begin tr[n-j] := s[n-j] + t[n-j]; rr
[n-j] := 0; end
                            else begin tr[n-j] := tr[n-j+1] + t[n-j];
rr[n-j] := 2; end;
    end;
    for j:=1 to n do
    begin
      s[j] := min(tl[j],tr[j]);
      if (tl[j] < tr[j]) then res[i][j] := rl[j] else res[i][j] := rr
[j];
    end;
  end;

  mn := 2000000000;
  for j:=1 to n do
    if (s[j] < mn) then begin mn := s[j]; ind := j; end;

  i:=height; k:=1;
  while(i >= 1) do
  begin
    answer[k] := ind; Inc(k);
    if (res[i][ind] <> 0) then
       if (res[i][ind] = 2) then Inc(ind) else Dec(ind)
    else Dec(i);
  end;
  for i:=1 to k-1 do writeln(answer[k-i]);
end.

> program p1029;
> const height = 100;
>       width = 500;
> var m,n,i,j,k,l,ind:integer;
>     s,t,tr,tl:array[1..width] of longint;
>     mn:longint;
>     res:array[1..height,1..width] of 0..2;
>     rl,rr:array[1..width] of 0..2;
>     answer:array[1..height*width] of 0..2;
>
> function min(a,b:longint):longint;
> begin
>   if (a < b) then min := a else min := b;
> end;
>
> begin
>   readln(m,n);
>   for i:=1 to n do begin read(s[i]); res[1][i] := 0; end;
>   for i:=1 to height do for j:=1 to width do res[i][j] := 0;
>
>   for i:=2 to m do
>   begin
>     for j:=1 to n do read(t[j]);
>     tl[1] := s[1]+t[1]; rl[1] := 0;
>     for j:=2 to n do
>     begin
>       if s[j] < tl[j-1] then begin tl[j] := s[j] + t[j]; rl[j] :=0;
> end
>                         else begin tl[j] := tl[j-1] + t[j]; rl
[j] :=
> 1; end;
>     end;
>     tr[n] := s[n]+t[n]; rr[n] := 0;
>     for j:=1 to n-1 do
>     begin
>       if s[n-j] < tr[n-j+1] then begin tr[n-j] := s[n-j] + t[n-j];
rr
> [n-j] := 0; end
>                             else begin tr[n-j] := tr[n-j+1] + t[n-
j];
> rr[n-j] := 2; end;
>     end;
>     for j:=1 to n do
>     begin
>       s[j] := min(tl[j],tr[j]);
>       if (tl[j] < tr[j]) then res[i][j] := rl[j] else res[i][j] :=
rr
> [j];
>     end;
>   end;
>
>   mn := 2000000000;
>   for j:=1 to n do
>     if (s[j] < mn) then begin mn := s[j]; ind := j; end;
>
>   i:=height; k:=1;
>   while(i >= 1) do
>   begin
>     answer[k] := ind; Inc(k);
>     if (res[i][ind] <> 0) then
>        if (res[i][ind] = 2) then Inc(ind) else Dec(ind)
>     else Dec(i);
>   end;
>   for i:=1 to k-1 do writeln(answer[k-i]);
> end.
>
I think that your program is rigth. But you get WA. Look at this AC
program.(May be you'll find bug in your's )


type
  TBestPath = array [1..25000] of Word;

var
  i, j, n, m, x: LongInt;
  BestDirection: array [1..100, 1..500] of ShortInt;
  BestFloor:  array [1..500] of LongInt;
  CurrentFloor: array [1..500] of LongInt;
  PBestPath: ^TBestPath;

BEGIN
  FillChar(BestDirection, SizeOf(BestDirection), 0);
  FillChar(BestFloor, SizeOf(BestFloor), 0);
  Readln( m, n);

  for i:=1 to m do
    begin
      for j:=1 to n do
        begin
          Read( CurrentFloor[j]);
          Inc(BestFloor[j], CurrentFloor[j]);
          if (BestFloor[j]>1000000000) then
            BestFloor[j] := 1000000001;
        end;
      Readln;

      for j:=2 to n do
        if (BestFloor[j-1]+CurrentFloor[j] < BestFloor[j]) then
          begin
            BestFloor[j] := BestFloor[j-1] + CurrentFloor[j];
            BestDirection[i,j] := -1;
          end;

      for j:=n-1 downto 1 do
        if (BestFloor[j+1]+CurrentFloor[j] < BestFloor[j]) then
          begin
            BestFloor[j] := BestFloor[j+1] + CurrentFloor
[j];            BestDirection[i,j] := 1;
          end;
    end;

  j := 1;
  for i:=2 to n do
    if (BestFloor[i] < BestFloor[j]) then  j := i;
  i := m;
  x := 0;
  New(PBestPath);
  while (i>=1) do
    begin
      Inc(x);
      PBestPath^[x] := j;
      if (BestDirection[i, j] = 0) then
        Dec(i)
      else
        if (BestDirection[i, j] = -1) then
          Dec(j)
        else
          Inc(j);
    end;

  for i:=x downto 1 do
    Writeln(PBestPath^[i]);
  Dispose(PBestPath);
END.

P.S.
 Please, help me with problem 1132. My e-mail: nsc2001@ramble