(* Parameters *)
sigma = 0.25; r = 0.2; T = 1; K = 10;

(* Pay-off *)
f[x_]:=If[E^x-K>=0,E^x-K,0];

(* Domain and discretization *)
L = Log[2*K];
Nx = 66; dx = 2*L/(Nx+1);
X = Table[-L+i*dx,{i,1,Nx}];
Nt=60;
dt = T/Nt;

(* Solution Array *)
U = {Table[f[X[[i]]],{i,1,Nx}]};

(* Setting up matrices *)
alpha = sigma^2/(2*dx^2)-(r-sigma^2/2)/(2*dx);
beta = -sigma^2/dx^2-r;
gamma =sigma^2/(2*dx^2)+(r-sigma^2/2)/(2*dx);

A = beta*IdentityMatrix[Nx];
For[i=2,i<=Nx,i++, A[[i,i-1]]=alpha];
For[i=1,i<=Nx-1,i++, A[[i,i+1]]=gamma];

Tm=IdentityMatrix[Nx]-(dt/2)*A;
G = IdentityMatrix[Nx]+(dt/2)*A;

Tm[[Nx,Nx]]=1;
For[time=1,time<=Nt,time++,
OldU=Last[U];
rhs = G.OldU;
rhs[[Nx]]=Exp[X[[Nx]]]-K*Exp[-r*(time*dt)];
newU=LinearSolve[Tm,rhs];
U=Append[U,newU];
];
tab=Table[{Exp[X[[i]]],U[[Nt,i]]},{i,1,Nx}];
payoff=Table[{Exp[X[[i]]],U[[1,i]]},{i,1,Nx}];

Show[ListLinePlot[tab,PlotRange->All],ListLinePlot[payoff,PlotStyle->RGBColor[1,0,0]]]

t=Flatten[Table[{Exp[X[[i]]],(j-1)*dt,U[[j,i]]},{i,1,Nx},{j,1,Nt}],1];
ListPlot3D[t]