In mathematics, a subsequence is a sequence that can be derived from another sequence by deleting some elements without changing the order of the remaining elements. For example, the sequence BDF is a subsequence of ABCDEF. A substring of a string is a continuous subsequence of the string. For example, BCD is a substring of ABCDEF.You are given two strings s1, s2 and another string called virus. Your task is to find the longest common subsequence of s1 and s2, such that it doesn't contain virus as a substring.

The input contains three strings in three separate lines: s1, s2 and virus (1 ≤ |s1|, |s2|, |virus| ≤ 100). Each string consists only of uppercase English letters.

Output the longest common subsequence of s1 and s2 without virus as a substring. If there are multiple answers, any of them will be accepted.  If there is no valid common subsequence, output 0.

//type AnsiString = string;
var dp: array[0..100, 0..100, 0..100] of AnsiString;
    s1, s2, virus: AnsiString;
    n, m, l, i, j, k, temp: longint;
    p: array[0..501] of longint;
    ans: AnsiString;

function GetEntry(a, b: AnsiString): longint;
var i, t: longint;
begin
 a:= b + '#' + a;
 p[1]:= 0;
 for i:= 2 to length(a) do
  begin
   t:= p[i-1];
   while (t > 0) and (a[i] <> a[t + 1]) do
    t:= p[t];

   if a[i] = a[t + 1] then
    inc(t);
   p[i]:= t;
  end;
 GetEntry:= p[length(a)];
end;

begin
 //assign(input,'input.txt'); reset(input);
 //assign(output,'output.txt'); rewrite(output);
 readln(s1);
 readln(s2);
 readln(virus);
 n:= length(s1);
 m:= length(s2);
 l:= length(virus);
 for i:= 1 to n do
  for j:= 1 to m do
   for k:= 0 to l-1 do
    begin
     if s1[i] = s2[j] then
      begin
       temp:= GetEntry(dp[i-1][j-1][k] + s1[i], virus);
       if (temp < l) and
          (length(dp[i][j][temp]) < length(dp[i-1][j-1][k]) + 1) then
        dp[i][j][temp]:= dp[i-1][j-1][k] + s1[i];
      end;

     if length(dp[i-1][j][k]) > length(dp[i][j][k]) then
      dp[i][j][k]:= dp[i-1][j][k];
     if length(dp[i][j-1][k]) > length(dp[i][j][k]) then
      dp[i][j][k]:= dp[i][j-1][k];
    end;

 ans:= dp[n][m][0];
 for k:= 1 to l-1 do
  if length(ans) < length(dp[n][m][k]) then
   ans:= dp[i][j][k];

 if length(ans) = 0 then
  write(0)
 else
  write(ans);
end.

uses math;
type dp = record
       x , y , z , num: longint;
       ok : boolean;
     end;

  var f : array[0 .. 110 , 0 .. 110 , 0 .. 110] of dp;
      go : array[0 .. 110 , 'A' .. 'Z'] of longint;
      p : array[0 .. 110] of longint;
      s1 , s2 , virus , ans : string;
      i , j , k , dv , d1 , d2 , ii , jj , cc , mx : longint;
      c : char;

procedure kmp;
  var i , j : longint;
begin

  p[0] := 0; p[1] := 0;
  for i := 2 to dv do begin
    j := p[i - 1];
    while (j > 0) and (virus[i] <> virus[j + 1]) do j := p[j];
    if virus[i] = virus[j + 1] then inc(j);
    p[i] := j;
  end;

end;

BEGIN

  readln(s1); readln(s2); readln(virus);
  d1 := length(s1); d2 := length(s2); dv := length(virus);
  kmp;
  fillchar(f , sizeof(f) , 0);
  for i := 0 to dv - 1 do
    for c := 'A' to 'Z' do begin
      if virus[i + 1] = c then go[i][c] := i + 1 else go[i][c] := go[p[i]][c];
    end;

  for i := 0 to d1 do
    for j := 0 to d2 do
      for k := 0 to dv - 1 do begin

        if (i <> d1) and (j <> d2) and (s1[i + 1] = s2[j + 1]) and
           (f[i + 1][j + 1][go[k , s1[i + 1]]].num < f[i][j][k].num + 1) then begin
          f[i + 1][j + 1][go[k , s1[i + 1]]].num := f[i][j][k].num + 1;
          f[i + 1][j + 1][go[k , s1[i + 1]]].x  := i;
          f[i + 1][j + 1][go[k , s1[i + 1]]].y  := j;
          f[i + 1][j + 1][go[k , s1[i + 1]]].z  := k;
          f[i + 1][j + 1][go[k , s1[i + 1]]].ok := true;
        end;

        if (i <> d1) and (f[i + 1][j][k].num < f[i][j][k].num) then begin
          f[i + 1][j][k].num := f[i][j][k].num;
          f[i + 1][j][k].x := i;
          f[i + 1][j][k].y := j;
          f[i + 1][j][k].z := k;
          f[i + 1][j][k].ok := false;
        end;

        if (j <> d2) and (f[i][j + 1][k].num < f[i][j][k].num) then begin
          f[i][j + 1][k].num := f[i][j][k].num;
          f[i][j + 1][k].x := i;
          f[i][j + 1][k].y := j;
          f[i][j + 1][k].z := k;
          f[i][j + 1][k].ok := false;
        end;

      end;

  i := d1; j := d2;
  mx := 0; k := -1;
  for cc := 0 to dv - 1 do
    if mx < f[i][j][cc].num then begin
      mx := f[i][j][cc].num;
      k := cc;
    end;

  if mx = 0 then begin writeln(0); halt; end;

  ans := '';
  while (i <> 0) and (j <> 0) do begin
    if f[i][j][k].ok then ans := s1[i] + ans;
    ii := i; jj := j; cc := k;
    i := f[ii][jj][cc].x;
    j := f[ii][jj][cc].y;
    k := f[ii][jj][cc].z;
  end;

  writeln(ans);

END.

{$R-,S-,Q-,I-,O+}
{$M 32000000}

{$APPTYPE CONSOLE}

uses Math;
const
    inf = round(1e9);
    maxn = round(1e5) + 200;
    md = round(1e9) + 7;
type
    state = record
             i, j, k : longint;
            end;
var
    s1, s2, virus, res : string;
    n, m, v, i, j, k, ans : longint;
    ch : char;
    f : array [0..111, 'A'..'Z'] of longint;
    p : array [1..111] of longint;
    dp : array [0..111, 0..111, 0..111] of longint;
    pred : array [0..111, 0..111, 0..111] of state;
    cur, now :  state;
begin
 // reset (input, 'input.txt');
 // rewrite (output, 'output.txt');
  randomize;
  readln(s1); n := length(s1);
  readln(s2); m := length(s2);
  readln(virus); v := length(virus);
  p[1] := 0;
  k := 0;
  for i := 2 to v do
  begin
    while (k > 0) and (virus[i] <> virus[k + 1]) do k := p[k];
    if virus[i] = virus[k + 1] then inc(k);
    p[i] := k;
  end;
  for ch := 'A' to 'Z' do
  if ch <> virus[1] then f[0][ch] := 0
                    else f[0][ch] := 1;
  for i := 1 to v - 1 do
    for ch := 'A' to 'Z' do
    if virus[i + 1] = ch then f[i][ch] := i + 1
                         else f[i][ch] := f[p[i]][ch];

  fillchar(dp, sizeof(dp), -1);
  fillchar(pred, sizeof(pred), 0);
  dp[0][0][0] := 0;
  for i := 0 to n do
    for j := 0 to m do
      for k := 0 to v - 1 do
      if dp[i][j][k] <> -1 then
      begin
        if (i < n) and (j < m) and (s1[i + 1] = s2[j + 1]) then
          if dp[i + 1][j + 1][f[k][s1[i + 1]]] < dp[i][j][k] + 1 then
          begin
            dp[i + 1][j + 1][f[k][s1[i + 1]]] := dp[i][j][k] + 1;
            pred[i + 1][j + 1][f[k][s1[i + 1]]].i := i;
            pred[i + 1][j + 1][f[k][s1[i + 1]]].j := j;
            pred[i + 1][j + 1][f[k][s1[i + 1]]].k := k;
          end;
        if (i < n) then
          if dp[i + 1][j][k] < dp[i][j][k] then
          begin
            dp[i + 1][j][k] := dp[i][j][k];
            pred[i + 1][j][k].i := i;
            pred[i + 1][j][k].j := j;
            pred[i + 1][j][k].k := k;
          end;
        if (j < m) then
          if dp[i][j + 1][k] < dp[i][j][k] then
          begin
            dp[i][j + 1][k] := dp[i][j][k];
            pred[i][j + 1][k].i := i;
            pred[i][j + 1][k].j := j;
            pred[i][j + 1][k].k := k;
          end;
      end;

  fillchar(cur, sizeof(cur), -1);
  ans := 0;
  for k := 0 to v - 1 do
  if ans < dp[n][m][k] then
  begin
    ans := dp[n][m][k];
    cur.i := n;
    cur.j := m;
    cur.k := k;
  end;

  if ans = 0 then
  begin
    writeln(0);
    halt;
  end;

  res := '';
  v := ans;
  while v > 0 do
  begin
    now := pred[cur.i][cur.j][cur.k];
    if (now.i + 1 = cur.i) and (now.j + 1 = cur.j) then
    begin
      res := res + s1[cur.i];
      dec(v);
    end;
    cur := now;
  end;

  for i := ans downto 1 do write(res[i]);
end.

program mfs;
type data=record
	i,j,k,f:longint;
	end;
var
s1,s2,vir:string[115];
len1,len2,len,i,j,k,ans,ansi,ansj,ansk,kk:longint;
next:array[0..115]of longint;
dp,up:array[0..110,0..110,0..110]of longint;
g:array[0..102,0..102,0..102]of data;
procedure getnext;
var i,j:longint;
begin
j:=0;
for i:=2 to len do
	begin
	while (vir[i]<>vir[j+1])and(j>0) do j:=next[j];
	if vir[i]=vir[j+1] then j:=j+1;
	next[i]:=j;
	end;
end;
procedure printf(i,j,k:longint);
var ii,jj,kk:longint;
begin
if g[i][j][k].i=0 then begin if g[i][j][k].f=1 then write(s1[i]); exit; end;
ii:=g[i][j][k].i;jj:=g[i][j][k].j;kk:=g[i][j][k].k;
//writeln(ii,' ',jj,' ',kk);
printf(ii,jj,kk);
if g[i][j][k].f=1 then write(s1[i]);
end;
begin
readln(s1);
readln(s2);
readln(vir);
len1:=length(s1);len2:=length(s2);
len:=length(vir);
fillchar(dp,sizeof(dp),$ff);
for i:=0 to len1 do
	for j:=0 to len2 do dp[i][j][0]:=0;
getnext;
fillchar(up,sizeof(up),0);
for i:=1 to len1 do
	for j:=1 to len2 do
	begin
	if s1[i]<>s2[j] then
		for k:=0 to len do
		if dp[i-1][j][k]>dp[i][j-1][k] then
			begin
			dp[i][j][k]:=dp[i-1][j][k];
			up[i][j][k]:=up[i-1][j][k];
			g[i][j][k].i:=i-1;g[i][j][k].j:=j;g[i][j][k].k:=k;
			g[i][j][k].f:=0;
			//writeln(dp[i][j][k],' ',i,' ',j,' ',k,' ',dp[i-1][j][k],' ',dp[i][j-1][k],' ',g[i][j][k].i,' ',g[i][j][k].j,' ',g[i][j][k].k);
			end
		else begin
			dp[i][j][k]:=dp[i][j-1][k];
			up[i][j][k]:=up[i][j-1][k];
			g[i][j][k].i:=i;g[i][j][k].j:=j-1;g[i][j][k].k:=k;
			g[i][j][k].f:=0;
			end;
	if s1[i]=s2[j] then
		begin
		for k:=0 to len-1 do
			begin
			dp[i][j][k]:=dp[i-1][j-1][k];
			g[i][j][k].i:=i-1;g[i][j][k].j:=j-1;g[i][j][k].k:=k;
			end;
		//writeln(i,' ',j,' ',s1[i],' ',s2[j]);
		for k:=0 to len-1 do
			begin
			kk:=k;
			while (vir[kk+1]<>s1[i])and(kk>0) do kk:=next[kk];
			if vir[kk+1]=s1[i] then inc(kk);
			if (dp[i-1][j-1][k]>=0)and(dp[i][j][kk]<dp[i-1][j-1][k]+1) then
				begin
				dp[i][j][kk]:=dp[i-1][j-1][k]+1;
				g[i][j][kk].i:=i-1;g[i][j][kk].j:=j-1;g[i][j][kk].k:=k;g[i][j][kk].f:=1;
				end;
				//writeln('--->',i,' ',j,' ',k,' ',kk,' ',dp[i][j][kk],' ',up[i][j][k]);
			end;
		end;
	end;
ans:=0;
for i:=1 to len1 do
	for j:=1 to len2 do
		for k:=0 to len-1 do
		begin
		//writeln(i,' ',j,' ',k,' ',dp[i][j][k],' ',ans);
		if dp[i][j][k]>ans then
		begin
		ans:=dp[i][j][k];
		ansi:=i;
		ansj:=j;
		ansk:=k;
		end;
		end;
if ans=0 then begin writeln(0); halt; end;
//writeln('###',ans,' ',dp[ansi][ansj][ansk],' ',ansi,' ',ansj,' ',ansk);
printf(ansi,ansj,ansk);
end.
{
ABBBDASSDASDASDDAASDASDADASDASASDAS
SDADASDASSDAASDASDASDADASSDDA
SD
}

{$MODE OBJFPC}
uses
   math;
const
   fi = '346BDIV1.INP';
   fo = '346BDIV1.OUT';
   maxn = 101;
var
   f, tracex, tracey, tracez : array[0..maxn,0..maxn,0..maxn] of Integer;
   ok : array[0..maxn,0..maxn,0..maxn] of Boolean;
   d : array[0..maxn,'A'..'Z'] of Integer;
   a, b, virus, sub : String;
   n, m, res: Integer;
   t : array[0..maxn] of Integer;

procedure enter;
begin
   //assign(input,fi); reset(input);
   readln(a); readln(b); readln(virus);
end;

procedure init;
var
   i, j : Integer;
   ch : Char;
begin
   fillchar(ok,sizeof(ok),false);
   j := 0;
   for i := 2 to length(virus) do
      begin
         while (virus[i] <> virus[j+1]) and (j > 0) do j := t[j];
         if (virus[i] = virus[j+1]) then inc(j);
         t[i] := j;
      end;
   for ch := 'A' to 'Z' do
      for i := 0 to length(virus) - 1 do
         begin
            j := i;
            while (virus[j+1] <> ch) and (j > 0) do j := t[j];
            if virus[j+1] = ch then inc(j);
            d[i,ch] := j;
         end;
end;

procedure solve;
var
   i, j, k, x0, y0, z0, z, p : Integer;
begin
   n := length(a); m := length(b);
   fillchar(f,sizeof(f),255);
   for i := 0 to n do
      for j := 0 to m do
         f[i,j,0] := 0;
   for i := 1 to n do
      for j := 1 to m do
         for k := 0 to length(virus) - 1 do
            begin
               if (a[i] = b[j]) and (f[i-1,j-1,k] <> -1) then z := d[k, a[i]] else z := -1;
               f[i,j,k] := max(f[i,j,k], max(f[i-1,j,k], f[i,j-1,k]));
               if f[i,j,k] = f[i,j-1,k] then
                  begin
                     tracex[i,j,k] := i; tracey[i,j,k] := j-1; tracez[i,j,k] := k;
                     ok[i,j,k] := false;
                  end
                     else
               if f[i,j,k] = f[i-1,j,k] then
                  begin
                     tracex[i,j,k] := i-1; tracey[i,j,k] := j; tracez[i,j,k] := k;
                     ok[i,j,k] := false;
                  end;
               if (z <> -1) and (z < length(virus)) then
                  begin
                     f[i,j,z] := max(f[i,j,z], f[i-1,j-1,k] + 1);
                     if f[i,j,z] = f[i-1,j-1,k] + 1 then
                        begin
                           tracex[i,j,z]:= i-1; tracey[i,j,z] := j-1; tracez[i,j,z] := k;
                           ok[i,j,z] := true;
                        end;
                  end;
            end;

   for i := 0 to length(virus) - 1 do
      begin
         res := max(res, f[n,m,i]);
         if res = f[n,m,i] then
            begin
               k := i;
            end;
      end;

   if res = 0 then
      begin
         writeln(0);
         halt;
      end;
   while (n > 0) and (m > 0) do
      begin
        if ok[n,m,k] then sub := a[n] + sub;
        x0 := tracex[n,m,k]; y0 := tracey[n,m,k]; z0 := tracez[n,m,k];
        n := x0; m := y0; k := z0;
      end;
   writeln(sub);
