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.

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 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.

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.

{$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.

//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.

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.

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.