http://acm.pku.edu.cn/JudgeOnline/problem?id=1149

Код:
program PKU1149;
const maxn = 1000;
  maxm = 200100;
  maxv = 2000;
  Tlimit = 1000000;

type integer = longint;
     node = record
       tow, next: integer;
       c, f: integer;
     end;

var a: array[1..maxm] of node;
    x: array[1..maxn, 1..maxn] of boolean;
    g: array[1..maxv] of integer;
    s, t, n, m, tot: integer;

function min(i, j: integer): integer;
begin
  if i < j then min := i
  else min := j;
end;

procedure insert(u, v, t: integer);
begin
  with a[tot + 1] do begin
    tow := v; next := g[u];
    f := 0; c := t;
  end; g[u] := tot + 1;
  with a[tot + 2] do begin
    tow := u; next := g[v];
    f := t; c := t;
  end; g[v] := tot + 2;
  tot := tot + 2;
end;

var q, pre, e: array[1..maxv] of integer;

function maxflow: integer;
var sum, first, last, u, v, tmp: integer;
begin
  sum := 0;
  while true do begin
    fillchar(pre, sizeof(pre), 0);
    pre[s] := s; q[1] := s;
    first := 0; last := 1;
    while (first < last) and (pre[t] = 0) do begin
      first := first + 1; u := q[first];
      tmp := g[u];
      while tmp <> 0 do begin
        v := a[tmp].tow;
        if (a[tmp].c - a[tmp].f > 0) and (pre[v] = 0) then begin
          pre[v] := u; e[v] := tmp;
          inc(last); q[last] := v;
        end;
        tmp := a[tmp].next;
      end;
    end;
    if pre[t] = 0 then break;
    u := t; tmp := maxlongint;
    while pre[u] <> u do begin
      tmp := min(tmp, a[e[u]].c - a[e[u]].f);
      u := pre[u];
    end;
    u := t; sum := sum + tmp;
    while pre[u] <> u do begin
      inc(a[e[u]].f, tmp); dec(a[e[u] xor 1].f, tmp);
      u := pre[u];
    end;
  end;
  maxflow := sum;
end;

var cc: array[1..maxn] of integer;

procedure prepare;
var i, j, p, k: integer;
    boo: boolean;
begin
  read(m, n); tot := 1;
  s := n + m + 1; t := s + 1;
  fillchar(g, sizeof(g), 0);
  for i := 1 to m do begin
    read(k);
    insert(s, i, k);
  end;
  fillchar(x, sizeof(x), false);
  for i := 1 to m do x[i, i] := true;
  for i := 1 to n do begin
    read(k);
    for j := 1 to k do read(cc[j]);
    for j := 1 to m do begin
      boo := false;
      for p := 1 to k do if x[j, cc[p]] then begin boo := true; break; end;
      if boo then begin
        for p := 1 to k do x[j, cc[p]] := true;
        insert(j, i + m, Tlimit);
      end;
    end;
    read(k); insert(i + m, t, k);
  end;
end;

begin
  prepare;
  writeln(maxflow);
end.