end;

begin
   enter;
   init;
   solve;
end.

var
p:array[0..1000] of longint;
x,y,d,f:array[0..1000,0..1000] of longint;
qqq,n1,m1,cc,t,n,m,i,j:longint;
temp2,temp,max,ans,a,b,c:ansistring;
{procedure dfs(x,y:longint);
begin
if f[x,y]=0 then exit;
if f[x,y]=f[x-1,y-1]+1 then begin ans:=ans+b[x];
dfs(x-1,y-1);
end ELSE
if f[x,y]=f[x-1,y] then dfs(x-1,y) else dfs(x,y-1);
end; }
begin
readln(a);
temp2:=a;
readln(b);
readln(c);
max:='';
for qqq:=1 to length(a) do begin
a:=temp2;
delete(a,qqq,1);
fillchar(f,sizeof(f),0);
fillchar(d,sizeof(d),0);
j:=0;
p[1]:=0;
n:=length(a);
m:=length(b);
cc:=length(c);
for i:=2 to cc do
begin
while (j>0) and (c[j+1]<>c[i]) do j:=p[j];
if c[j+1]=c[i] then inc(j);
p[i]:=j;
end;
for i:=1 to n do
for j:=1 to m do
begin
if (d[i-1,j]<=d[i,j-1]) and (f[i-1,j]=f[i,j-1]) or (f[i-1,j]>f[i,j-1]) then begin
f[i,j]:=f[i-1,j];
d[i,j]:=d[i-1,j];
x[i,j]:=i-1;
y[i,j]:=j;
end
else
begin
f[i,j]:=f[i,j-1];
d[i,j]:=d[i,j-1];
x[i,j]:=i;
y[i,j]:=j-1;
end;
t:=d[i-1,j-1];
if a[i]=b[j] then begin
while (t>0) and (c[t+1]<>a[i]) do t:=p[t];
if c[t+1]=a[i] then inc(t);
if t<>cc then
if (f[i-1,j-1]+1=f[i,j]) and (t<=d[i,j]) or (f[i-1,j-1]+1>f[i,j]) then begin
f[i,j]:=f[i-1,j-1]+1;
d[i,j]:=t;
x[i,j]:=i-1;
y[i,j]:=j-1;
end;
end;
end;
if f[n,m]<>0 then  begin
ans:='';
while (n<>0) and (m<>0) do begin
if x[n,m]+y[n,m]-n-m+2=0 then ans:=a[n]+ans;
n1:=n;
m1:=m;
n:=x[n1,m1];
m:=y[n1,m1];
end;
if length(max)<length(ans) then max:=ans;
end;
end;
a:=temp2;
for qqq:=1 to length(a) do begin
fillchar(f,sizeof(f),0);
fillchar(d,sizeof(d),0);
j:=0;
p[1]:=0;
n:=length(a);
m:=length(b);
cc:=length(c);
for i:=2 to cc do
begin
while (j>0) and (c[j+1]<>c[i]) do j:=p[j];
if c[j+1]=c[i] then inc(j);
p[i]:=j;
end;
for i:=1 to n do
for j:=1 to m do
begin
if (d[i-1,j]<=d[i,j-1]) and (f[i-1,j]=f[i,j-1]) or (f[i-1,j]>f[i,j-1]) then begin
f[i,j]:=f[i-1,j];
d[i,j]:=d[i-1,j];
x[i,j]:=i-1;
y[i,j]:=j;
end
else
begin
f[i,j]:=f[i,j-1];
d[i,j]:=d[i,j-1];
x[i,j]:=i;
y[i,j]:=j-1;
end;
t:=d[i-1,j-1];
if a[i]=b[j] then begin
while (t>0) and (c[t+1]<>a[i]) do t:=p[t];
if c[t+1]=a[i] then inc(t);
if t<>cc then
if (f[i-1,j-1]+1=f[i,j]) and (t<=d[i,j]) or (f[i-1,j-1]+1>f[i,j]) then begin
f[i,j]:=f[i-1,j-1]+1;
d[i,j]:=t;
x[i,j]:=i-1;
y[i,j]:=j-1;
end;
end;
end;
if f[n,m]<>0 then  begin
ans:='';
while (n<>0) and (m<>0) do begin
if x[n,m]+y[n,m]-n-m+2=0 then ans:=a[n]+ans;
n1:=n;
m1:=m;
n:=x[n1,m1];
m:=y[n1,m1];
end;
if length(max)<length(ans) then max:=ans;
end;
temp:=a;
a:='';
for i:=2 to length(temp) do A:=a+temp[i];
end;
if max<>'' then writeln(max) else writeln(0);
end.

{$coperators on}
{$R-,Q-}

uses            math;

type            int     = longint;
                ll      = int64;
                bool    = boolean;

const           fi      = '';
                fo      = '';
                nmax    = 110;
                base    = 73471;

var             a , b   : string;
                virtus  : string;
                f       : array[0..nmax,0..nmax,0..nmax] of int;
                g       : array[0..nmax,'A'..'Z'] of int;
                mul , h : array[0..nmax] of qword;
                n , m , l       : int;

procedure       enter;
  begin
                readln(a);
                readln(b);
                readln(virtus);
                n := length(a);
                m := length(b);
                l := length(virtus);
  end;

procedure       init;
  var
                i , j   : int;
                c       : char;
  begin
                mul[0] := 1;
                for i := 1 to n do
                   begin
                      h[i] := h[i-1]*base+ord(virtus[i])-ord('A');
                      mul[i] := mul[i-1]*base;
                   end;

                for i := 0 to n do
                   begin
                      for c := 'A' to 'Z' do
                         begin
                            if c = virtus[i+1] then
                               begin
                                  g[i,c] := i+1;
                                  continue;
                               end;
                            for j := i downto 1 do
                               if h[j] = (h[i]-h[i-j+1]*mul[j-1])*base+ord(c)-ord('A') then
                                  begin
                                     g[i,c] := j;
                                     break;
                                  end;
                         end;
                   end;
  end;

function        cal(i , j , k : int) : int;
  begin
                if (i > n) or (j > m) then exit(0);

                if f[i,j,k] <> -1 then exit(f[i,j,k]);

                f[i,j,k] := max(cal(i+1,j,k) , cal(i,j+1,k));
                if (a[i] = b[j]) and (g[k,a[i]] <> l) then f[i,j,k] := max(f[i,j,k] , cal(i+1,j+1,g[k,a[i]])+1 );

                exit(f[i,j,k]);
  end;

procedure       trace(i , j , k : int);
  begin
                if (i > n) or (j > m) then exit;

                if (cal(i,j,k) = cal(i+1,j,k)) then
                   begin
                      trace(i+1,j,k); exit;
                   end;
                if (cal(i,j,k) = cal(i,j+1,k)) then
                   begin
                      trace(i,j+1,k); exit;
                   end;
                if cal(i,j,k) = cal(i+1,j+1,g[k,a[i]])+1 then
                   begin
                      write(a[i]);
                      trace(i+1,j+1,g[k,a[i]]);
                   end;
  end;

procedure       solve;
  var
                i       : int;
                tmp     : int;
                pos     : int;
  begin
                fillchar(f, sizeof(f) , 255);

                tmp := 0;
                for i := 0 to l do
                   if tmp < cal(1,1,i) then
                      begin
                         tmp := cal(1,1,i);
                         pos := i;
                      end;
                if tmp = 0 then
                   begin
                      writeln(0);
                      exit;
                   end;

                trace(1,1,pos);
  end;

begin
                assign(input,fi);
                reset(input);
                assign(output,fo);
                rewrite(output);

                enter;
                init;
                solve;

                close(input);
                close(output);
end.

const inf=10000;
var kmp:array[0..110]of longint;
    pre,dp:array[0..101,0..101,0..101]of longint;
    i,j,l1,l2,lv,k,t,ans:longint;
    s,s1,s2,virus:string;

begin
  readln(s1);l1:=length(s1);
  readln(s2);l2:=length(s2);
  readln(virus);lv:=length(virus);
  kmp[1]:=0;k:=0;
  for i:=2 to lv do
    begin
      while(k<>0)and(virus[k+1]<>virus[i])do k:=kmp[k];
      if(virus[k+1]=virus[i])then inc(k);
      kmp[i]:=k;
    end;
  for i:=0 to l1 do
    for j:=0 to l2 do
      for k:=0 to lv do
        dp[i,j,k]:=-inf;
  dp[0,0,0]:=0;
  for i:=0 to l1 do
    for j:=0 to l2 do
      for k:=0 to lv-1 do
        begin
          if(i<l1)then
            if(dp[i,j,k]>dp[i+1,j,k])then
              begin
                dp[i+1,j,k]:=dp[i,j,k];
                pre[i+1,j,k]:=1;
              end;
          if j<l2 then
            if(dp[i,j,k]>dp[i,j+1,k])then
              begin
                dp[i,j+1,k]:=dp[i,j,k];
                pre[i,j+1,k]:=2;
              end;
          if(i<l1)and(j<l2)and(s1[i+1]=s2[j+1])then
            begin
              t:=k;
              while(t<>0)and(virus[t+1]<>s1[i+1])do t:=kmp[t];
              if virus[t+1]=s1[i+1] then inc(t);
              if dp[i+1,j+1,t]<dp[i,j,k]+1 then
                begin
                  dp[i+1,j+1,t]:=dp[i,j,k]+1;
                  pre[i+1,j+1,t]:=k+3;
                end;
            end;
        end;
  ans:=0;
  for i:=0 to lv-1 do
    if(dp[l1,l2,i]>ans)then begin ans:=dp[l1,l2,i];k:=i;end;
  if ans=0 then
    writeln(0)
  else
    begin
      i:=l1;j:=l2;s:='';
      while(i<>0)and(j<>0)do
        begin
          case pre[i,j,k] of
            1:dec(i);
            2:dec(j);
            else
              begin
                k:=pre[i,j,k]-3;
                s:=s1[i]+s;
                dec(i);dec(j);
              end;
          end;
        end;
      writeln(s);
    end;
end.

{$mode objfpc}
uses math;
var
  i,j,k,na,nb,np,t: integer;
  r: integer;
  ch: char;
  a,b,p,rs: string;
  f,tr: array[0..101,0..101,0..101] of integer;
  g: array[0..101,'A'..'Z'] of integer;
  c: array[0..101] of integer;

procedure kmp;
var
  q,t,i: integer;
begin
  for ch:='A' to 'Z' do if ch=p[1] then g[0,ch]:=1 else g[0,ch]:=0;
  q:=0;
  np:=length(p);
  c[1]:=0;
  for i:=2 to np do
    begin
      for ch:='A' to 'Z' do
        begin
          if ch=p[i] then g[i-1,ch]:=i
          else
            begin
              t:=q;
              while (t>0) and (p[t+1]<>ch) do t:=c[t];
              if p[t+1]=ch then inc(t);
              g[i-1,ch]:=t;
            end;
        end;

      while (q>0) and (p[q+1]<>p[i]) do q:=c[q];
      if p[q+1]=p[i] then inc(q);
      c[i]:=q;
    end;

end;
begin
//  assign(input,'te.in'); reset(input);
  readln(a);
  readln(b);
  readln(p);
  kmp;
  na:=length(a);
  nb:=length(b);
  a:=a+'@';
  b:=b+'%';
  fillchar(f,sizeof(f),0);
  fillchar(tr,sizeof(tr),0);
  for i:=0 to na do
    for j:=0 to nb do
      for k:=0 to np-1 do
        begin
          if f[i,j,k]>f[i,j+1,k] then
            begin
              f[i,j+1,k]:=f[i,j,k];
              tr[i,j+1,k]:=1;
            end;
          if f[i,j,k]>f[i+1,j,k] then
            begin
              f[i+1,j,k]:=f[i,j,k];
              tr[i+1,j,k]:=2;
            end;
          if (a[i+1]=b[j+1]) and (f[i,j,k]+1>f[i+1,j+1,g[k,a[i+1]]]) then
            begin
              f[i+1,j+1,g[k,a[i+1]]]:=f[i,j,k]+1;
              tr[i+1,j+1,g[k,a[i+1]]]:=-k-1;
            end;
        end;
  r:=0;
  for k:=0 to np-1 do if f[na,nb,k]>f[na,nb,r] then r:=k;
  if F[na,nb,r]=0 then
    begin
      writeln(f[na,nb,r]);
      halt;
    end;
  i:=na;
  j:=nb;
  k:=r;
  rs:='';
  repeat
    t:=tr[i,j,k];
    if t=0 then break;
    case t of
      1: dec(j);
      2: dec(i);
    else
      begin
        rs:=rs+a[i];
        dec(i);
        dec(j);
        k:=-t-1;
      end;
    end;
  until false;
  for i:=length(rs) downto 1 do write(rs[i]);

end.

type tt=record
 x,y,z:longint;
end;
Var i,j,u,k,n,m,x,y,z:longint;
    pref:array[0..123]of longint;
    s1,s2,virus:string;
    q:char;
    next:array[0..123,char]of longint;
    f:array[0..103,0..103,0..103]of longint;
    p:array[0..103,0..103,0..103]of tt;
 procedure go(x,y,z,val:longint);
     begin
       if f[x,y,z]<val then
         begin
           f[x,y,z]:=val;
           p[x,y,z].x:=i;
           p[x,y,z].y:=j;
           p[x,y,z].z:=u;
         end;
     end;
 procedure rec(x,y,z:longint);
  var xx,yy,zz:longint;
    begin
      if x=0 then exit;
      xx:=p[x,y,z].x;
      yy:=p[x,y,z].y;
      zz:=p[x,y,z].z;
      rec(xx,yy,zz);
      if f[xx,yy,zz]<f[x,y,z] then Write(s1[x]);
    end;
  begin
    readln(s1);
    readln(s2);
    readln(virus);
    n:=length(s1);
    m:=length(s2);
    k:=length(virus);
    pref[1]:=0;
    for i:=2 to k do
      begin
        j:=pref[i-1];
        while (j>0)and(virus[i]<>virus[j+1]) do
          j:=pref[j];
        if virus[j+1]=virus[i] then pref[i]:=j+1
        else pref[i]:=0;
      end;
    for i:=1 to k-1 do
      for q:='A' to 'Z' do
        begin
          j:=i;
          while (j>0)and(virus[j+1]<>q) do
            j:=pref[j];
          if virus[j+1]=q then next[i,q]:=j+1
          else next[i,q]:=0;
        end;
    for i:=0 to n+1 do
      for j:=0 to m+1 do
        for u:=0 to k+1 do
          f[i,j,u]:=-1;
    f[0,0,0]:=0;
    for i:=0 to n do
      for j:=0 to m do
        for u:=0 to k-1 do
          if f[i,j,u]<>-1 then
          begin
            go(i+1,j,u,f[i,j,u]);
            go(i,j+1,u,f[i,j,u]);
            if (i<n)and(j<m)and(s1[i+1]=s2[j+1]) then
              begin
                if (s1[i+1]=virus[u+1]) then
                  begin
                    if u+1<k then go(i+1,j+1,u+1,f[i,j,u]+1);
                  end
                 else go(i+1,j+1,next[u,s1[i+1]],f[i,j,u]+1);
              end
          end;
    x:=0;
    y:=0;
    z:=0;
    for i:=1 to n do
      for j:=1 to m do
        for u:=0 to k do
          if f[i,j,u]>f[x,y,z] then
            begin
              x:=i;
              y:=j;
              z:=u;
            end;
    if x=0 then Write(0)
    else rec(x,y,z);
    Writeln;
  end.

var s1,s2,virus : string;
    d,d2 : array[1..210,0..210] of string;
    var i,j,k,i1,j1 : longint;
    p : array[0..210] of longint;
    s,best : string;
