SURFACE ROUGHNESS

DEFINITIONS

neighBC[a_,b_]:=Switch[Abs[a-b],0,1,1,0,_,-Infinity]

BondCount[sdata_]:=
(
Sum[neighBC[sdata[[i,j]],sdata[[i,j+1]]]+neighBC[sdata[[i,j]],sdata[[i+1,j]]],{i,1,Length[sdata]-1},{j,1,Length[sdata]-1}]
)

dBCxc[sdata_,{i1_,j1_},{i2_,j2_}]:=(
(neighBC[sdata[[i1,j1]]+1,sdata[[i1,j1+1]]-
If[i2==i1 && j2==j1+1,1,0]]+neighBC[sdata[[i1,j1]]+1,sdata[[i1,j1-1]]-If[i2==i1 && j2==j1-1,1,0]]+neighBC[sdata[[i1,j1]]+1,sdata[[i1+1,j1]]-If[i2==i1+1 && j2==j1,1,0]]+neighBC[sdata[[i1,j1]]+1,sdata[[i1-1,j1]]-If[i2==i1-1 && j2==j1,1,0]]+
neighBC[sdata[[i2,j2]]-1,sdata[[i2,j2+1]]+
If[i2==i1 && j2+1==j1,1,0]]+neighBC[sdata[[i2,j2]]-1,sdata[[i2,j2-1]]+If[i2==i1 && j2-1==j1,1,0]]+neighBC[sdata[[i2,j2]]-1,sdata[[i2+1,j2]]+If[i2+1==i1 && j2==j1,1,0]]+neighBC[sdata[[i2,j2]]-1,sdata[[i2-1,j2]]+If[i2-1==i1 && j2==j1,1,0]])-
(neighBC[sdata[[i1,j1]],sdata[[i1,j1+1]]]+neighBC[sdata[[i1,j1]],sdata[[i1,j1-1]]]+neighBC[sdata[[i1+1,j1]],sdata[[i1,j1]]]+neighBC[sdata[[i1-1,j1]],sdata[[i1,j1]]]+
neighBC[sdata[[i2,j2]],sdata[[i2,j2+1]]]+neighBC[sdata[[i2,j2]],sdata[[i2,j2-1]]]+neighBC[sdata[[i2+1,j2]],sdata[[i2,j2]]]+neighBC[sdata[[i2-1,j2]],sdata[[i2,j2]]])
)

SurfacePlot[sdata_]:=Show[Graphics3D[{EdgeForm[],Table[Cuboid[{i-1,j-1,sdata[[i,j]]-1},{i,j,sdata[[i,j]]}],{i,1,Length[sdata]},{j,1,Length[sdata]}],
Table[If[sdata[[i,j]]≠sdata[[i,j+1]],{Line[{{i-1,j,sdata[[i,j]]},{i,j,sdata[[i,j]]}}],
Line[{{i-1,j,sdata[[i,j]]-1},{i,j,sdata[[i,j]]-1}}]}
,{}],{i,2,Length[sdata]-1},{j,2,Length[sdata]-1}],
Table[If[sdata[[i,j]]≠sdata[[i,j-1]],{Line[{{i-1,j-1,sdata[[i,j]]},{i,j-1,sdata[[i,j]]}}],
Line[{{i-1,j-1,sdata[[i,j]]-1},{i,j-1,sdata[[i,j]]-1}}]}
,{}],{i,2,Length[sdata]-1},{j,2,Length[sdata]-1}],
Table[If[sdata[[i,j]]≠sdata[[i+1,j]],{Line[{{i,j-1,sdata[[i,j]]},{i,j,sdata[[i,j]]}}],
Line[{{i,j-1,sdata[[i,j]]-1},{i,j,sdata[[i,j]]-1}}]}
,{}],{i,2,Length[sdata]-1},{j,2,Length[sdata]-1}],
Table[If[sdata[[i,j]]≠sdata[[i-1,j]],{Line[{{i-1,j-1,sdata[[i,j]]},{i-1,j,sdata[[i,j]]}}],
Line[{{i-1,j-1,sdata[[i,j]]-1},{i-1,j,sdata[[i,j]]-1}}]}
,{}],{i,2,Length[sdata]-1},{j,2,Length[sdata]-1}]
}
],ImageSize->6*72]

Module[{i1,i2,j1,j2,ns},
DoMC[kTeB_]:= (
ns=Dimensions[surf]-2;
{i1,i2}=RandomInteger[{2,ns[[1]]+1},2];
{j1,j2}=RandomInteger[{2,ns[[2]]+1},2];
If[(i1!=i2 || j1!=j2) && (RandomReal[]<Exp[1/kTeB*dBCxc[surf,{i1,j1},{i2,j2}]]),
surf[[i1,j1]]++;surf[[i2,j2]]--;
]
)
]

