这题 居然一次就过了^_^

Program P2195;
const
   maxn=200;
   maxm=200;
   maxh=200;
   maxd=1000;
var
   n,m,i,j,k,ut,vt:longint;
   s:string;
   form:array[1..maxn,1..maxm] of longint;
   u,v:array[1..maxh,1..2] of longint;

   map,f,cost:array[0..maxd,0..maxd] of longint;
   b:array[0..maxd] of boolean;
   q:array[1..maxd*5] of longint;
   d,pre:array[0..maxd] of longint;
function max(a,b:longint):longint;
begin
   if a>b then exit(a) else exit(b);
end;
function min(a,b:longint):longint;
begin
   if a<b then exit(a) else exit(b);
end;
procedure spfa;
var
   i,j,h,t,now:longint;
begin
   fillchar(d,sizeof(d),127);
   fillchar(b,sizeof(b),false);
   fillchar(pre,sizeof(pre),0);
   d[0]:=0;
   b[0]:=true;
   h:=1;t:=1;
   q[1]:=0;
   while h<=t do
   begin
      now:=q[h];
      for i:=0 to 2*ut+1 do
         if (map[now,i]-f[now,i]>0) then
            if (d[now]+cost[now,i]<d[i]) then
            begin
               d[i]:=d[now]+cost[now,i];
               pre[i]:=now;
               if not(b[i]) then
               begin
                  b[i]:=true;
                  inc(t);
                  q[t]:=i;
               end;
            end;

      b[now]:=false;
      inc(h);
   end;

end;
function hllp:longint;
var
   i,j,k,flow,totalcost,nowcost:longint;
begin
   hllp:=0;
   totalcost:=0;
   while (true) do
   begin
      spfa;
      if d[ut*2+1]=2139062143 then exit(totalcost);
      flow:=maxlongint;
      i:=ut*2+1;
      repeat
         flow:=min(map[pre[i],i]-f[pre[i],i],flow);
         i:=pre[i];
      until i=0;
      i:=ut*2+1;
      nowcost:=0;
      repeat
         inc(f[pre[i],i],flow);
         f[i,pre[i]]:=-f[pre[i],i];
         inc(nowcost,cost[pre[i],i]);
         i:=pre[i];

      until i=0;
      inc(totalcost,nowcost*flow);

   end;
end;
function main:longint;
var
   i,j,k:longint;
begin
   main:=0;
   fillchar(map,sizeof(map),0);
   fillchar(f,sizeof(f),0);
   fillchar(cost,sizeof(cost),0);
   for i:=1 to ut do map[0,i]:=1;
   for i:=ut+1 to ut+vt do map[i,ut+vt+1]:=1;
   for i:=1 to ut do
      for j:=ut+1 to ut+vt do
      begin
         map[i,j]:=1;
         cost[i,j]:=abs(u[i,1]-v[j-ut,1])+abs(u[i,2]-v[j-ut,2]);
         cost[j,i]:=-cost[i,j];
      end;
   main:=hllp;
end;
begin
   while not eof do
   begin
      readln(n,m);
      if (n=0) and (m=0) then break;
      ut:=0;
      vt:=0;
      for i:=1 to n do
      begin
         readln(s);
         for j:=1 to m do
            if s[j]='m'  then
            begin
               inc(ut);
               u[ut,1]:=i;
               u[ut,2]:=j;
            end
            else if s[j]='H' then
            begin
               inc(vt);
               v[vt,1]:=i;
               v[vt,2]:=j;
            end;
      end;
      writeln(main);

   end;
end.

一开始居然忘添反向边……

Program P2516;
const
   maxn=100;
   maxm=100;
   maxk=100;
var
   n,m,k,i,j,l,maxflow:longint;
   need,prod:array[1..maxn,1..maxk] of longint;
   needk,prodk:array[1..maxk] of longint;
   fee:array[1..maxk,1..maxn,1..maxm] of longint;

   cost,map,f:array[0..200,0..200] of longint;

   b:array[0..200] of boolean;
   d,pre:array[0..200] of longint;
   q:array[1..500000] of longint;
function min(a,b:longint):longint;
begin
   if a<b then exit(a) else exit(b);
end;
function max(a,b:longint):longint;
begin
   if a>b then exit(a) else exit(b);
end;

procedure spfa;
var
   i,j,l,h,t,now:longint;
begin
   fillchar(d,sizeof(d),127);
   fillchar(b,sizeof(b),false);
   fillchar(pre,sizeof(pre),0);
   d[0]:=0;
   b[0]:=true;
   q[1]:=0;
   h:=1;t:=1;
   while h<=t do
   begin
      now:=q[h];
      for i:=0 to n+m+1 do
         if (map[now,i]-f[now,i]>0) then
            if (d[now]+cost[now,i]<d[i]) then
            begin
               d[i]:=d[now]+cost[now,i];
               pre[i]:=now;
               if not(b[i]) then
               begin
                  b[i]:=true;
                  inc(t);
                  q[t]:=i;
               end;
            end;


      b[now]:=false;
      inc(h);
   end;


end;
function hllp:longint;
var
   i,j,l,flow,totalflow,p:longint;
   totalcost,nowcost:longint;
begin
   hllp:=0;
   totalflow:=0;
   totalcost:=0;
   while (true) do
   begin
      spfa;
      if d[n+m+1]=2139062143 then exit(totalcost);
      flow:=maxlongint;
      i:=n+m+1;

      repeat
         flow:=min(flow,map[pre[i],i]-f[pre[i],i]);
         i:=pre[i];
      until i=0;

      nowcost:=0;
      i:=n+m+1;
      repeat
         inc(f[pre[i],i],flow);
         f[i,pre[i]]:=-f[pre[i],i];
         inc(nowcost,cost[pre[i],i]);
         i:=pre[i];
      until i=0;
      inc(totalcost,nowcost*flow);
   end;
end;
function main:longint;
var
   i,j,l,s,t:longint;
begin
   main:=0;
   for i:=1 to k do if prodk[i]<needk[i] then exit(-1);
   for i:=1 to k do
   begin
      fillchar(cost,sizeof(cost),0);
      fillchar(map,sizeof(map),0);
      fillchar(f,sizeof(f),0);
      s:=0;
      t:=n+m+1;
      for j:=1 to m do map[s,j]:=prod[j,i];
      for j:=1 to n do map[m+j,t]:=need[j,i];
      for j:=1 to m do
         for l:=1 to n do
         begin
            map[j,m+l]:=prod[j,i];
            cost[j,m+l]:=fee[i,l,j];
            cost[m+l,j]:=-cost[j,m+l];
         end;
      main:=main+hllp;

   end;

end;
begin
   while not seekeof do
   begin
      read(n,m,k);
      if (n=0) and (m=0) and (k=0) then break;

      fillchar(needk,sizeof(needk),0);
      fillchar(prodk,sizeof(prodk),0);

      for i:=1 to n do
         for j:=1 to k do
         begin
            read(need[i,j]);
            inc(needk[j],need[i,j]);
         end;
      for i:=1 to m do
         for j:=1 to k do
         begin
            read(prod[i,j]);
            inc(prodk[j],prod[i,j]);
         end;
      for i:=1 to k do
         for j:=1 to n do
            for l:=1 to m do
            begin
               read(fee[i,j,l]);
            end;
     writeln(main);



   end;
end.