begin
    readln(s1);
    readln(s2);
    readln(virus);
    //s1 := 'BABB';
    //s2 := 'BABB';
    //virus := 'AB';

    for i := 1 to 110 do
        for j := 0 to 110 do begin
            d[i][j] := '';
            d2[i][j] := '';
        end;

    best := '';
    for i := 1 to length(s1) do begin

        for j := 1 to length(s2) do
            for k := 0 to length(virus)-1 do begin
                d2[j][k] := '';
        end;

        for j := 1 to length(s2) do
            for k := 0 to length(virus)-1 do begin
                if s1[i] = s2[j] then begin
                    //writeln(i,' ',j);
                    s := virus+'#'+d[j][k]+s1[i];
                    j1 := 0;
                    for i1 := 0 to length(s) do p[i1] := 0;

                    for i1 := 1 to length(s)-1 do begin
                        while (j1 > 0) and (s[i1+1] <> s[j1+1]) do j1 := p[j1-1];
                        if s[i1+1] = s[j1+1] then inc(j1);
                        p[i1] := j1;
                    end;

                    //j1 := 0;
                    //writeln(j1);

                    if (length(d[j][k])+1 > length(d2[j+1][j1])) and (j1 < length(virus)) then begin

                        d2[j+1][j1] := d[j][k]+s1[i];
                        //writeln('yes ',j+1,' ',j1);
                    //  writeln(i,' ',j,' ',s,' ',d2[j+1][j1],' ',j1,' ',length(d2[j+1][j1]));
                        if (length(best) < length(d2[j+1][j1])) then best := d2[j+1][j1];
                    end;

                end; begin
                    if (length(d[j][k]) > length(d2[j][k])) then d2[j][k] := d[j][k];
                    if (length(d[j][k]) > length(d[j+1][k])) then d[j+1][k] := d[j][k];
                end;

            end;

        d := d2;

        {writeln('i: ',i);
        for i1 := 1 to length(s2) do begin
            for j1 := 0 to length(virus)-1 do
                if length(d[i1][j1]) > 0 then
                //write(d[i1][j1],' ') else write('- ');
            writeln;
        end;

        writeln;}

    end;

    if length(best) > 0 then
    writeln(best) else writeln(0);

end.

var f,l:array[0..100,0..100,0..100] of longint;
    m:array[0..100,'A'..'Z'] of longint;
    p:array[1..100] of longint;
    i,j,k,t,l1,l2,lv,max:longint;
    a,b,v,ans:string;
    ch:char;

procedure print(x,y,z:longint);

  begin
    if (x=0) or (y=0) then exit;
    if l[x,y,z]<=0 then begin ans:=a[x]+ans; print(x-1,y-1,-l[x,y,z]); end;
    if l[x,y,z]=1 then print(x-1,y,z);
    if l[x,y,z]=2 then print(x,y-1,z);
  end;

begin
  readln(a);
  l1:=length(a);
  readln(b);
  l2:=length(b);
  readln(v);
  lv:=length(v);
  p[1]:=0;
  j:=0;
  for i:=2 to lv do
    begin
      while (j>0) and (v[j+1]<>v[i]) do
        j:=p[j];
      if v[j+1]=v[i] then inc(j);
      p[i]:=j;
    end;
  fillchar(m,sizeof(m),0);
  for i:=0 to lv-1 do
    for ch:='A' to 'Z' do
      if v[i+1]=ch then m[i,ch]:=i+1 else m[i,ch]:=m[p[i],ch];
  for i:=0 to l1 do
    for j:=0 to l2 do
      for k:=0 to lv do
        if (k=0) and (i*j=0) then f[i,j,k]:=0 else f[i,j,k]:=-1;
  for i:=0 to l1 do
    for j:=0 to l2 do
      for k:=0 to lv-1 do
        begin
          if (i<>l1) and (j<>l2) then
            if a[i+1]=b[j+1] then
              if f[i,j,k]+1>f[i+1,j+1,m[k,a[i+1]]] then
                begin
                  f[i+1,j+1,m[k,a[i+1]]]:=f[i,j,k]+1;
                  l[i+1,j+1,m[k,a[i+1]]]:=-k;
                end;
            if i<>l1 then
              if f[i,j,k]>f[i+1,j,k] then
                begin
                  f[i+1,j,k]:=f[i,j,k];
                  l[i+1,j,k]:=1;
                end;
            if j<>l2 then
              if f[i,j,k]>f[i,j+1,k] then
                begin
                  f[i,j+1,k]:=f[i,j,k];
                  l[i,j+1,k]:=2;
                end;
        end;
  max:=f[l1,l2,0];
  t:=0;
  for i:=1 to lv-1 do
    if f[l1,l2,i]>max then begin max:=f[l1,l2,i]; t:=i; end;
  ans:='';
  if max=0 then
    writeln(0)
  else
    begin
      print(l1,l2,t);
      writeln(ans);
    end;
end.

program probb;
type
	dp=record
		x,y,z,num:longint;
		ok:boolean;
	end;
var
	f:array[0..100,0..100,0..100] of dp;
	a:array[0..100,'A'..'Z'] of longint;
	max,d1,d2,dv,i,j,k,x,y,z:longint;
	p:array[0..100] of longint;
	ans,s1,s2,v:string;
	c:char;

procedure kmp();
	var
		k,i:longint;
	begin
		k:=0;
		for i:=2 to dv do begin
			while (k>0)and(v[k+1]<>v[i]) do k:=p[k];
			if (v[k+1]=v[i]) then inc(k);
			p[i]:=k;
		end;
	end;
begin
	readln(s1); readln(s2);
	readln(v);
	d1:=length(s1); d2:=length(s2);
	dv:=length(v);
	kmp();
	for i:=0 to dv-1 do
		for c:='A' to 'Z' do
			if (v[i+1]=c) then a[i,c]:=i+1 else a[i,c]:=a[p[i],c];
	for i:=0 to d1 do
		for j:=0 to d2 do
			for k:=0 to dv-1 do begin
				if (i*j=0)and(k>0) then continue;
				if (i<>d1)and(j<>d2)and(s1[i+1]=s2[j+1])and(f[i+1,j+1,a[k,s1[i+1]]].num<f[i,j,k].num+1) then begin
					f[i+1,j+1,a[k,s1[i+1]]].num:=f[i,j,k].num+1;
					f[i+1,j+1,a[k,s1[i+1]]].x:=i;
					f[i+1,j+1,a[k,s1[i+1]]].y:=j;
					f[i+1,j+1,a[k,s1[i+1]]].z:=k;
					f[i+1,j+1,a[k,s1[i+1]]].ok:=true;
				end;
				if (i<>d1)and(f[i+1,j,k].num<f[i,j,k].num) then begin
					f[i+1,j,k].num:=f[i,j,k].num;
					f[i+1,j,k].x:=i;
					f[i+1,j,k].y:=j;
					f[i+1,j,k].z:=k;
					f[i+1,j,k].ok:=false;
				end;
				if (j<>d2)and(f[i,j+1,k].num<f[i,j,k].num) then begin
					f[i,j+1,k].num:=f[i,j,k].num;
					f[i,j+1,k].x:=i;
					f[i,j+1,k].y:=j;
					f[i,j+1,k].z:=k;
					f[i,j+1,k].ok:=false;
				end;
			end;
	max:=0;
	for x:=0 to dv-1 do
		if (max<f[d1,d2,x].num) then begin
			max:=f[d1,d2,x].num;
			k:=x;
		end;
	if (max=0) then writeln(0) else begin
		i:=d1; j:=d2;
		while (i>0)and(j>0) do begin
			if (f[i,j,k].ok=true) then ans:=s1[i]+ans;
			x:=f[i,j,k].x; y:=f[i,j,k].y; z:=f[i,j,k].z;
			i:=x; j:=y; k:=z;
		end;
		writeln(ans);
	end;
end.

{$coperators on}
{$mode objfpc}
uses math;
const
        fi='INPUT.INP';
        fo='OUTPUT.OUT';
        maxn=105;
procedure fileio;
begin
        assign(input,fi); reset(input);
        assign(output,fo); rewrite(output);
end;
type    data=record
                x,y,z:longint;
        end;
        arr=array[0..maxn*2] of longint;
var     a,b,c,s:string;
        f:array[0..maxn,0..maxn,0..maxn] of longint;
        trace:array[0..maxn,0..maxn,0..maxn] of data;
        next:array[0..maxn,'A'..'Z'] of longint;
        Z:arr;
procedure enter;
begin
        readln(a);
        readln(b);
        readln(c);
end; {
procedure maximize(var target:longint; value:longint);
begin
        if value>target then target:=value;
end;  }
function make(i,j,k:longint):data;
begin
        result.x:=i; result.y:=j; result.z:=k;
end;
procedure maximize(i,j,k,x,y,z,val:longint);
begin
        if f[i][j][k]<f[x][y][z]+val then
         begin
                f[i][j][k]:=f[x][y][z]+val;
                trace[i][j][k]:=make(x,y,z);
         end;
end;
procedure Zfunc(var s:string; var Z:arr);
var     l,r,i,n:longint;
begin
        l:=0; r:=0; fillchar(z,sizeof(z),0);
        n:=length(s);
        for i:=2 to n do begin
                if i<r then z[i]:=min(z[i-l+1],r-i+1);
                while (i+z[i]<=n) and (s[z[i]+1]=s[i+z[i]]) do inc(z[i]);
                if i+z[i]-1>r then begin
                        r:=i+z[i]-1;
                        l:=i;
                end;
         end;
end;
procedure init;
var     tmp:string;
        n,i,len,j:longint;
        ch:char;
begin
        tmp:=c+'##';
        n:=length(c);
        for i:=0 to n do begin
                len:=length(tmp);
                if i<>0 then begin
                        tmp[len]:=c[i];
                        tmp+='#';
                        inc(len);
                end;
                for ch:='A' to 'Z' do begin
                        tmp[len]:=ch;
                        Zfunc(tmp,Z);
                        //next[i][ch]
                        for j:=n+2 to len do
                         if z[j]=len-j+1 then begin
                                next[i][ch]:=z[j];
                                break;
                         end;
                end;
        end;
end;
procedure solve;
var     i,j,k,res,len,m,n,z:longint;
        tmp:data;
begin
        init;
        n:=length(a); m:=length(b); z:=length(c);
        fillchar(f,sizeof(f),255);
        f[0][0][0]:=0;
        for i:=0 to n-1 do
         for j:=0 to m-1 do
          for k:=0 to z-1 do
           if f[i][j][k]<>-1 then begin
                maximize(i+1,j,k,i,j,k,0);//maximize(f[i+1][j][k],f[i][j][k]);
                maximize(i,j+1,k,i,j,k,0);//maximize(f[i][j+1][k],f[i][j][k]);
                if a[i+1]=b[j+1] then
                        maximize(i+1,j+1,next[k][a[i+1]],i,j,k,1)//maximize(f[i+1][j+1][next[k][a[i+1]],f[i][j][k]+1)
           end;
        res:=0;
        for i:=1 to n do
         for j:=1 to m do
          for k:=0 to z-1 do
           res:=max(res,f[i][j][k]);
        if res=0 then writeln(0)
        else begin
             for i:=1 to n do
              for j:=1 to m do
               for k:=0 to z-1 do
                if res=f[i][j][k] then
                        tmp:=make(i,j,k);
             i:=tmp.x; j:=tmp.y; k:=tmp.z;
             len:=res;
             while len>0 do begin
                tmp:=trace[i][j][k];
                with tmp do begin
                        if f[i][j][k]=f[x][y][z]+1 then begin
                                s+=a[i];
                                dec(len);
                        end;
                        i:=x; j:=y; k:=z;
                end;
             end;
             for len:=res downto 1 do
                write(s[len]);
             exit;
        end;
end;
begin
        //fileio;
        enter;
        solve;
end.

type pp=record
         x,y:longint;
        end;

var q:char;
    j,g:longint;
    s1,s2,w,ww,lw:string;
    i,l,m,n,t,x,y,lx,ly,len:longint;
    p:array[0..111,0..111,0..111] of pp;
    a,b,d:array[0..111,'A'..'Z'] of longint;
    c:array[0..111,0..111,0..111] of longint;

procedure tt(len,x,y:longint);
 begin
  if (x=0) and (y=0) then exit;
  tt(len-1,p[len,x,y].x,p[len,x,y].y);
  write(s1[x]);
 end;

 begin
  readln(s1);
  readln(s2);
  n:=length(s1);
  m:=length(s2);
  if n<m then l:=n
         else l:=m;

  for q:='A' to 'Z' do
   begin
    a[n+1,q]:=n+1;
    b[m+1,q]:=m+1;
   end;

  for i:=n downto 0 do
   begin
    for q:='A' to 'Z' do
     a[i,q]:=a[i+1,q];
    if i>0 then a[i,s1[i]]:=i;
   end;

  for i:=m downto 0 do
   begin
    for q:='A' to 'Z' do
     b[i,q]:=b[i+1,q];
    if i>0 then b[i,s2[i]]:=i;
   end;

  lw:='';
  readln(w);
  t:=length(w);
  for i:=1 to t do
   begin
    for q:='A' to 'Z' do
     begin
      ww:=lw+q;

      for j:=1 to i do
       begin
        if copy(ww,i-j+1,j)=copy(w,1,j) then d[i-1,q]:=j;
       end;

     end;

    lw:=lw+w[i];
   end;

  for i:=0 to l do
   for x:=0 to n do
    for y:=0 to m do
      c[i,x,y]:=-1;

  c[0,0,0]:=0;
  for i:=0 to l do
   begin

    for x:=0 to n do
     for y:=0 to m do
      begin

       if (c[i,x,y]=-1) then continue;

       for q:='A' to 'Z' do
        begin
         lx:=a[x+1,q];
         ly:=b[y+1,q];
         if (lx<=n) and
            (ly<=m) then begin
                          g:=d[c[i,x,y],q];
                          if (g>=t) then continue;

                          if (c[i+1,lx,ly]=-1) or
                             (c[i+1,lx,ly]>g) then begin
                                                    c[i+1,lx,ly]:=g;
                                                    p[i+1,lx,ly].x:=x;
                                                    p[i+1,lx,ly].y:=y;
                                                   end;
                         end;
        end;

      end;

   end;

  len:=0;
  for i:=l downto 0 do
   begin
    for x:=n downto 1 do
     begin
      for y:=m downto 1 do
       if (c[i,x,y]<>-1) then begin
                               lx:=x;ly:=y;
                               len:=i;
                               break;
                              end;
      if (len>0) then break;
     end;
    if (len>0) then break;
   end;

  if (len=0) then writeln(len)
             else begin
                   tt(len,lx,ly);writeln;
                  end;
 end.

const
  l=100;
type
  dp=record
    x,y,z,num:longint;
    used:boolean;
  end;
var
  f:array[0..l,0..l,0..l] of dp;
  go:array[0..l,'A'..'Z'] of longint;
  max,d1,d2,dv,i,j,k,x,y,z:longint;
  p:array[0..l] of longint;
  ans,s1,s2,v:string;
  c:char;

procedure kmp;
var
  k,i:longint;
begin
  k:=0;
  for i:=2 to dv do
  begin
    while (k>0) and (v[k+1]<>v[i]) do k:=p[k];
    if (v[k+1]=v[i]) then inc(k);
    p[i]:=k;
  end;
end;

begin
  readln(s1);
  readln(s2);
  readln(v);
  d1:=length(s1);
  d2:=length(s2);
  dv:=length(v);
  kmp;
  for i:=0 to dv-1 do for c:='A' to 'Z' do
  begin
    case i of
    0: if (v[i+1]=c) then go[i,c]:=1 else go[i,c]:=0;
    else if (v[i+1]=c) then go[i,c]:=i+1 else go[i,c]:=go[p[i],c];
    end;
  end;
  for i:=0 to d1 do for j:=0 to d2 do for k:=0 to dv-1 do
  begin
    if (i*j=0) and (k>0) then continue;
    if (i<>d1) and (j<>d2) and (s1[i+1]=s2[j+1]) and (f[i+1,j+1,go[k,s1[i+1]]].num<f[i,j,k].num+1) then
    begin
      f[i+1,j+1,go[k,s1[i+1]]].num:=f[i,j,k].num+1;
      f[i+1,j+1,go[k,s1[i+1]]].x:=i;
      f[i+1,j+1,go[k,s1[i+1]]].y:=j;
      f[i+1,j+1,go[k,s1[i+1]]].z:=k;
      f[i+1,j+1,go[k,s1[i+1]]].used:=true;
    end;
    if (i<>d1) and (f[i+1,j,k].num<f[i,j,k].num) then
    begin
      f[i+1,j,k].num:=f[i,j,k].num;
      f[i+1,j,k].x:=i;
      f[i+1,j,k].y:=j;
      f[i+1,j,k].z:=k;
      f[i+1,j,k].used:=false;
    end;
    if (j<>d2) and (f[i,j+1,k].num<f[i,j,k].num) then
    begin
      f[i,j+1,k].num:=f[i,j,k].num;
      f[i,j+1,k].x:=i;
      f[i,j+1,k].y:=j;
      f[i,j+1,k].z:=k;
      f[i,j+1,k].used:=false;
    end;
  end;
  max:=0;
  for x:=0 to dv-1 do if (max<f[d1,d2,x].num) then
  begin
    max:=f[d1,d2,x].num;
    k:=x;
  end;
  if (max=0) then writeln(0) else
  begin
    i:=d1;
    j:=d2;
    while (i>0) and (j>0) do
    begin
      if (f[i,j,k].used) then ans:=s1[i]+ans;
      x:=f[i,j,k].x;
      y:=f[i,j,k].y;
      z:=f[i,j,k].z;
      i:=x;
      j:=y;
      k:=z;
    end;
    writeln(ans);
  end;