ns=10
surf=ConstantArray[0,{ns+2,ns+2}];

Dynamic[Refresh[MatrixPlot[surf,ImageSize->3*72],UpdateInterval->2]]

interactive

Manipulate[Column[{Dynamic[Refresh[MatrixPlot[surf,ImageSize->3.5*72],UpdateInterval->0.5,TrackedSymbols:>{}]],SurfacePlot[surf]},Center],
{{ns,10,"Surface size"},10,50,5,Appearance->"Labeled"},
{{sstyle,"flat","Surface style"},{"flat","ledge","kink"}},
Button["reset",
Switch[sstyle,"flat",
surf=ConstantArray[0,{ns+2,ns+2}],"ledge",
surf=Table[If[i<ns/2,1,0],{i,1,ns+2},{j,1,ns+2}],
"kink",
surf=Table[If[i<ns/2||(i<ns/2+1 &&j>ns/2),1,0],{i,1,ns+2},{j,1,ns+2}]
],ImageSize->80],
{{eb,0.5,"kT/eB"},0.001,10,Appearance->"Labeled"},
{{nstep,10000,"Number of MC steps"},{1,100,10000,100000,1000000}},
Button["go",Do[DoMC[eb],{i,1,nstep}],ImageSize->80,Method->"Queued"],SaveDefinitions->True
]

SURFACE RECONSTRUCTIONS

DEFINITIONS

{b1,b2}={{1,0},{1/2,Sqrt[3]/2}};

Module[{cr},
mkLattice[{b1_,b2_},{n1_,n2_},r_:Automatic,orig_:{0,0}]:=(
cr=If[r=!=Automatic,r,Sqrt[Norm[b1]*Norm[b2]*Sin[ArcCos[b1.b2]/(Norm[b1]Norm[b2])]/Pi]/2];
Table[Circle[orig+b1*i+b2*j,cr],{i,-n1,n1},{j,-n2,n2}]
)]

Module[{s1,s2,cr,rm},
slDrawRec[{b1_,b2_},{n_,m_},c_:False,rot_:0,r_:Automatic]:=
(cr=If[r=!=Automatic,r,Sqrt[Norm[b1]*Norm[b2]*Sin[ArcCos[b1.b2]/(Norm[b1]Norm[b2])]/Pi]/3];
s1=n*b1;s2=m*b2;
rm={{Cos[rot*Pi/180],Sin[rot*Pi/180]},{-Sin[rot*Pi/180],Cos[rot*Pi/180]}};
s1=Transpose[rm].s1;s2=Transpose[rm].s2;
Union[{
Line[{{0,0},s1,s1+s2,s2,{0,0}}],
Disk[{0,0},cr],Disk[s1,cr],Disk[s2,cr],Disk[s1+s2,cr]},
If[c,{Disk[(s1+s2)/2,cr]},{}]]
)]

Graphics[{mkLattice[{b1,b2},{3,3}],Red,slDrawRec[{b1,b2},{Sqrt[3],Sqrt[3]},True,45]}]

interactive

Manipulate[
Graphics[{mkLattice[base,{3,3}],Red,slDrawRec[base,{m,n},center,rot],
Black,Text[Style[If[center,"c-",""]<>ToString[m]<>"×"<>ToString[n]<>If[rot≠0,"-R"<>ToString[rot],""],FontSize->14,Bold],(base[[1]]+base[[2]]/2)*-3,{-1,1},Background->White]}]
,
{{base,(Sqrt[2]/2{{1,1},{1,-1}}),"Surface lattice"},{ { {1,0},{1,Sqrt[3]}/2}->"fcc(111)",(Sqrt[2]/2{{1,1},{1,-1}})->"fcc(100)"}},
{{m,Sqrt[5]}},{{n,Sqrt[5]}},{{center,True,"Centered"},{True,False}},
{{rot,26.56,"R[deg.]"}},SaveDefinitions->True
]

exam

g=Graphics[{mkLattice[{ {1,0},{1,Sqrt[3]}/2},{3,3},Automatic,{1,Sqrt[3]}/2+{1,0}],Red}]

g=Graphics[{mkLattice[ Sqrt[2]/2{{1,1},{1,-1}},{3,3},Automatic,{1,Sqrt[3]}/2+{1,0}],Red}]

Export["/tmp/fcc100-wood.pdf",g,"PDF"]