最大流模版 pascal

//最大流模版
const maxn=; maxm=;
type list=record num:integer; a:array[..maxn] of integer; end;
var n,m,max:longint;
    r:array[..maxn,..maxn] of longint;
    g:array[..maxn,..maxn] of integer;
    d,cur:Array[..maxn] of integer;
    h:array[..maxn] of integer;//h表示高度
    L:array[..maxn*-] of list;
    e:array[..maxn] of longint;//e表示盈余
    Buf:Array[..] of char;

procedure Init;
var i,j,a,b,w:longint;
begin
  Assign(Input,'test.in');reset(Input);
  readln(m,n);
  fillchar(d,sizeof(d),);
  fillchar(e,sizeof(e),);
  fillchar(r,sizeof(r),);
  for i :=  to m do begin
    readln(a,b,w);
    Inc(r[a,b],w);//r表示a,b之间还能再流多少流量
  end;
  Close(Input);
  for i :=  to n do begin
    for j := i+ to n do begin
      if (r[i][j]>) or (r[j][i]>) then begin
        Inc(d[i]); Inc(d[j]);
        g[i,d[i]] := j;     g[j,d[j]] := i;
      end;
    end;
  end;
  for i :=  to n do cur[i] := ;
  for i :=  to *n- do L[i].num := ;
end;

procedure Insert(level,x:integer);
begin
  with L[level] do begin
    Inc(num);
    a[num] := x;
  end;
end;

procedure Bfs;
const limit=maxn*;
var p,q,i:integer;
    x:array[..maxn] of integer;
begin
  for i :=  to n do h[i] := limit;
  x[] := n; h[n] := ; q := ; p := ;
  repeat
    Inc(p);
    for i :=  to d[x[p]] do begin
      if h[g[x[p],i]]=limit then begin
        Inc(q); x[q] := g[x[p],i];
        h[x[q]] := h[x[p]] + ;
        if x[q]> then Insert(h[x[q]],x[q]);
      end;
    end;
  until p>=q;
  h[] := n;
end;

procedure Push(a,b:integer);
var x:longint;
begin
  if r[a,b]>e[a] then x := e[a] else x := r[a,b];
  Dec(r[a,b],x); Inc(r[b,a],x);
  Dec(e[a],x);     Inc(e[b],x);
end;

procedure Relabel(a:integer);
var i,min:integer;
begin
  min := maxint;
  for i :=  to d[a] do begin
    if (r[a,g[a,i]]>) and (h[g[a,i]]<min) then min := h[g[a,i]];
  end;
  h[a] := min+;
end;

function Check(a:integer):boolean;
begin
  Check := false;
  while e[a]> do begin
    if cur[a]>d[a] then begin
      Relabel(a);  Check := true; cur[a] := ;
    end else begin
      if (r[a,g[a,cur[a]]]>) and (h[a]=h[g[a,cur[a]]]+) then Push(a,g[a,cur[a]])
        else Inc(cur[a]);
    end;
  end;
end;

procedure Update(level:integer);
var j,k:integer;
begin
  for j := level+ to n do begin
    for k :=  to L[j].num do begin
      L[n+].a[L[n+].num+k] := L[j].a[k];
      h[L[j].a[k]] := n+;
    end;
    Inc(L[n+].num,L[j].num);
    L[j].num := ;
  end;
end;

procedure Flow;
var i,level:integer;
begin
  level := n;
  repeat
    Dec(level);
    with L[level] do begin
      for i := num downto  do begin
        if Check(a[i]) then begin
          if (level>) and (num=) then Update(level);
          Insert(h[a[i]],a[i]);
          level := h[a[i]];
          a[i] := a[num];  Dec(num);
          break;
        end;
      end;
    end;
  until level=;
end;

procedure PreFlow;
var i,b:integer;
begin
  for i :=  to d[] do begin
    b := g[,i];
    e[b] := r[,b]; Dec(e[],r[,b]);
    r[b,] := e[b];
    r[,b] := ;
  end;
end;

begin
  Init;
  Bfs;
  PreFlow;
  Flow;
  writeln(e[n]);
  readln;
end.