end.

const
  l=100;
type
  dp=record
    x,y,z,num:longint;
    used:boolean;
  end;
var
  f:array[0..l,0..l,0..l] of dp;
  go:array[0..l,'A'..'Z'] of longint;
  max,d1,d2,dv,i,j,k,x,y,z:longint;
  p:array[0..l] of longint;
  ans,s1,s2,v:string;
  c:char;

procedure kmp;
var
  k,i:longint;
begin
  k:=0;
  for i:=2 to dv do
  begin
    while (k>0) and (v[k+1]<>v[i]) do k:=p[k];
    if (v[k+1]=v[i]) then inc(k);
    p[i]:=k;
  end;
end;

begin
  readln(s1);
  readln(s2);
  readln(v);
  d1:=length(s1);
  d2:=length(s2);
  dv:=length(v);
  kmp;
  for i:=0 to dv-1 do for c:='A' to 'Z' do if (v[i+1]=c) then go[i,c]:=i+1 else go[i,c]:=go[p[i],c];
  for i:=0 to d1 do for j:=0 to d2 do for k:=0 to dv-1 do
  begin
    if (i*j=0) and (k>0) then continue;
    if (i<>d1) and (j<>d2) and (s1[i+1]=s2[j+1]) and (f[i+1,j+1,go[k,s1[i+1]]].num<f[i,j,k].num+1) then
    begin
      f[i+1,j+1,go[k,s1[i+1]]].num:=f[i,j,k].num+1;
      f[i+1,j+1,go[k,s1[i+1]]].x:=i;
      f[i+1,j+1,go[k,s1[i+1]]].y:=j;
      f[i+1,j+1,go[k,s1[i+1]]].z:=k;
      f[i+1,j+1,go[k,s1[i+1]]].used:=true;
    end;
    if (i<>d1) and (f[i+1,j,k].num<f[i,j,k].num) then
    begin
      f[i+1,j,k].num:=f[i,j,k].num;
      f[i+1,j,k].x:=i;
      f[i+1,j,k].y:=j;
      f[i+1,j,k].z:=k;
      f[i+1,j,k].used:=false;
    end;
    if (j<>d2) and (f[i,j+1,k].num<f[i,j,k].num) then
    begin
      f[i,j+1,k].num:=f[i,j,k].num;
      f[i,j+1,k].x:=i;
      f[i,j+1,k].y:=j;
      f[i,j+1,k].z:=k;
      f[i,j+1,k].used:=false;
    end;
  end;
  max:=0;
  for x:=0 to dv-1 do if (max<f[d1,d2,x].num) then
  begin
    max:=f[d1,d2,x].num;
    k:=x;
  end;
  if (max=0) then writeln(0) else
  begin
    i:=d1;
    j:=d2;
    while (i>0) and (j>0) do
    begin
      if (f[i,j,k].used) then ans:=s1[i]+ans;
      x:=f[i,j,k].x;
      y:=f[i,j,k].y;
      z:=f[i,j,k].z;
      i:=x;
      j:=y;
      k:=z;
    end;
    writeln(ans);
  end;
end.

const
      inf=10000;
var
    i,j,l1,l2,lv,k,t,ans:longint;
    s,s1,s2,virus:string;
    kmp:array[0..110] of longint;
    pre,dp:array[0..101,0..101,0..101] of longint;

begin {main}
  readln(s1);
  readln(s2);
  readln(virus);
  l1:=length(s1);l2:=length(s2);lv:=length(virus);
  kmp[1]:=0;k:=0;
  for i:=2 to lv do
    begin
      while (k<>0) and (virus[k+1]<>virus[i]) do k:=kmp[k];
      if virus[k+1]=virus[i] then inc(k);
      kmp[i]:=k;
    end;
  for i:=0 to l1 do
    for j:=0 to l2 do
      for k:=0 to lv do
        dp[i,j,k]:=-inf;
  dp[0,0,0]:=0;
  for i:=0 to l1 do
    for j:=0 to l2 do
      for k:=0 to lv-1 do
        begin
          if i<l1 then
            if dp[i,j,k]>dp[i+1,j,k] then begin dp[i+1,j,k]:=dp[i,j,k];pre[i+1,j,k]:=1;end;
          if j<l2 then
            if dp[i,j,k]>dp[i,j+1,k] then begin dp[i,j+1,k]:=dp[i,j,k];pre[i,j+1,k]:=2;end;
          if (i<l1) and (j<l2) and (s1[i+1]=s2[j+1]) then
            begin
              t:=k;
              while (t<>0) and (virus[t+1]<>s1[i+1]) do t:=kmp[t];
              if virus[t+1]=s1[i+1] then inc(t);
              if dp[i+1,j+1,t]<dp[i,j,k]+1 then begin dp[i+1,j+1,t]:=dp[i,j,k]+1;pre[i+1,j+1,t]:=k+3;end;
            end;
        end;
  ans:=0;
  for i:=0 to lv-1 do
    if dp[l1,l2,i]>ans then begin ans:=dp[l1,l2,i];k:=i;end;
  if ans=0 then
    writeln(0)
  else
    begin
      i:=l1;j:=l2;s:='';
      while (i<>0) and (j<>0) do
        begin
          case pre[i,j,k] of
            1:dec(i);
            2:dec(j);
            else
              begin
                k:=pre[i,j,k]-3;
                s:=s1[i]+s;
                dec(i);dec(j);
              end;
          end;
        end;
      writeln(s);
    end;
end.

var dp: array[0..100, 0..100, 0..100] of AnsiString;
    s1, s2, virus: AnsiString;
    n, m, l, i, j, k, temp: longint;
    p: array[0..501] of longint;
    ans: AnsiString;

function GetEntry(a, b: AnsiString): longint;
var i, t: longint;
begin
 a:= a + '#' + b;
 p[1]:= 0;
 for i:= 2 to length(a) do
  begin
   t:= p[i-1];
   while (t > 0) and (a[i] <> a[t + 1]) do
    t:= p[t];

   if a[i] = a[t + 1] then
    p[i]:= t + 1;
  end;
 GetEntry:= p[length(a)];
end;

begin
 //assign(input,'input.txt'); reset(input);
 //assign(output,'output.txt'); rewrite(output);
 readln(s1);
 readln(s2);
 readln(virus);
 n:= length(s1);
 m:= length(s2);
 l:= length(virus);
 for i:= 1 to n do
  for j:= 1 to m do
   for k:= 0 to l-1 do
    begin
     if s1[i] = s2[j] then
      begin
       temp:= GetEntry(dp[i-1][j-1][k] + s1[i], virus);
       if (temp < l) and
          (length(dp[i][j][temp]) < length(dp[i-1][j-1][k]) + 1) then
        dp[i][j][temp]:= dp[i-1][j-1][k] + s1[i];
      end;

     if length(dp[i-1][j][k]) > length(dp[i][j][k]) then
      dp[i][j][k]:= dp[i-1][j][k];
     if length(dp[i][j-1][k]) > length(dp[i][j][k]) then
      dp[i][j][k]:= dp[i][j-1][k];
    end;

 ans:= dp[n][m][0];
 for k:= 1 to l-1 do
  if length(ans) < length(dp[n][m][k]) then
   ans:= dp[i][j][k];

 if length(ans) = 0 then
  write(0)
 else
  write(ans);
end.

var dp: array[0..100, 0..100, 0..100] of string;
    s1, s2, virus: string;
    n, m, l, i, j, k, temp: longint;
    p: array[0..200] of longint;
    ans: string;

function GetEntry(a, b: string): longint;
var i, t: longint;
begin
 a:= b + '#' + a;
 p[1]:= 0;
 for i:= 2 to length(a) do
  begin
   t:= p[i-1];
   while (t > 0) and (a[i] <> a[t + 1]) do
    t:= p[t];

   if a[i] = a[t + 1] then
    p[i]:= t + 1;
  end;
 GetEntry:= p[length(a)];
end;

begin
 //assign(input,'input.txt'); reset(input);
 //assign(output,'output.txt'); rewrite(output);
 readln(s1);
 readln(s2);
 readln(virus);
 n:= length(s1);
 m:= length(s2);
 l:= length(virus);

 for i:= 1 to n do
  for j:= 1 to m do
   for k:= 0 to l do
    begin
      if s1[i] = s2[j] then
       begin
        temp:= GetEntry(dp[i-1][j-1][k] + s1[i], virus);
        if (temp < l) and
           (length(dp[i][j][temp]) < length(dp[i-1][j-1][k]) + 1) then
         dp[i][j][temp]:= dp[i-1][j-1][k] + s1[i];
       end
      else
       begin
        if length(dp[i-1][j][k]) > length(dp[i][j-1][k]) then
         dp[i][j][k]:= dp[i-1][j][k]
        else
         dp[i][j][k]:= dp[i][j-1][k];
       end;
     end;

 ans:= dp[n][m][0];
 for i:= 1 to l-1 do
  if length(ans) < length(dp[n][m][i]) then
   ans:= dp[n][m][i];

 if length(ans) = 0 then
  write(0)
 else
  write(ans);
end.

uses math;
  var s1 , s2 , v , ans : string;
      i , j , n , m , lim , pp : longint;
      dp , pre : array[0 .. 101 , 0 .. 101] of longint;
      st : array[0 .. 101 , 0 .. 101] of string;

function pi(s : string) : longint;
  var p : array[0 .. 220] of longint;
      ss : string;
      i , j , d : longint;
begin

  ss := v + '$' + s;
  p[0] := 0; p[1] := 0; d := length(ss);
  i := 2;
  while i <= d do begin
    j := p[i - 1];
    while (j > 0) and (ss[i] <> ss[j + 1]) do j := p[j];
    p[i] := j;
    if ss[i] = ss[j + 1] then inc(p[i]);
    inc(i);
  end;

  exit(p[d]);

end;

BEGIN

  fillchar(dp , sizeof(dp) , 0);
  fillchar(pre , sizeof(pre) , 0);
  for i := 0 to 101 do for j := 0 to 101 do st[i][j] := '';

  readln(s1); readln(s2); readln(v);
  n := length(s1); m := length(s2); lim := length(v);
  for i := 1 to n do begin
    for j := 1 to m do begin
      if (dp[i - 1][j] > dp[i][j - 1]) or
         ((dp[i - 1][j] = dp[i][j - 1])and(pre[i - 1][j] < pre[i][j - 1])) then begin
        dp[i][j] := dp[i - 1][j];
        pre[i][j] := pre[i - 1][j];
        st[i][j] := st[i - 1][j];
      end
        else begin
          dp[i][j] := dp[i][j - 1];
          pre[i][j] := pre[i][j - 1];
          st[i][j] := st[i][j - 1];
        end;

      if s1[i] = s2[j] then begin
        if dp[i - 1][j - 1] + 1 < dp[i][j] then continue;

        pp := pre[i - 1][j - 1];
        if s1[i] = v[pp + 1] then inc(pp)
          else pp := pi(st[i - 1][j - 1] + s1[i]);

        if (pp < lim) then begin
          if (dp[i][j] < dp[i - 1][j - 1] + 1) or
             ((dp[i][j] = dp[i - 1][j - 1])and(pp < pre[i - 1][j - 1])) then begin
            dp[i][j] := dp[i - 1][j - 1] + 1;
            pre[i][j] := pp;
            st[i][j] := st[i - 1][j - 1] + s1[i];
          end;
        end;

      end;
    end;
  end;

  if length(st[n][m]) = 0 then writeln(0)
    else write(st[n][m]);

END.

uses math;
  var d , p , pri , prj : array[0 .. 110 , 0..110] of longint;
      s1 , s2 , v : string;
      n , m , i , j : longint;

procedure solve;
  var i , j , dn , pn : longint;
begin
  for i := 1 to n do begin
    for j := 1 to m do begin

      dn := d[i - 1 , j - 1]; pn := p[i - 1 , j - 1];
      if (s1[i] = s2[j]) then begin
        if (s1[i] = v[pn + 1]) then begin
          if pn + 1 < length(v) - 1 then begin inc(dn); inc(pn); end;
        end
          else begin
            inc(dn);
            if s1[i] = v[1] then pn := 1
              else pn := 0;
          end;
      end;

      d[i , j] := d[i - 1 , j]; p[i , j] := p[i - 1 , j];
      pri[i , j] := i - 1; prj[i , j] := j;

      if (d[i , j - 1] > d[i , j]) or
      ((d[i , j - 1] = d[i , j]) and (p[i , j - 1] < p[i , j])) then begin
        d[i , j] := d[i , j - 1]; p[i , j] := p[i , j - 1];
        pri[i , j] := i; prj[i , j] := j - 1;
      end;

      if (dn > d[i , j]) or ((dn = d[i , j]) and (pn < p[i , j])) then begin
        d[i , j] := dn; p[i , j] := pn;
        pri[i , j] := i - 1; prj[i , j] := j - 1;
      end;

    end;
  end;
end;

procedure outdata;
  var i , j , cc : longint;
      ans : string;
begin
  if d[n , m] = 0 then begin writeln(0); halt; end;
  ans := '';
  i := n; j := m;
  while (i <> 0) and (j <> 0) do begin
    if (pri[i , j] <> i) and (prj[i , j] <> j) then ans := ans + s1[i];
    cc := i; i := pri[cc , j]; j := prj[cc , j];
  end;
  for i := length(ans) downto 1 do write(ans[i]);
end;

BEGIN

  readln(s1); readln(s2); readln(v); v := v + '$';
  n := length(s1); m := length(s2);
  fillchar(d , sizeof(d) , 0);
  fillchar(p , sizeof(p) , 0);
  fillchar(pri , sizeof(pri) , 0);
  fillchar(prj , sizeof(prj) , 0);

  solve;
  outdata;

END.

uses math;
  var s1 , s2 , v , ans , ss : string;
      i , j , n , m , lim , pp : longint;
      dp , pre : array[0 .. 101 , 0 .. 101] of longint;
      st : array[0 .. 101 , 0 .. 101] of string;

function pi(s : string) : longint;
  var p : array[0 .. 220] of longint;
      ss : string;
      i , j , d : longint;
begin

  ss := v + '$' + s;
  p[0] := 0; p[1] := 0; d := length(ss);
  i := 2;
  while i <= d do begin
    j := p[i - 1];
    while (j > 0) and (ss[i] <> ss[j + 1]) do j := p[j];
    p[i] := j;
    if ss[i] = ss[j + 1] then inc(p[i]);
    inc(i);
  end;

  exit(p[d]);

end;

BEGIN

  fillchar(dp , sizeof(dp) , 0);
  fillchar(pre , sizeof(pre) , 0);
  for i := 0 to 101 do for j := 0 to 101 do st[i][j] := '';

  readln(s1); readln(s2); readln(v);
  n := length(s1); m := length(s2); lim := length(v);
  for i := 1 to n do begin
    for j := 1 to m do begin
      if (dp[i - 1][j] > dp[i][j - 1]) or
         ((dp[i - 1][j] = dp[i][j - 1])and(pre[i - 1][j] < pre[i][j - 1])) then begin
        dp[i][j] := dp[i - 1][j];
        pre[i][j] := pre[i - 1][j];
        st[i][j] := st[i - 1][j];
      end
        else begin
          dp[i][j] := dp[i][j - 1];
          pre[i][j] := pre[i][j - 1];
          st[i][j] := st[i][j - 1];
        end;

      if s1[i] = s2[j] then begin
        if dp[i - 1][j - 1] + 1 < dp[i][j] then continue;

        pp := pre[i - 1][j - 1];
        if s1[i] = v[pp + 1] then inc(pp)
          else pp := pi(st[i - 1][j - 1] + s1[i]);

        if (pp < lim) then begin
          if (dp[i][j] < dp[i - 1][j - 1] + 1) or
             ((dp[i][j] = dp[i - 1][j - 1])and(pp < pre[i - 1][j - 1])) then begin
            dp[i][j] := dp[i - 1][j - 1] + 1;
            pre[i][j] := pp;
            st[i][j] := st[i - 1][j - 1] + s1[i];
          end;
        end;

        if (pp = lim) then begin
          ss := st[i - 1][j - 1] + s1[i];
          if (length(ss) - pp = 0) or (ss[length(ss) - pp] <> v[1]) then begin
            dp[i][j] := dp[i - 1][j - 1];
            delete(ss , length(ss) - pp + 1 , 1);
            st[i][j] := ss;
            pre[i][j] := pi(ss);
          end;
        end;

      end;
    end;
  end;

  if length(st[n][m]) = 0 then writeln(0)
    else write(st[n][m]);

