This is my program :


{$R-,Q-,S-,B-}
Const
  maxm=100;
  maxn=500;
  lm=1000000001;
Var
  m,n:integer;
  a:array[1..maxm,1..maxn] of longint;

  (*---------------------*)
  c:array[1..maxm,1..maxn] of longint;
  p:array[1..maxm,1..maxn] of integer;


Procedure Input2;
Var i,j:integer;
Begin
  readln(m,n);
  for i:=1 to m do
  begin
    for j:=1 to n do read(a[i,j]);
    readln;
  end;
End;

Procedure Init;
Var i,j:integer;
Begin
  for i:=2 to m-1 do
  for j:=1 to n do c[i,j]:=lm;

  for i:=1 to n do c[1,i]:=a[1,i];
  fillchar(p,sizeof(p),0);
End;

Procedure Solve;
Var k,i,j:integer;
    s:longint;
Begin
  for k:=2 to m-1 do
  begin

    for i:=1 to n do
    if c[k,i]>c[k-1,i]+a[k,i] then
    begin
      c[k,i]:=c[k-1,i]+a[k,i];
      p[k,i]:=i;
    end;

    for i:=1 to n-1 do
    begin
      s:=a[k,i];
      for j:=i+1 to n do
      begin
        s:=s+a[k,j];
        if s>=lm then break;
        if s+c[k-1,j]<c[k,i] then begin c[k,i]:=s+c[k-1,j];p
[k,i]:=j;end;
        if s+c[k-1,i]<c[k,j] then begin c[k,j]:=s+c[k-1,i];p
[k,j]:=i;end;
      end;
    end;

  end;
End;

Procedure Display(x,y:integer);
Var i:integer;
Begin
  if x>1 then
  begin
    display(x-1,p[x,y]);
    if p[x,y]<=y then
    for i:=p[x,y] to y do writeln(i)
    else
    for i:=p[x,y] downto y do writeln(i);
  end
  else writeln(y);
End;

Procedure Output2;
Var i,k:integer;
    s:longint;
Begin
  s:=maxlongint;
  for i:=1 to n do
  if s>c[m-1,i]+a[m,i] then
  begin
    k:=i;
    s:=c[m-1,i]+a[m,i];
  end;

  p[m,k]:=k;
  display(m,k);
End;

Procedure Output3;
Var i,k:integer;
    s:longint;
Begin
  s:=maxlongint;
  for i:=1 to n do
  if s>a[1,i] then
  begin
    s:=a[1,i];
    k:=i;
  end;

  writeln(k);
End;

BEGIN
  input2;
  if m>1 then
  begin
    init;
    solve;
    output2;
  end else output3;
END.

Thank you very much.