I've used an Hungarian algo I've found on the NET. I don't know
if it's correct because, for some tests it cycles to the infinite
because no modifications can be done. Please, could somebody give me
an algo that works?
Here's my source. Usually it works fine but, as I said, in some cases
it doesn't work.
program trash;
const nmax = 150;
var a, d : array [1..nmax, 1..nmax] of integer;

    s : array [1..nmax] of integer;
    nz : array [1..nmax] of byte;

    m, b : array [1..nmax, 1..nmax] of boolean;
    hasm, found : boolean;

    mlin, mcol : array [1..nmax] of boolean;

    ming1 : integer;
    sum : longint;

    N, i, j : byte;



procedure readdata;
begin
{  assign(input, 'trash.in'); reset(input);}
  fillchar(s, sizeof(s), 0);
  readln(N);
  for i:=1 to N do
  begin
    for j:=1 to N do
    begin
      read(d[i,j]);
      inc(s[i], d[i,j]);
    end;
    for j:=1 to N do
    begin
      a[i,j]:=s[i]-d[i,j];
      d[i,j]:=a[i,j];
    end;
    readln;
  end;
{  close(input);}
end;

procedure DoZero;
var i, j : byte;
    min : integer;
begin
  for i:=1 to N do
  begin
    min:=a[i,1];
    for j:=2 to N do
      if a[i,j]<min then
        min:=a[i,j];
    for j:=1 to N do
      dec(a[i,j], min);
  end;
  for j:=1 to N do
  begin
    min:=a[1,j];
    for i:=2 to N do
      if a[i,j]<min then
        min:=a[i,j];
    for i:=1 to N do
      dec(a[i,j],min);
  end;
end;

function DoMark:boolean;
var i, j, k, min, r : byte;
begin
  fillchar(nz, sizeof(nz), 0);
  fillchar(m, sizeof(m), 0);
  fillchar(b, sizeof(b), 0);
  for i:=1 to N do
    for j:=1 to N do
      if a[i,j]=0 then
        inc(nz[i]);
  for k:=1 to N do
  begin {choose a row with min 0's}
    min:=255;
    for i:=1 to N do
      if (nz[i]>0)and(nz[i]<min) then
      begin
        min:=nz[i];
        r:=i;
      end;
    if min=255 then
    begin
      DoMark:=false;
      exit;
    end;
    j:=1;
    nz[r]:=0;
    while (a[r,j]<>0)or(b[r,j]) do inc(j);
    m[r,j]:=true; {is marked}
    for i:=j+1 to N do
      if (a[r,i]=0) then
        b[r,i]:=true;
    for i:=1 to N do
      if (i<>r)and(a[i,j]=0) then
      begin
        b[i,j]:=true;
        dec(nz[i]);
      end;
  end;
  DoMark:=true;
end;

begin
  readdata;
  DoZero;


  while not DoMark do
  begin

    fillchar(mlin, sizeof(mlin), false);
    fillchar(mcol, sizeof(mcol), false);

    for i:=1 to N do
    begin
      hasm:=false;
      for j:=1 to N do
        if m[i,j] then
        begin
          hasm:=true;
          break;
        end;
      if not hasm then mlin[i]:=true;
    end;


    repeat
      found:=false;
      for i:=1 to N do
        if mlin[i] then
          for j:=1 to N do
            if (b[i,j])and(mcol[j]=false) then
            begin
              mcol[j]:=true;
              found:=true;
            end;

      if found then
        for j:=1 to N do
          if mcol[j] then
            for i:=1 to N do
              if (m[i,j])and(not mlin[i]) then
              begin
                mlin[i]:=true;
                found:=true;
              end;
    until not found;
    {i've made the marking}

    ming1:=maxint;
    for i:=1 to N do
      for j:=1 to N do
        if (mlin[i])and(not mcol[j])and(a[i,j]<ming1) then
          ming1:=a[i,j];

    for i:=1 to N do
      for j:=1 to N do
        if (mlin[i])and(not mcol[j]) then
          dec(a[i,j], ming1);

    for i:=1 to N do
      for j:=1 to N do
        if (not mlin[i])and(mcol[j]) then
          inc(a[i,j], ming1);
  end;

  sum:=0;
  for i:=1 to N do
    for j:=1 to N do
      if m[i,j] then
        inc(sum, d[i,j]);
  writeln(sum);
end.

no message