END.

{$MODE OBJFPC}
uses
   math;
const
   fi = '346BDIV1.INP';
   fo = '346BDIV1.OUT';
   maxn = 101;
var
   f, tracex, tracey, tracez : array[0..maxn,0..maxn,0..maxn] of Integer;
   ok : array[0..maxn,0..maxn,0..maxn] of Boolean;
   d : array[0..maxn,'A'..'Z'] of Integer;
   a, b, virus, sub : String;
   n, m, res: Integer;
   t : array[0..maxn] of Integer;

procedure enter;
begin
   //assign(input,fi); reset(input);
   readln(a); readln(b); readln(virus);
end;

procedure init;
var
   i, j : Integer;
   ch : Char;
begin
   fillchar(ok,sizeof(ok),false);
   j := 0;
   for i := 2 to length(virus) do
      begin
         while (virus[i] <> virus[j+1]) and (j > 0) do j := t[j];
         if (virus[i] = virus[j+1]) then inc(j);
         t[i] := j;
      end;
   for ch := 'A' to 'Z' do
      for i := 0 to length(virus) - 1 do
         begin
            j := i;
            while (virus[j+1] <> ch) and (j > 0) do j := t[j];
            if virus[j+1] = ch then inc(j);
            d[i,ch] := j;
         end;
end;

procedure solve;
var
   i, j, k, x0, y0, z0, z, p : Integer;
begin
   n := length(a); m := length(b);
   fillchar(f,sizeof(f),255);
   for i := 0 to n do
      for j := 0 to m do
         f[i,j,0] := 0;
   for i := 1 to n do
      for j := 1 to n do
         for k := 0 to length(virus) - 1 do
            begin
               if (i = 8) and (j = 1) and (k = 0) then
                  p := 1;
               if (a[i] = b[j]) and (f[i-1,j-1,k] <> -1) then z := d[k, a[i]] else z := -1;
               f[i,j,k] := max(f[i,j,k], max(f[i-1,j,k], f[i,j-1,k]));
               if f[i,j,k] = f[i,j-1,k] then
                  begin
                     tracex[i,j,k] := i; tracey[i,j,k] := j-1; tracez[i,j,k] := k;
                     ok[i,j,k] := false;
                  end
                     else
               if f[i,j,k] = f[i-1,j,k] then
                  begin
                     tracex[i,j,k] := i-1; tracey[i,j,k] := j; tracez[i,j,k] := k;
                     ok[i,j,k] := false;
                  end;
               if (z <> -1) and (z < length(virus)) then
                  begin
                     f[i,j,z] := max(f[i,j,z], f[i-1,j-1,k] + 1);
                     if f[i,j,z] = f[i-1,j-1,k] + 1 then
                        begin
                           tracex[i,j,z]:= i-1; tracey[i,j,z] := j-1; tracez[i,j,z] := k;
                           ok[i,j,z] := true;
                        end;
                  end;
            end;

   for i := 0 to length(virus) - 1 do
      begin
         res := max(res, f[n,m,i]);
         if res = f[n,m,i] then
            begin
               k := i;
            end;
      end;

   if res = 0 then
      begin
         writeln(0);
         halt;
      end;
   while (n > 0) and (m > 0) do
      begin
        if ok[n,m,k] then sub := a[n] + sub;
        x0 := tracex[n,m,k]; y0 := tracey[n,m,k]; z0 := tracez[n,m,k];
        n := x0; m := y0; k := z0;
      end;
   writeln(sub);
end;

begin
   enter;
   init;
   solve;
end.

{$MODE OBJFPC}
uses
   math;
const
   fi = '346B.INP';
   fo = '346B.OUT';
   maxn = 101;

var
   f, tracex, tracey, tracez : array[0..maxn,0..maxn,0..maxn] of Integer;
   s1, s2, virus : String;
   d : array[-2..maxn,'A'..'Z'] of Integer;
   m, n, res : Integer;
   t : array[0..maxn] of Integer;
   kq : String;

procedure enter;
begin
   //assign(input,fi); reset(input);
   readln(s1); readln(s2); readln(virus);
end;

procedure init;
var
   i, j : Integer;
   ch : char;
begin
   fillchar(f,sizeof(f),255);
   t[0] := 0;
   j := 0;
   for i := 2 to length(virus) do
      begin
         while (j > 0) and (virus[j+1] <> virus[i]) do j := t[j];
         if virus[j+1] = virus[i] then inc(j);
         t[i] := j;
      end;
   for  i := 0 to length(virus) - 1 do
      for ch := 'A' to 'Z' do
         begin
            j := i;
            while (ch <> virus[j+1]) and (j > 0) do j := t[j];
            if ch = virus[j+1] then inc(j);
            d[i,ch] := j;
         end;
end;

procedure solve;
var
   i, j, k, x, y, z, x0, y0, z0 : Integer;
begin
   n := length(s1);
   m := length(s2);
   for i := 1 to n do
      for j := 1 to m do
         for k := 0 to length(virus) - 1 do
            begin
               if f[i-1,j,k] < f[i,j-1,k] then
                  begin
                     tracex[i,j,k] := i; tracey[i,j,k] := j-1; tracez[i,j,k] := k;
                     f[i,j,k] := f[i,j-1,k];
                  end else
                  begin
                    tracex[i,j,k] := i-1; tracey[i,j,k] := j; tracez[i,j,k] := k;
                    f[i,j,k] := f[i-1,j,k];
                  end;
               if (s1[i] = s2[j]) and (f[i,j,k] < f[i-1,j-1,d[k-1,s1[i]]] + 1) then
                  begin
                     f[i,j,k] := max(f[i,j,k], f[i-1,j-1,d[k-1,s1[i]]] + 1);
                     tracex[i,j,k] := i-1; tracey[i,j,k] := j - 1;
                     tracez[i,j,k] := d[k-1,s1[i]] + 1;
                  end;
            end;
   res := 0;
   for i := 0 to length(virus) - 1 do
      if res < f[n,m,i] then
         begin
            res := f[n,m,i];
            x := n; y := m; z:= i;
         end;
   if res = 0 then writeln(0) else
   while (x > 0) and (y > 0) do
      begin
         if (s1[x] = s2[y]) and (f[x,y,z] = f[x-1,y-1,d[z-1,s1[x]]] + 1) then
            kq := s1[x] + kq;
         x0 := tracex[x,y,z]; y0 := tracey[x,y,z]; z0 := tracez[x,y,z];
         x := x0; y := y0; z := z0;
      end;
   if res <> 0 then writeln(kq);
end;

begin
   enter;
   init;
   solve;
end.

{$MODE OBJFPC}
uses
   math;
const
   fi = '346B.INP';
   fo = '346B.OUT';
   maxn = 101;

var
   f, tracex, tracey, tracez : array[0..maxn,0..maxn,0..maxn] of Integer;
   s1, s2, virus : String;
   d : array[-2..maxn,'A'..'Z'] of Integer;
   m, n, res : Integer;
   t : array[0..maxn] of Integer;
   kq : String;

procedure enter;
begin
   //assign(input,fi); reset(input);
   readln(s1); readln(s2); readln(virus);
end;

procedure init;
var
   i, j : Integer;
   ch : char;
begin
   fillchar(f,sizeof(f),255);
   t[0] := 0;
   j := 0;
   for i := 2 to length(virus) do
      begin
         while (j > 0) and (virus[j+1] <> virus[i]) do j := t[j];
         if virus[j+1] = virus[i] then inc(j);
         t[i] := j;
      end;
   for  i := -1 to length(virus) - 2 do
      for ch := 'A' to 'Z' do
         begin
            j := i + 1;
            while (ch <> virus[j+1]) and (j > 0) do j := t[j];
            if ch = virus[j+1] then inc(j);
            d[i,ch] := j;
         end;
end;

procedure solve;
var
   i, j, k, x, y, z, x0, y0, z0 : Integer;
begin
   n := length(s1);
   m := length(s2);
   f[0,0,0] := 0;
   for i := 1 to n do
      for j := 1 to m do
         for k := 0 to length(virus) - 1 do
            begin
               if f[i-1,j,k] < f[i,j-1,k] then
                  begin
                     tracex[i,j,k] := i; tracey[i,j,k] := j-1; tracez[i,j,k] := k;
                     f[i,j,k] := f[i,j-1,k];
                  end else
                  begin
                     tracex[i,j,k] := i-1; tracey[i,j,k] := j; tracez[i,j,k] := k;
                     f[i,j,k] := f[i-1,j,k];
                  end;
               if (s1[i] = s2[j]) and (d[k-1,s1[i]] = k) and (f[i,j,k] < f[i-1,j-1,d[k-1,s1[i]]] + 1) then
                  begin
                     f[i,j,k] := max(f[i,j,k], f[i-1,j-1,d[k-1,s1[i]]] + 1);
                     tracex[i,j,k] := i-1; tracey[i,j,k] := j - 1;
                     tracez[i,j,k] := d[k-1,s1[i]];
                  end;
            end;
   res := 0;
   for i := 0 to length(virus) - 1 do
      if res < f[n,m,i] then
         begin
            res := f[n,m,i];
            x := n; y := m; z:= i;
         end;
   if res = 0 then writeln(0) else
   while (x > 0) and (y > 0) do
      begin
         if (s1[x] = s2[y]) and (d[z-1,s1[x]] = z) and (f[x,y,z] = f[x-1,y-1,d[z-1,s1[x]]] + 1) then
            begin
               kq := s1[x] + kq;
               x0 := x - 1; y0 := y - 1; z0 := d[z-1,s1[x]];
               x:= x0; y := y0; z := z0;
            end else
            begin
               x0 := tracex[x,y,z]; y0 := tracey[x,y,z]; z0 := tracez[x,y,z];
               x := x0; y := y0; z := z0;
            end;
      end;
   if res <> 0 then writeln(kq);
end;

begin
   enter;
   init;
   solve;
end.

{$MODE OBJFPC}
uses
   math;
const
   fi = '346B.INP';
   fo = '346B.OUT';
   maxn = 101;

var
   f, tracex, tracey, tracez : array[0..maxn,0..maxn,0..maxn] of Integer;
   s1, s2, virus : String;
   d : array[-2..maxn,'A'..'Z'] of Integer;
   m, n, res : Integer;
   t : array[0..maxn] of Integer;
   kq : String;

procedure enter;
begin
   //assign(input,fi); reset(input);
   readln(s1); readln(s2); readln(virus);
end;

procedure init;
var
   i, j : Integer;
   ch : char;
begin
   fillchar(f,sizeof(f),255);
   t[0] := 0;
   j := 0;
   for i := 2 to length(virus) do
      begin
         while (j > 0) and (virus[j+1] <> virus[i]) do j := t[j];
         if virus[j+1] = virus[i] then inc(j);
         t[i] := j;
      end;
   for  i := 0 to length(virus) - 1 do
      for ch := 'A' to 'Z' do
         begin
            j := i;
            while (ch <> virus[j+1]) and (j > 0) do j := t[j];
            if ch = virus[j+1] then inc(j);
            d[i,ch] := j;
         end;
end;

procedure solve;
var
   i, j, k, x, y, z, x0, y0, z0 : Integer;
begin
   n := length(s1);
   m := length(s2);
   for i := 1 to n do
      for j := 1 to m do
         for k := 0 to length(virus) - 1 do
            begin
               if f[i-1,j,k] < f[i,j-1,k] then
                  begin
                     tracex[i,j,k] := i; tracey[i,j,k] := j-1; tracez[i,j,k] := k;
                     f[i,j,k] := f[i,j-1,k];
                  end else
                  begin
                    tracex[i,j,k] := i-1; tracey[i,j,k] := j; tracez[i,j,k] := k;
                    f[i,j,k] := f[i-1,j,k];
                  end;
               if (s1[i] = s2[j]) and (f[i,j,k] < f[i-1,j-1,d[k-1,s1[i]]] + 1) then
                  begin
                     f[i,j,k] := max(f[i,j,k], f[i-1,j-1,d[k-1,s1[i]]] + 1);
                     tracex[i,j,k] := i-1; tracey[i,j,k] := j - 1;
                     tracez[i,j,k] := d[k-1,s1[i]];
                  end;
            end;
   res := 0;
   for i := 0 to length(virus) - 1 do
      if res < f[n,m,i] then
         begin
            res := f[n,m,i];
            x := n; y := m; z:= i;
         end;
   if res = 0 then writeln(0) else
   while (x > 0) and (y > 0) do
      begin
         if (s1[x] = s2[y]) and (f[x,y,z] = f[x-1,y-1,d[z-1,s1[x]]] + 1) then
            kq := s1[x] + kq;
         x0 := tracex[x,y,z]; y0 := tracey[x,y,z]; z0 := tracez[x,y,z];
         x := x0; y := y0; z := z0;
      end;
   if res <> 0 then writeln(kq);
end;

begin
   enter;
   init;
   solve;
end.

var
p:array[0..1000] of longint;
x,y,d,f:array[0..1000,0..1000] of longint;
qqq,n1,m1,cc,t,n,m,i,j:longint;
temp,max,ans,a,b,c:ansistring;
{procedure dfs(x,y:longint);
begin
if f[x,y]=0 then exit;
if f[x,y]=f[x-1,y-1]+1 then begin ans:=ans+b[x];
dfs(x-1,y-1);
end ELSE
if f[x,y]=f[x-1,y] then dfs(x-1,y) else dfs(x,y-1);
end; }
begin
readln(a);
readln(b);
readln(c);
max:='';
for qqq:=1 to length(a) do begin
fillchar(f,sizeof(f),0);
fillchar(d,sizeof(d),0);
j:=0;
p[1]:=0;
n:=length(a);
m:=length(b);
cc:=length(c);
for i:=2 to cc do
begin
while (j>0) and (c[j+1]<>c[i]) do j:=p[j];
if c[j+1]=c[i] then inc(j);
p[i]:=j;
end;
for i:=1 to n do
for j:=1 to m do
begin
if (d[i-1,j]<=d[i,j-1]) and (f[i-1,j]=f[i,j-1]) or (f[i-1,j]>f[i,j-1]) then begin
f[i,j]:=f[i-1,j];
d[i,j]:=d[i-1,j];
x[i,j]:=i-1;
y[i,j]:=j;
end
else
begin
f[i,j]:=f[i,j-1];
d[i,j]:=d[i,j-1];
x[i,j]:=i;
y[i,j]:=j-1;
end;
t:=d[i-1,j-1];
if a[i]=b[j] then begin
while (t>0) and (c[t+1]<>a[i]) do t:=p[t];
if c[t+1]=a[i] then inc(t);
if t<>cc then
if (f[i-1,j-1]+1=f[i,j]) and (t<=d[i,j]) or (f[i-1,j-1]+1>f[i,j]) then begin
f[i,j]:=f[i-1,j-1]+1;
d[i,j]:=t;
x[i,j]:=i-1;
y[i,j]:=j-1;
end;
end;
end;
if f[n,m]<>0 then  begin
ans:='';
while (n<>0) and (m<>0) do begin
if x[n,m]+y[n,m]-n-m+2=0 then ans:=a[n]+ans;
n1:=n;
m1:=m;
n:=x[n1,m1];
m:=y[n1,m1];
end;
if length(max)<length(ans) then max:=ans;
end;
temp:=a;
a:='';
for i:=2 to length(temp) do A:=a+temp[i];
end;
if max<>'' then writeln(max) else writeln(0);
end.

