var
 s:array[1..200]of char;
 p,n,num,i,j,k,l:integer;
 word:array[1..6,1..200]of char;
 m:array[1..6]of integer;
 check:array[0..200]of integer;
 v:array[1..201,1..200]of integer;
 f:array[0..41,-1..200]of integer;
 ch:char;
function pp(x,y:integer):boolean;
var i:integer;
begin
 pp:=true;
 for i:=1 to m[x] do
   if word[x,i]<>s[y+i-1] then exit(false);
end;
begin
 readln(p,n);
 for i:=1 to p do begin
   for j:=1 to 19 do read(s[(i-1)*20+j]);
   readln(s[i*20]); end;
 l:=p*20;
 readln(num);
 for i:=1 to num do begin
   read(ch);
   while (ord(ch)<>13) and (ord(ch)<>32) do begin
     inc(m[i]);
     word[i,m[i]]:=ch;
     read(ch); end;
   readln;end;
 for i:=0 to l do check[i]:=maxint;
 for i:=1 to num do
   for j:=1 to l-m[i]+1 do
     if (pp(i,j)) and (s[j]=word[i,1]) and (m[i]<check[j]) then
       check[j]:=m[i];
 for i:=1 to l do
   if check[i]<>maxint then inc(v[1,l]);
 for i:=l-1 downto 1 do begin
   for j:=1 to num do
     if check[i+2-m[j]]=m[j] then
       if pp(j,i+2-m[j]) then
         dec(v[1,i]);
       inc(v[1,i],v[1,i+1]);end;
 for i:=2 to l do
   for j:=i to l do begin
     if check[i-1]<>maxint then dec(v[i,j]);
     inc(v[i,j],v[i-1,j]); end;
 for i:=1 to n do
   for j:=i+1 to l do
     for k:=j-1 downto i-1 do
       if f[i,j]<f[i-1,k]+v[k+1,j] then
         f[i,j]:=f[i-1,k]+v[k+1,j];
 writeln(f[n,l]);
end.