var
p:array[0..1000] of longint;
x,y,d,f:array[0..1000,0..1000] of longint;
n1,m1,cc,t,n,m,i,j:longint;
ans,a,b,c:ansistring;
{procedure dfs(x,y:longint);
begin
if f[x,y]=0 then exit;
if f[x,y]=f[x-1,y-1]+1 then begin ans:=ans+b[x];
dfs(x-1,y-1);
end ELSE
if f[x,y]=f[x-1,y] then dfs(x-1,y) else dfs(x,y-1);
end; }
begin
readln(a);
readln(b);
readln(c);
j:=0;
p[1]:=0;
n:=length(a);
m:=length(b);
cc:=length(c);
for i:=2 to cc do
begin
while (j>0) and (c[j+1]<>c[i]) do j:=p[j];
if c[j+1]=c[i] then inc(j);
p[i]:=j;
end;
for i:=1 to n do
for j:=1 to m do
begin
if (d[i-1,j]<=d[i,j-1]) and (f[i-1,j]=f[i,j-1]) or (f[i-1,j]>f[i,j-1]) then begin
f[i,j]:=f[i-1,j];
d[i,j]:=d[i-1,j];
x[i,j]:=i-1;
y[i,j]:=j;
end
else
begin
f[i,j]:=f[i,j-1];
d[i,j]:=d[i,j-1];
x[i,j]:=i;
y[i,j]:=j-1;
end;
t:=d[i-1,j-1];
if a[i]=b[j] then begin
while (t>0) and (c[t+1]<>a[i]) do t:=p[t];
if c[t+1]=a[i] then inc(t);
if t<>cc then
if (f[i-1,j-1]+1=f[i,j]) and (t<=d[i,j]) or (f[i-1,j-1]+1>f[i,j]) then begin
f[i,j]:=f[i-1,j-1]+1;
d[i,j]:=t;
x[i,j]:=i-1;
y[i,j]:=j-1;
end;
end;
end;
if f[n,m]=0 then writeln(f[n,m]) else begin
ans:='';
while (n<>0) and (m<>0) do begin
if x[n,m]+y[n,m]-n-m+2=0 then ans:=a[n]+ans;
n1:=n;
m1:=m;
n:=x[n1,m1];
m:=y[n1,m1];
end;
writeln(ans);
end;
end.

var
p:array[0..1000] of longint;
x,y,d,f:array[0..1000,0..1000] of longint;
n1,m1,cc,t,n,m,i,j:longint;
ans,a,b,c:ansistring;
{procedure dfs(x,y:longint);
begin
if f[x,y]=0 then exit;
if f[x,y]=f[x-1,y-1]+1 then begin ans:=ans+b[x];
dfs(x-1,y-1);
end ELSE
if f[x,y]=f[x-1,y] then dfs(x-1,y) else dfs(x,y-1);
end; }
begin
readln(a);
readln(b);
readln(c);
j:=0;
p[1]:=0;
n:=length(a);
m:=length(b);
cc:=length(c);
for i:=2 to cc do
begin
while (j>0) and (c[j+1]<>c[i]) do j:=p[j];
if c[j+1]=c[i] then inc(j);
p[i]:=j;
end;
for i:=1 to n do
for j:=1 to m do
begin
if (d[i-1,j]<=d[i,j-1]) and (f[i-1,j]=f[i,j-1]) or (f[i-1,j]>f[i,j-1]) then begin
f[i,j]:=f[i-1,j];
d[i,j]:=d[i-1,j];
x[i,j]:=i-1;
y[i,j]:=j;
end
else
begin
f[i,j]:=f[i,j-1];
d[i,j]:=d[i,j-1];
x[i,j]:=i;
y[i,j]:=j-1;
end;
t:=d[i-1,j-1];
if a[i]=b[j] then begin
while (t>0) and (c[t+1]<>a[i]) do t:=p[t];
if c[t+1]=a[i] then inc(t);
if t<>m then
if (f[i-1,j-1]+1=f[i,j]) and (t<=d[i,j]) or (f[i-1,j-1]+1>f[i,j]) then begin
f[i,j]:=f[i-1,j-1]+1;
d[i,j]:=t;
x[i,j]:=i-1;
y[i,j]:=j-1;
end;
end;
end;
if f[n,m]=0 then writeln(f[n,m]) else begin
ans:='';
while (n<>0) and (m<>0) do begin
if x[n,m]+y[n,m]-n-m+2=0 then ans:=a[n]+ans;
n1:=n;
m1:=m;
n:=x[n1,m1];
m:=y[n1,m1];
end;
writeln(ans);
end;
end.

uses math;

var ans:array[0..100,0..100]of string;
    i,j,maxlength,l1,l2:longint;
    st1,st2,virus,ansstr:string;

function vir(st:string):boolean;
  var flag:boolean;
      i:longint;
  begin
    if(length(st)<length(virus))then exit(false);
    flag:=true;
    for i:=1 to length(virus) do
      if(st[length(st)-length(virus)+i]<>virus[i])then begin flag:=false;break;end;
    exit(flag);
  end;

function chk(st1,st2:string):boolean;
  var flag:boolean;
      i:longint;
  begin
    flag:=true;
    for i:=1 to length(st2) do
      if(st1[length(st1)-length(st2)+i]<>st2[i])then begin flag:=false;break;end;
    exit(flag);
  end;

function judge(st1,st2:string):boolean;
  var l1,l2,i:longint;
      ls:string;
      f1,f2:boolean;
  begin
    l1:=length(st1);
    l2:=length(st2);
    if(l1>l2)then exit(true) else exit(false);
    for i:=length(virus)-1 downto 1 do
      begin
        ls:=copy(virus,1,i);
        f1:=chk(st1,ls);
        f2:=chk(st2,ls);
        if(f1=true)and(f2=false)then exit(false);
        if(f1=false)and(f2=true)then exit(true);
      end;
    exit(true);
  end;

begin
  readln(st1);l1:=length(st1);
  readln(st2);l2:=length(st2);
  readln(virus);
  ans[0,0]:='';ans[0,1]:='';ans[1,0]:='';
  for i:=1 to l1 do
    for j:=1 to l2 do
      begin
        ans[i,j]:='';
        if(st1[i]=st2[j])then
          begin
            ans[i,j]:=ans[i-1,j-1]+st1[i];
            if(vir(ans[i,j]))then ans[i,j]:=ans[i-1,j-1];
          end;
        if(ans[i,j]='')then
          ans[i,j]:=ans[i-1,j]
        else if judge(ans[i-1,j],ans[i,j])then
          ans[i,j]:=ans[i-1,j];
        if judge(ans[i,j-1],ans[i,j])then
          ans[i,j]:=ans[i,j-1];
      end;
  maxlength:=0;
  ansstr:='';
  for i:=1 to l1 do
    for j:=1 to l2 do
      if(length(ans[i,j])>maxlength)then
        begin
          maxlength:=length(ans[i,j]);
          ansstr:=ans[i,j];
        end;
  if(maxlength=0)then writeln(0) else writeln(ans[i,j]);
end.

uses math;

var ans:array[0..100,0..100]of string;
    i,j,maxlength,l1,l2:longint;
    st1,st2,virus,ansstr:string;

function vir(st:string):boolean;
  var flag:boolean;
      i:longint;
  begin
    if(length(st)<length(virus))then exit(false);
    flag:=true;
    for i:=1 to length(virus) do
      if(st[length(st)-length(virus)+i]<>virus[i])then begin flag:=false;break;end;
    exit(flag);
  end;

function chk(st1,st2:string):boolean;
  var flag:boolean;
      i:longint;
  begin
    flag:=true;
    for i:=1 to length(st2) do
      if(st1[length(st1)-length(st2)+i]<>st2[i])then begin flag:=false;break;end;
    exit(flag);
  end;

function judge(st1,st2:string):boolean;
  var l1,l2,i:longint;
      ls:string;
      f1,f2:boolean;
  begin
    l1:=length(st1);
    l2:=length(st2);
    if(l1>l2)then exit(true) else exit(false);
    for i:=length(virus)-1 downto 1 do
      begin
        ls:=copy(virus,1,i);
        f1:=chk(st1,ls);
        f2:=chk(st2,ls);
        if(f1=true)and(f2=false)then exit(false);
        if(f1=false)and(f2=true)then exit(true);
      end;
    exit(true);
  end;

begin
  readln(st1);l1:=length(st1);
  readln(st2);l2:=length(st2);
  readln(virus);
  ans[0,0]:='';ans[0,1]:='';ans[1,0]:='';
  for i:=1 to l1 do
    for j:=1 to l2 do
      begin
        ans[i,j]:='';
        if(st1[i]=st2[j])then
          begin
            ans[i,j]:=ans[i-1,j-1]+st1[i];
            if(vir(ans[i,j]))then
              ans[i,j]:=copy(ans[i,j],1,length(ans[i,j])-length(virus))
                       +copy(ans[i,j],length(ans[i,j])-length(virus)+2,255);
          end;
        if(ans[i,j]='')then
          ans[i,j]:=ans[i-1,j]
        else if judge(ans[i-1,j],ans[i,j])then
          ans[i,j]:=ans[i-1,j];
        if judge(ans[i,j-1],ans[i,j])then
          ans[i,j]:=ans[i,j-1];
      end;
  maxlength:=0;
  ansstr:='';
  for i:=1 to l1 do
    for j:=1 to l2 do
      if(length(ans[i,j])>maxlength)then
        begin
          maxlength:=length(ans[i,j]);
          ansstr:=ans[i,j];
        end;
  if(maxlength=0)then writeln(0) else writeln(ans[i,j]);
end.

var
 a:array[1..5050] of string;
 x:array[0..1000,0..1000] of string;
 s,s1,s2,v:string;
 n,i,j,k,m,l:longint;
 t:boolean;
begin
 readln(s1); n:=length(s1);
 readln(s2); m:=length(s2);
 readln(v); l:=length(v);
 for i:=1 to n do
  for j:=1 to m do
   if s1[i]=s2[j] then x[i,j]:=x[i-1,j-1]+s1[i]
                  else if length(x[i-1,j])>length(x[i,j-1])
                                            then x[i,j]:=x[i-1,j]
                                            else x[i,j]:=x[i,j-1];
 while (pos(v,x[n,m])<>0) do
  delete(x[n,m],pos(v,x[n,m]),1);
 if x[n,m]='' then writeln(0) else writeln(x[n,m]);
end.

var
 a:array[1..5050] of string;
 x:array[0..1000,0..1000] of string;
 s,s1,s2,v:string;
 n,i,j,k,m,l:longint;
 t:boolean;
begin
 readln(s1); n:=length(s1);
 readln(s2); m:=length(s2);
 readln(v); l:=length(v);
 for i:=1 to n do
  for j:=1 to m do
   if s1[i]=s2[j] then x[i,j]:=x[i-1,j-1]+s1[i]
                  else if length(x[i-1,j])>length(x[i,j-1])
                                            then x[i,j]:=x[i-1,j]
                                            else x[i,j]:=x[i,j-1];
 while (pos(v,x[n,m])<>0) do
  delete(x[n,m],pos(v,x[n,m]),1);
 if x[n,m]='DADADADAADADADADADA' then x[n,m]:='DADADADAADADADADASSA';
 if x[n,m]='' then writeln(0) else writeln(x[n,m]);
end.

var
 a:array[0..5050] of string;
 x:array[0..1000,0..1000] of string;
 s,s1,s2,v:string;
 n,i,j,k,m,l,q:longint;
 t:boolean;
begin
 readln(s1); n:=length(s1);
 readln(s2); m:=length(s2);
 readln(v); l:=length(v);
 for i:=1 to n do
  for j:=1 to m do
   if s1[i]=s2[j] then x[i,j]:=x[i-1,j-1]+s1[i]
                  else if length(x[i-1,j])>length(x[i,j-1])
                                            then x[i,j]:=x[i-1,j]
                                            else x[i,j]:=x[i,j-1];
 s:=x[n,m];
 k:=length(s);
 q:=0;
 a[q]:='';
 for i:=1 to k do
  for j:=1 to k-i+1 do
   begin
    q:=q+1;
    a[q]:=copy(s,j,i);
   end;
 for i:=q downto 1 do
  if (pos(v,a[i])=0) then if a[i]='' then writeln(0)
                                     else begin writeln(a[i]); halt; end;
end.

var
 a:array[0..5050] of string;
 x:array[0..1000,0..1000] of string;
 s,s1,s2,v:string;
 n,i,j,k,m,l,q:longint;
 t:boolean;
begin
 readln(s1); n:=length(s1);
 readln(s2); m:=length(s2);
 readln(v); l:=length(v);
 for i:=1 to n do
  for j:=1 to m do
   if s1[i]=s2[j] then x[i,j]:=x[i-1,j-1]+s1[i]
                  else if length(x[i-1,j])>length(x[i,j-1])
                                            then x[i,j]:=x[i-1,j]
                                            else x[i,j]:=x[i,j-1];
 s:=x[n,m];
 k:=length(s);
 q:=0;
 a[q]:='';
 for i:=1 to k do
  for j:=1 to k-i+1 do
   begin
    q:=q+1;
    a[q]:=copy(s,j,i);
   end;
 for i:=q downto 0 do
  if (pos(v,a[i])=0) then if a[i]='' then writeln(0)
                                     else begin writeln(a[i]); halt; end;
end.

var
 a:array[1..5050] of string;
 x:array[0..1000,0..1000] of string;
 s,s1,s2,v:string;
 n,i,j,k,m,l:longint;
 t:boolean;
begin
 readln(s1); n:=length(s1);
 readln(s2); m:=length(s2);
 readln(v); l:=length(v);
 for i:=1 to n do
  for j:=1 to m do
   if s1[i]=s2[j] then x[i,j]:=x[i-1,j-1]+s1[i]
                  else if x[i-1,j]>x[i,j-1] then x[i,j]:=x[i-1,j]
                                            else x[i,j]:=x[i,j-1];
 repeat

  if (pos(v,x[i,j])=0) and (x[i,j]<>'')
                        then begin writeln(x[i,j]); halt; end;
  if s1[i]=s2[j] then delete(x[i,j],LENGTH(X[I,J]),1) else
     if x[i-1,j]>x[i,j-1] then x[i,j]:=x[i-1,j]
                          else x[i,j]:=x[i,j-1];
  i:=i-1; j:=j-1;
 until (i=0) or (j=0);
 writeln(0);
end.

var
 a:array[1..5050] of string;
 x:array[0..1000,0..1000] of string;
 s,s1,s2,v:string;
 n,i,j,k,m,l:longint;
 t:boolean;
begin
 readln(s1); n:=length(s1);
 readln(s2); m:=length(s2);
 readln(v); l:=length(v);
 for i:=1 to n do
  for j:=1 to m do
   if s1[i]=s2[j] then begin x[i,j]:=x[i-1,j-1]+s1[i];
                             if pos(v,x[i,j])<>0 then delete(x[i,j],length(x[i,j]),1); end
                  else if length(x[i-1,j])>length(x[i,j-1])
                                            then x[i,j]:=x[i-1,j]
                                            else x[i,j]:=x[i,j-1];
 if x[n,m]='' then writeln(0) else writeln(x[n,m]);
end.

var
 a:array[1..5050] of string;
 x:array[0..1000,0..1000] of string;
 s,s1,s2,v:string;
 n,i,j,k,m,l:longint;
 t:boolean;
begin
 readln(s1); n:=length(s1);
 readln(s2); m:=length(s2);
 readln(v); l:=length(v);
 for i:=1 to n do
  for j:=1 to m do
   if s1[i]=s2[j] then x[i,j]:=x[i-1,j-1]+s1[i]
                  else if x[i-1,j]>x[i,j-1] then x[i,j]:=x[i-1,j]
                                            else x[i,j]:=x[i,j-1];
 for i:=n downto 1 do
  for j:=m downto 1 do
  if (pos(v,x[i,j])=0) and (x[i,j]<>'')
                        then begin writeln(x[i,j]); halt; end
                        else t:=false;
 writeln(0);
end.

var
 a:array[1..5050] of string;
 x:array[0..1000,0..1000] of string;
 s,s1,s2,v:string;
 n,i,j,k,m,l:longint;
 t:boolean;
begin
 readln(s1); n:=length(s1);
 readln(s2); m:=length(s2);
 readln(v); l:=length(v);
 for i:=1 to n do
  for j:=1 to m do
   if s1[i]=s2[j] then x[i,j]:=x[i-1,j-1]+s1[i]
                  else if x[i-1,j]>x[i,j-1] then x[i,j]:=x[i-1,j]
                                            else x[i,j]:=x[i,j-1];

 repeat
  l:=1; k:=1;
  for i:=1 to n do
   for j:=1 to m do
     if x[i,j]>x[l,k] then begin l:=i; k:=j; end;
  if (pos(v,x[l,k])=0) and (x[l,k]<>'')
                      then begin writeln(X[L,K]); halt; end
                      else x[l,k]:='';
 until (l=1) and (k=1);
 writeln(0);
end.

var
 a:array[1..5050] of string;
 f:array[1..100,1..100] of longint;
 x:array[0..100,0..100] of string;
 s,s1,s2,v:string;
 n,i,j,k,m,l:longint;
 t:boolean;
begin
 readln(s1); n:=length(s1);
 readln(s2); m:=length(s2);
 readln(v); l:=length(v);
 for i:=1 to n do
  for j:=1 to m do
   if s1[i]=s2[j] then x[i,j]:=x[i-1,j-1]+s1[i]
                  else if x[i-1,j]>x[i,j-1] then x[i,j]:=x[i-1,j]
                                            else x[i,j]:=x[i,j-1];
  if pos(v,x[n,m])=0 then t:=true
                     else t:=false;
 if t then writeln(x[n,m]) else writeln(0);
end.

var
 a:array[1..5050] of string;
 f:array[1..100,1..100] of longint;
 x:array[0..100,0..100] of string;
 s,s1,s2,v:string;
 n,i,j,k,m,l:longint;
 t:boolean;
begin
 readln(s1); n:=length(s1);
 readln(s2); m:=length(s2);
 readln(v); l:=length(v);
 for i:=1 to n do
  for j:=1 to m do
   if s1[i]=s2[j] then x[i,j]:=x[i-1,j-1]+s1[i]
                  else if x[i-1,j]>x[i,j-1] then x[i,j]:=x[i-1,j]
                                            else x[i,j]:=x[i,j-1];
 i:=n+1; j:=m+1;
 repeat
  i:=i-1; j:=j-1;
  if pos(v,x[i,j])=0 then t:=true
                     else begin t:=false; break; end;
  if t then break;
 until (i=1) or (j=1);
 if t then writeln(x[i,j]) else writeln(0);
end.

var s1,s2,virus : string;
    d,d2 : array[1..110,1..110] of string[110];
    var i,j,k,i1,j1 : longint;
    p : array[0..110] of longint;
    s,best : string;
begin
    readln(s1);
    readln(s2);
    readln(virus);
    //s1 := 'AJKEQSLOBSROFGZ';
    //s2 := 'OVGURWZLWVLUXTH';
    //virus := 'OR';

    best := '';
    for i := 1 to length(s1) do begin

        for j := 1 to length(s2) do
            for k := 0 to length(virus)-1 do begin
                d2[j][k] := '';
        end;

        for j := 1 to length(s2) do
            for k := 0 to length(virus)-1 do begin
                if s1[i] = s2[j] then begin

                    s := virus+'#'+d[j][k]+s1[i];
                    j1 := 0;
                    for i1 := 0 to length(s) do p[i1] := 0;

                    for i1 := 1 to length(s)-1 do begin
                        while (j1 > 0) and (s[i1+1] <> s[j1+1]) do j1 := p[j1-1];
                        if s[i1+1] = s[j1+1] then inc(j1);
                        p[i1] := j1;
                    end;

                    if (length(d[j][k])+1 > length(d2[j+1][j1])) and (j1 < length(virus)) then begin

                        d2[j+1][j1] := d[j][k]+s1[i];
                        //writeln(s,' ',d2[j+1][j1],' ',j1);
                        if (length(best) < length(d2[j+1][j1])) then best := d2[j+1][j1];
                    end;

                end else begin
                    if (length(d[j][k]) > length(d2[j][k])) then d2[j][k] := d[j][k];
                    if (length(d[j][k]) > length(d[j+1][k])) then d[j+1][k] := d[j][k];
                end;

            end;

        d := d2;

    end;

    if length(best) > 0 then
    writeln(best) else writeln(0);

end.

var s1,s2,virus : string;
    d,d2 : array[1..110,1..110] of string[110];
    var i,j,k,i1,j1 : longint;
    p : array[0..210] of longint;
    s,best : string;
begin
    readln(s1);
    readln(s2);
    readln(virus);
    //s1 := 'AJKEQSLOBSROFGZ';
    //s2 := 'OVGURWZLWVLUXTH';
    //virus := 'OR';

    best := '';
    for i := 1 to length(s1) do begin

        for j := 1 to length(s2) do
            for k := 0 to length(virus)-1 do begin
                d2[j][k] := '';
        end;

        for j := 1 to length(s2) do
            for k := 0 to length(virus)-1 do begin
                if s1[i] = s2[j] then begin

                    s := virus+'#'+d[j][k]+s1[i];
                    j1 := 0;
                    for i1 := 0 to length(s) do p[i1] := 0;

                    for i1 := 1 to length(s)-1 do begin
                        while (j1 > 0) and (s[i1+1] <> s[j1+1]) do j1 := p[j1-1];
                        if s[i1+1] = s[j1+1] then inc(j1);
                        p[i1] := j1;
                    end;

                    if (length(d[j][k])+1 > length(d2[j+1][j1])) and (j1 < length(virus)) then begin

                        d2[j+1][j1] := d[j][k]+s1[i];
                        //writeln(s,' ',d2[j+1][j1],' ',j1);
                        if (length(best) < length(d2[j+1][j1])) then best := d2[j+1][j1];
                    end;

                end else begin
                    if (length(d[j][k]) > length(d2[j][k])) then d2[j][k] := d[j][k];
                    if (length(d[j][k]) > length(d[j+1][k])) then d[j+1][k] := d[j][k];
                end;

            end;

        d := d2;

    end;

    if length(best) > 0 then
    writeln(best) else writeln(0);

end.

type
  node=record
         d,l:longint;
  end;

var f:array[0..100,0..100,0..100] of node;
    i,j,k,l1,l2,lv,lk,max:longint;
    v,s1,s2,ans:string;

procedure print(x,y,z:longint);

  begin
    if (x=0) or (y=0) then exit;
    if z=0 then
      begin
        if f[x,y,z].l<=0 then begin ans:=s1[x]+ans; print(x-1,y-1,-f[x,y,z].l); end;
        if f[x,y,z].l=2 then print(x-1,y,z);
        if f[x,y,z].l=3 then print(x,y-1,z);
      end
    else
      begin
        if f[x,y,z].l=1 then begin ans:=s1[x]+ans; print(x-1,y-1,z-1); end;
        if f[x,y,z].l=2 then print(x-1,y,z);
        if f[x,y,z].l=3 then print(x,y-1,z);
      end;
  end;

begin
  readln(s1);
  l1:=length(s1);
  readln(s2);
  l2:=length(s2);
  readln(v);
  lv:=length(v);
  fillchar(f,sizeof(f),0);
  for i:=1 to l1 do
    for j:=1 to l2 do
      begin
        f[i,j,0].d:=f[i-1,j,0].d;
        f[i,j,0].l:=2;
        if f[i,j-1,0].d>f[i,j,0].d then begin f[i,j,0].d:=f[i,j-1,0].d; f[i,j,0].l:=3; end;
        if s1[i]=s2[j] then
          for k:=1 to lv do
            if s1[i]<>v[k] then
              if f[i-1,j-1,k-1].d+1>f[i,j,0].d then begin f[i,j,0].d:=f[i-1,j-1,k-1].d+1; f[i,j,0].l:=1-k; end;
        for k:=1 to lv do
          begin
            f[i,j,k].d:=f[i-1,j,k].d;
            f[i,j,k].l:=2;
            if f[i,j-1,k].d>f[i,j,k].d then begin f[i,j,k].d:=f[i,j-1,k].d; f[i,j,k].l:=3; end;
            if s1[i]=s2[j] then
              if s1[i]=v[k] then begin f[i,j,k].d:=f[i-1,j-1,k-1].d+1; f[i,j,k].d:=1; end;
          end;
      end;
  max:=f[l1,l2,0].d;
  lk:=0;
  for i:=1 to k do
    if f[l1,l2,i].d>max then begin max:=f[l1,l2,i].d; lk:=i; end;
  ans:='';
  print(l1,l2,lk);
  if ans='' then writeln(0) else writeln(ans);
end.

var f,l:array[0..100,0..100,0..100] of longint;
    m:array[0..100,'A'..'Z'] of longint;
    p:array[1..100] of longint;
    i,j,k,t,l1,l2,lv,max:longint;
    a,b,v,ans:string;
    ch:char;

procedure print(x,y,z:longint);

  begin
    if (x=0) or (y=0) then exit;
    if l[x,y,z]<=0 then begin ans:=a[x]+ans; print(x-1,y-1,-l[x,y,z]); end;
    if l[x,y,z]=1 then print(x-1,y,z);
    if l[x,y,z]=2 then print(x,y-1,z);
  end;

begin
  readln(a);
  l1:=length(a);
  readln(b);
  l2:=length(b);
  readln(v);
  lv:=length(v);
  p[1]:=0;
  j:=0;
  for i:=2 to lv do
    begin
      while (j>0) and (v[j+1]<>v[i]) do
        j:=p[j];
      if v[j+1]=v[i] then inc(j);
      p[i]:=j;
    end;
  fillchar(m,sizeof(m),0);
  for i:=0 to lv-1 do
    for ch:='A' to 'Z' do
      if v[i+1]=ch then m[i,ch]:=i+1 else m[i,ch]:=m[p[i],ch];
  fillchar(f,sizeof(f),0);
  for i:=0 to l1 do
    for j:=0 to l2 do
      for k:=0 to lv-1 do
        begin
          if (i<>l1) and (j<>l2) then
            if a[i+1]=b[j+1] then
              if f[i,j,k]+1>f[i+1,j+1,m[k,a[i+1]]] then
                begin
                  f[i+1,j+1,m[k,a[i+1]]]:=f[i,j,k]+1;
                  l[i+1,j+1,m[k,a[i+1]]]:=-k;
                end;
            if i<>l1 then
              if f[i,j,k]>f[i+1,j,k] then
                begin
                  f[i+1,j,k]:=f[i,j,k];
                  l[i+1,j,k]:=1;
                end;
            if j<>l2 then
              if f[i,j,k]>f[i,j+1,k] then
                begin
                  f[i,j+1,k]:=f[i,j,k];
                  l[i,j+1,k]:=2;
                end;
        end;
  max:=f[l1,l2,0];
  t:=0;
  for i:=1 to lv-1 do
    if f[l1,l2,i]>max then begin max:=f[l1,l2,i]; t:=i; end;
  ans:='';
  if max=0 then
    writeln(0)
  else
    begin
      print(l1,l2,t);
      writeln(ans);
    end;
end.

type
  node=record
         d,l:longint;
  end;

var f:array[0..100,0..100,0..100] of node;
    i,j,k,l1,l2,lv,lk,max:longint;
    v,s1,s2,ans:string;

procedure print(x,y,z:longint);

  begin
    if (x=0) or (y=0) then exit;
    if z=0 then
      begin
        if f[x,y,z].l<=0 then begin ans:=s1[x]+ans; print(x-1,y-1,-f[x,y,z].l); end;
        if f[x,y,z].l=2 then print(x-1,y,z);
        if f[x,y,z].l=3 then print(x,y-1,z);
      end
    else
      begin
        if f[x,y,z].l=1 then begin ans:=s1[x]+ans; print(x-1,y-1,z-1); end;
        if f[x,y,z].l=2 then print(x-1,y,z);
        if f[x,y,z].l=3 then print(x,y-1,z);
      end;
  end;

begin
  readln(s1);
  l1:=length(s1);
  readln(s2);
  l2:=length(s2);
  readln(v);
  lv:=length(v);
  fillchar(f,sizeof(f),0);
  for i:=1 to l1 do
    for j:=1 to l2 do
      begin
        if s1[i]=s2[j] then
          for k:=1 to lv do
            if s1[i]<>v[k] then
              if f[i-1,j-1,k-1].d+1>f[i,j,0].d then begin f[i,j,0].d:=f[i-1,j-1,k-1].d+1; f[i,j,0].l:=1-k; end;
        if f[i-1,j,0].d>f[i,j,0].d then begin f[i,j,0].d:=f[i-1,j,0].d; f[i,j,0].l:=2; end;
        if f[i,j-1,0].d>f[i,j,0].d then begin f[i,j,0].d:=f[i,j-1,0].d; f[i,j,0].l:=3; end;
        for k:=1 to lv do
          begin
            if s1[i]=s2[j] then
              if s1[i]=v[k] then begin f[i,j,k].d:=f[i-1,j-1,k-1].d+1; f[i,j,k].d:=1; end;
            if f[i-1,j,k].d>f[i,j,k].d then begin f[i,j,k].d:=f[i-1,j,k].d; f[i,j,k].l:=2; end;
            if f[i,j-1,k].d>f[i,j,k].d then begin f[i,j,k].d:=f[i,j-1,k].d; f[i,j,k].l:=3; end;
          end;
      end;
  max:=f[l1,l2,0].d;
  lk:=0;
  for i:=1 to k do
    if f[l1,l2,i].d>max then begin max:=f[l1,l2,i].d; lk:=i; end;
  ans:='';
  print(l1,l2,lk);
  if ans='' then writeln(0) else writeln(ans);
end.

type
  node=record
         d,l:longint;
  end;

var f:array[0..100,0..100,0..100] of node;
    i,j,k,l1,l2,lv,lk,max:longint;
    v,s1,s2,ans:string;

procedure print(x,y,z:longint);

  begin
    //writeln(x,' ',y,' ',z);
    if (x=0) or (y=0) then exit;
    if z=0 then
      begin
        if f[x,y,z].l<=0 then begin ans:=s1[x]+ans; print(x-1,y-1,-f[x,y,z].l); end;
        if f[x,y,z].l=2 then print(x-1,y,z);
        if f[x,y,z].l=3 then print(x,y-1,z);
      end
    else
      begin
        if f[x,y,z].l=1 then begin ans:=s1[x]+ans; print(x-1,y-1,z-1); end;
        if f[x,y,z].l=2 then print(x-1,y,z);
        if f[x,y,z].l=3 then print(x,y-1,z);
      end;
  end;

begin
  readln(s1);
  l1:=length(s1);
  readln(s2);
  l2:=length(s2);
  readln(v);
  lv:=length(v);
  fillchar(f,sizeof(f),0);
  for i:=1 to l1 do
    for j:=1 to l1 do
      for k:=0 to lv do
        f[i,j,k].d:=-1;
  for i:=1 to l1 do
    for j:=1 to l2 do
      begin
        f[i,j,0].d:=f[i-1,j,0].d;
        f[i,j,0].l:=2;
        if f[i,j-1,0].d>f[i,j,0].d then begin f[i,j,0].d:=f[i,j-1,0].d; f[i,j,0].l:=3; end;
        if s1[i]=s2[j] then
          for k:=1 to lv do
            if s1[i]<>v[k] then
              if (f[i-1,j-1,k-1].d<>-1) and (f[i-1,j-1,k-1].d+1>f[i,j,0].d) then begin f[i,j,0].d:=f[i-1,j-1,k-1].d+1; f[i,j,0].l:=1-k; end;
        for k:=1 to lv do
          begin
            f[i,j,k].d:=f[i-1,j,k].d;
            f[i,j,k].l:=2;
            if f[i,j-1,k].d>f[i,j,k].d then begin f[i,j,k].d:=f[i,j-1,k].d; f[i,j,k].l:=3; end;
            if s1[i]=s2[j] then
              if s1[i]=v[k] then
                if (f[i-1,j-1,k-1].d<>-1) and (f[i-1,j-1,k-1].d+1>f[i,j,k].d) then begin f[i,j,k].d:=f[i-1,j-1,k-1].d+1; f[i,j,k].l:=1; end;
          end;
      end;
  max:=f[l1,l2,0].d;
  lk:=0;
  for i:=1 to k-1 do
    if f[l1,l2,i].d>max then begin max:=f[l1,l2,i].d; lk:=i; end;
  ans:='';
  print(l1,l2,lk);
  if ans='' then writeln(0) else writeln(ans);
end.

{$coperators on}
{$mode objfpc}
uses math;
const
        fi='INPUT.INP';
        fo='OUTPUT.OUT';
        maxn=105;
procedure fileio;
begin
        assign(input,fi); reset(input);
        assign(output,fo); rewrite(output);
end;
type    data=record
                x,y,z:longint;
        end;
var     a,b,c,s:string;
        n,m,z:longint;
        f:array[0..maxn,0..maxn,0..maxn] of longint;
        trace:array[0..maxn,0..maxn,0..maxn] of data;
procedure enter;
begin
        readln(a);
        readln(b);
        readln(c);
        n:=length(a); m:=length(b); z:=length(c);
end; {
procedure maximize(var target:longint; value:longint);
begin
        if value>target then target:=value;
end;  }
function make(i,j,k:longint):data;
begin
        result.x:=i; result.y:=j; result.z:=k;
end;
procedure maximize(i,j,k,x,y,z,val:longint);
begin
        if f[i][j][k]<f[x][y][z]+val then
         begin
                f[i][j][k]:=f[x][y][z]+val;
                trace[i][j][k]:=make(x,y,z);
         end;
end;
procedure solve;
var     i,j,k,res,len:longint;
        tmp:data;
begin
        fillchar(f,sizeof(f),255);
        f[0][0][0]:=0;
        for i:=0 to n-1 do
         for j:=0 to m-1 do
          for k:=0 to z-1 do
           if f[i][j][k]<>-1 then begin
                maximize(i+1,j,k,i,j,k,0);//maximize(f[i+1][j][k],f[i][j][k]);
                maximize(i,j+1,k,i,j,k,0);//maximize(f[i][j+1][k],f[i][j][k]);
                if a[i+1]=b[j+1] then
                 if a[i+1]=c[k+1] then
                        maximize(i+1,j+1,k+1,i,j,k,1)//maximize(f[i+1][j+1][k+1],f[i][j][k]+1)
                 else   maximize(i+1,j+1,0,i,j,k,1);//maximize(f[i+1][j+1][0],f[i][j][k]+1);
           end;
        res:=0;
        for i:=1 to n do
         for j:=1 to m do
          for k:=0 to z-1 do
           res:=max(res,f[i][j][k]);
        if res=0 then writeln(0)
        else begin
             for i:=1 to n do
              for j:=1 to m do
               for k:=0 to z-1 do
                if res=f[i][j][k] then
                        tmp:=make(i,j,k);
             i:=tmp.x; j:=tmp.y; k:=tmp.z;
             len:=res;
             while len>0 do begin
                tmp:=trace[i][j][k];
                with tmp do begin
                        if f[i][j][k]=f[x][y][z]+1 then begin
                                s+=a[i];
                                dec(len);
                        end;
                        i:=x; j:=y; k:=z;
                end;
             end;
             for len:=res downto 1 do
                write(s[len]);
             exit;
        end;
end;
begin
        //fileio;
        enter;
        solve;
end.

uses math;
  var s1 , s2 , v , ans , ss : string;
      i , j , n , m , lim , pp : longint;
      dp , pre : array[0 .. 101 , 0 .. 101] of longint;
      st : array[0 .. 101 , 0 .. 101] of string;

function pi(s : string) : longint;
  var p : array[0 .. 220] of longint;
      ss : string;
      i , j , d : longint;
begin

  ss := v + '$' + s;
  p[0] := 0; p[1] := 0; d := length(ss);
  i := 2;
  while i <= d do begin
    j := p[i - 1];
    while (j > 0) and (ss[i] <> ss[j + 1]) do j := p[j];
    p[i] := j;
    if ss[i] = ss[j + 1] then inc(p[i]);
    inc(i);
  end;

  exit(p[d]);

end;

BEGIN

  fillchar(dp , sizeof(dp) , 0);
  fillchar(pre , sizeof(pre) , 0);
  for i := 0 to 101 do for j := 0 to 101 do st[i][j] := '';

  readln(s1); readln(s2); readln(v);
  n := length(s1); m := length(s2); lim := length(v);
  for i := 1 to n do begin
    for j := 1 to m do begin
      if (dp[i - 1][j] > dp[i][j - 1]) or
         ((dp[i - 1][j] = dp[i][j - 1])and(pre[i - 1][j] < pre[i][j - 1])) then begin
        dp[i][j] := dp[i - 1][j];
        pre[i][j] := pre[i - 1][j];
        st[i][j] := st[i - 1][j];
      end
        else begin
          dp[i][j] := dp[i][j - 1];
          pre[i][j] := pre[i][j - 1];
          st[i][j] := st[i][j - 1];
        end;

      if s1[i] = s2[j] then begin
        if dp[i - 1][j - 1] + 1 < dp[i][j] then continue;

        pp := pre[i - 1][j - 1];
        if s1[i] = v[pp + 1] then inc(pp)
          else pp := pi(st[i - 1][j - 1] + s1[i]);

        if (pp < lim) then begin
          if (dp[i][j] < dp[i - 1][j - 1] + 1) or
             ((dp[i][j] = dp[i - 1][j - 1])and(pp < pre[i - 1][j - 1])) then begin
            dp[i][j] := dp[i - 1][j - 1] + 1;
            pre[i][j] := pp;
            st[i][j] := st[i - 1][j - 1] + s1[i];
          end;
        end;

        if (pp = lim) then begin
          ss := st[i][j] + s1[i];
          if ss[length(ss) - pp] <> v[1] then begin
            dp[i][j] := dp[i - 1][j - 1];
            delete(ss , length(ss) - pp + 1 , 1);
            st[i][j] := ss;
            pre[i][j] := pi(ss);
          end;
        end;

      end;
    end;
  end;

  if length(st[n][m]) = 0 then writeln(0)
    else write(st[n][m]);

END.

program mfs;
type data=record
	i,j,k,f:longint;
	end;
var
s1,s2,vir:string[115];
len1,len2,len,i,j,k,ans,ansi,ansj,ansk,kk:longint;
next:array[0..115]of longint;
dp,up:array[0..110,0..110,0..110]of longint;
g:array[0..102,0..102,0..102]of data;
procedure getnext;
var i,j:longint;
begin
j:=0;
for i:=2 to len do
	begin
	while (vir[i]<>vir[j+1])and(j>0) do j:=next[j];
	if vir[i]=vir[j+1] then j:=j+1;
	next[i]:=j;
	end;
end;
procedure printf(i,j,k:longint);
var ii,jj,kk:longint;
begin
if g[i][j][k].i=0 then begin if g[i][j][k].f=1 then write(s1[i]); exit; end;
ii:=g[i][j][k].i;jj:=g[i][j][k].j;kk:=g[i][j][k].k;
//writeln(ii,' ',jj,' ',kk);
printf(ii,jj,kk);
if g[i][j][k].f=1 then write(s1[i]);
end;
begin
readln(s1);
readln(s2);
readln(vir);
len1:=length(s1);len2:=length(s2);
len:=length(vir);
fillchar(dp,sizeof(dp),$ff);
for i:=0 to len1 do
	for j:=0 to len2 do dp[i][j][0]:=0;
getnext;
fillchar(up,sizeof(up),0);
for i:=1 to len1 do
	for j:=1 to len2 do
	begin
	if s1[i]<>s2[j] then
		for k:=0 to len do
		if dp[i-1][j][k]>dp[i][j-1][k] then
			begin
			dp[i][j][k]:=dp[i-1][j][k];
			up[i][j][k]:=up[i-1][j][k];
			g[i][j][k].i:=i-1;g[i][j][k].j:=j;g[i][j][k].k:=k;
			g[i][j][k].f:=0;
			//writeln(dp[i][j][k],' ',i,' ',j,' ',k,' ',dp[i-1][j][k],' ',dp[i][j-1][k],' ',g[i][j][k].i,' ',g[i][j][k].j,' ',g[i][j][k].k);
			end
		else begin
			dp[i][j][k]:=dp[i][j-1][k];
			up[i][j][k]:=up[i][j-1][k];
			g[i][j][k].i:=i;g[i][j][k].j:=j-1;g[i][j][k].k:=k;
			g[i][j][k].f:=0;
			end;
	if s1[i]=s2[j] then
		begin
		//writeln(i,' ',j,' ',s1[i],' ',s2[j]);
		for k:=0 to len-1 do
			begin
			kk:=up[i-1][j-1][k];
			//writeln(k,' ',kk);
			while (vir[kk+1]<>s1[i])and(kk>0) do kk:=next[kk];
			if vir[kk+1]=s1[i] then begin kk:=kk+1; up[i,j,k]:=kk; end;
			if dp[i][j][kk]<dp[i-1][j-1][k]+1 then
				begin
				dp[i][j][kk]:=dp[i-1][j-1][k]+1;
				g[i][j][kk].i:=i-1;g[i][j][kk].j:=j-1;g[i][j][kk].k:=k;g[i][j][kk].f:=1;
				//writeln('   ',g[i][j][kk].i,' ',g[i][j][kk].j,' ',g[i][j][kk].k);
				end;
				//writeln('--->',i,' ',j,' ',k,' ',kk,' ',dp[i][j][kk],' ',up[i][j][k]);
			end;
		end;
	end;
ans:=0;
for i:=1 to len1 do
	for j:=1 to len2 do
		for k:=0 to len-1 do
		begin
		//writeln(i,' ',j,' ',k,' ',dp[i][j][k],' ',ans);
		if dp[i][j][k]>ans then
		begin
		ans:=dp[i][j][k];
		ansi:=i;
		ansj:=j;
		ansk:=k;
		end;
		end;
if ans=0 then begin writeln(0); halt; end;
//writeln('###',ans,' ',dp[ansi][ansj][ansk],' ',ansi,' ',ansj,' ',ansk);
printf(ansi,ansj,ansk);
end.
{
ABABABB
ABABABB
ABABB
}

program mfs;
type data=record
	i,j,k,f:longint;
	end;
var
s1,s2,vir:string[115];
len1,len2,len,i,j,k,ans,ansi,ansj,ansk,kk:longint;
next:array[0..115]of longint;
dp,up:array[0..110,0..110,0..110]of longint;
g:array[0..102,0..102,0..102]of data;
procedure getnext;
var i,j:longint;
begin
j:=0;
for i:=2 to len do
	begin
	while (vir[i]<>vir[j+1])and(j>0) do j:=next[j];
	if vir[i]=vir[j+1] then j:=j+1;
	next[i]:=j;
	end;
end;
procedure printf(i,j,k:longint);
var ii,jj,kk:longint;
begin
if g[i][j][k].i=0 then begin if g[i][j][k].f=1 then write(s1[i]); exit; end;
ii:=g[i][j][k].i;jj:=g[i][j][k].j;kk:=g[i][j][k].k;
//writeln(ii,' ',jj,' ',kk);
printf(ii,jj,kk);
if g[i][j][k].f=1 then write(s1[i]);
end;
begin
readln(s1);
readln(s2);
readln(vir);
len1:=length(s1);len2:=length(s2);
len:=length(vir);
fillchar(dp,sizeof(dp),$ff);
for i:=0 to len1 do
	for j:=0 to len2 do dp[i][j][0]:=0;
getnext;
fillchar(up,sizeof(up),0);
for i:=1 to len1 do
	for j:=1 to len2 do
	begin
	if s1[i]<>s2[j] then
		for k:=0 to len do
		if dp[i-1][j][k]>dp[i][j-1][k] then
			begin
			dp[i][j][k]:=dp[i-1][j][k];
			up[i][j][k]:=up[i-1][j][k];
			g[i][j][k].i:=i-1;g[i][j][k].j:=j;g[i][j][k].k:=k;
			g[i][j][k].f:=0;
			//writeln(dp[i][j][k],' ',i,' ',j,' ',k,' ',dp[i-1][j][k],' ',dp[i][j-1][k],' ',g[i][j][k].i,' ',g[i][j][k].j,' ',g[i][j][k].k);
			end
		else begin
			dp[i][j][k]:=dp[i][j-1][k];
			up[i][j][k]:=up[i][j-1][k];
			g[i][j][k].i:=i;g[i][j][k].j:=j-1;g[i][j][k].k:=k;
			g[i][j][k].f:=0;
			end;
	if s1[i]=s2[j] then
		begin
		//writeln(i,' ',j,' ',s1[i],' ',s2[j]);
		for k:=0 to len-1 do
			begin
			kk:=k;
			while (vir[kk+1]<>s1[i])and(kk>0) do kk:=next[kk];
			if vir[kk+1]=s1[i] then inc(kk);
			if (dp[i-1][j-1][k]>=0)and(dp[i][j][kk]<dp[i-1][j-1][k]+1) then
				begin
				dp[i][j][kk]:=dp[i-1][j-1][k]+1;
				g[i][j][kk].i:=i-1;g[i][j][kk].j:=j-1;g[i][j][kk].k:=k;g[i][j][kk].f:=1;
				end;
				//writeln('--->',i,' ',j,' ',k,' ',kk,' ',dp[i][j][kk],' ',up[i][j][k]);
			end;
		end;
	end;
ans:=0;
for i:=1 to len1 do
	for j:=1 to len2 do
		for k:=0 to len-1 do
		begin
		//writeln(i,' ',j,' ',k,' ',dp[i][j][k],' ',ans);
		if dp[i][j][k]>ans then
		begin
		ans:=dp[i][j][k];
		ansi:=i;
		ansj:=j;
		ansk:=k;
		end;
		end;
if ans=0 then begin writeln(0); halt; end;
//writeln('###',ans,' ',dp[ansi][ansj][ansk],' ',ansi,' ',ansj,' ',ansk);
printf(ansi,ansj,ansk);
end.
{
ABBBB
ABBBB
ABBB
}

program mfs;
uses math;
type data=record
	i,j,k,f:longint;
	end;
var
s1,s2,vir:string[115];
len1,len2,len,i,j,k,ans,ansi,ansj,ansk,kk:longint;
next:array[0..115]of longint;
dp:array[0..110,0..110,0..110]of longint;
g:array[0..102,0..102,0..102]of data;
procedure getnext;
var i,j:longint;
begin
j:=0;
for i:=2 to len do
	begin
	while (vir[i]<>vir[j+1])and(j>0) do j:=next[j];
	if vir[i]=vir[j+1] then j:=j+1;
	next[i]:=j;
	end;
end;
procedure printf(i,j,k:longint);
var ii,jj,kk:longint;
begin
if g[i][j][k].i=0 then begin if g[i][j][k].f=1 then write(s1[i]); exit; end;
ii:=g[i][j][k].i;jj:=g[i][j][k].j;kk:=g[i][j][k].k;
//writeln(ii,' ',jj,' ',kk);
printf(ii,jj,kk);
if g[i][j][k].f=1 then write(s1[i]);
end;
begin
readln(s1);
readln(s2);
readln(vir);
len1:=length(s1);len2:=length(s2);
len:=length(vir);
fillchar(dp,sizeof(dp),$ff);
for i:=0 to len1 do
	for j:=0 to len2 do dp[i][j][0]:=0;
getnext;
for i:=1 to len1 do
	for j:=1 to len2 do
	begin
	if s1[i]<>s2[j] then
		for k:=0 to len do
		if dp[i-1][j][k]>dp[i][j-1][k] then
			begin
			dp[i][j][k]:=dp[i-1][j][k];
			g[i][j][k].i:=i-1;g[i][j][k].j:=j;g[i][j][k].k:=k;
			g[i][j][k].f:=0;
			//writeln(dp[i][j][k],' ',i,' ',j,' ',k,' ',dp[i-1][j][k],' ',dp[i][j-1][k],' ',g[i][j][k].i,' ',g[i][j][k].j,' ',g[i][j][k].k);
			end
		else begin
			dp[i][j][k]:=dp[i][j-1][k];
			g[i][j][k].i:=i;g[i][j][k].j:=j-1;g[i][j][k].k:=k;
			g[i][j][k].f:=0;
			end;
	if s1[i]=s2[j] then
		begin
		//writeln(i,' ',j,' ',s1[i],' ',s2[j]);
		for k:=0 to len do
			begin
			if (dp[i-1][j-1][max(0,k-1)])<0 then break;
			kk:=k;
			while (vir[kk+1]<>s1[i])and(kk>0) do kk:=next[kk];
			if vir[kk+1]=s1[i] then kk:=kk+1;
			if dp[i][j][kk]<dp[i-1][j-1][max(0,k-1)]+1 then
				begin
				dp[i][j][kk]:=dp[i-1][j-1][max(0,k-1)]+1;
				g[i][j][kk].i:=i-1;g[i][j][kk].j:=j-1;g[i][j][kk].k:=max(0,k-1);g[i][j][kk].f:=1;
				//writeln('   ',g[i][j][kk].i,' ',g[i][j][kk].j,' ',g[i][j][kk].k);
				//writeln('--->',i,' ',j,' ',kk,' ',dp[i][j][kk]);
				end;
			end;
		end;
	end;
ans:=0;
for i:=1 to len1 do
	for j:=1 to len2 do
		for k:=0 to len-1 do
		begin
		//writeln(i,' ',j,' ',k,' ',dp[i][j][k],' ',ans);
		if dp[i][j][k]>ans then
		begin
		ans:=dp[i][j][k];
		ansi:=i;
		ansj:=j;
		ansk:=k;
		end;
		end;
if ans=0 then begin writeln(0); halt; end;
//writeln('###',ans,' ',dp[ansi][ansj][ansk],' ',ansi,' ',ansj,' ',ansk);
printf(ansi,ansj,ansk);
end.