TIP-SAMPLE FORCE CURVE

Remove["Global`*"]

Highlights

Abstract

Introduction

Off[General::spell,General::spell1];

Needs["Graphics`Arrow`"];

tera  = 10^12  ; micro = 10^-6;
giga  = 10^9   ; nano  = 10^-9; 
mega  = 10^6   ; pico  = 10^-12;
kilo  = 10^3   ; femto = 10^-15; 
milli = 10.^-3 ; atto  = 10^-18;

NSub = {
c   -> 2.99792458 10^8  , e     -> 1.6021773 10^-19,
h   -> 6.6260755 10.^-34, hbar  -> 1.05457 10.^-34 ,
K   -> 1.380658 10^-23  , me    -> 9.109389 10^-31 ,
mu0 -> 4. Pi 10^-7      , eps0  -> 8.85419 10^-12   };

ESi   =0.179 tera; rhoSi   =2330 ; nuSi   =0.28;
ESiO2 =0.06  tera; rhoSiO2 =2200 ; nuSiO2 =0.3;
ESi3N4=0.15  tera; rhoSi3N4=3100 ; nuSi3N4=0.24;
EAu   =0.08  tera; rhoAu   =19300; nuAu   =0.42;
ENi   =0.207 tera; rhoNi   =8900 ; nuNi   =0.41;
EW    =0.345 tera; rhoW    =19300; nuW    =0.28;
EPt   =0.17  tera; rhoPt   =21400; nuPt   =0.39;
EIr   =0.52  tera; rhoIr   =22500; nuIr   =0.3 ;
EHOPG =0.2   tera; rhoHOPG =2250 ; nuHOPG =0.3 ;
EPol  =0.001 tera; rhoPol  =1000 ; nuPol  =0.3 ;

xx     =0.8;
EPtIr  =xx 0.8 EPt+(1-xx) EIr;
rhoPtIr=xx rhoPt  +(1-xx) rhoIr;
nuPtIr =0.3;

opt= {
PlotRange  ->All,
AxesOrigin ->{0,0},
Frame      ->True,
GridLines  ->Automatic,           
DefaultFont->{"Times-Roman",8},
PlotStyle  ->{
Dashing[{.0001}],
Dashing[{.0200}],
Dashing[{.0200}],
Dashing[{.0200}],
Dashing[{.0200}],
Dashing[{.0200}]}};

Operating Conditions

case = {
Rtip  -> 10 nano,
sigma -> 0.35 nano,
A    -> 0.425 atto,
kk    -> 0.5
};

Tip-Sample Interaction

Lennard-Jones Potential

Clear[Wb,W];
Wa       = Rtip A/(6 sigma);
Wb[s_]  := 1/210 (sigma/s)^7-sigma/s;
W[s_]   := Wa Wb[s];

sWzero = Solve[W[s]==0,s][[2,1,2]];
Print["sWzero = ",sWzero," = ",
N[sWzero/nano/.case]," [nm]"]

sWmin = Solve[D[W[s],s]==0,s][[2,1,2]];
Print["sWmin = ",sWmin," = ",
N[sWmin/nano/.case]," [nm]"]

Print["Wmin = ",W[sWmin]," = ",
N[W[sWmin]/.case]/nano/nano," [nnJ]"]

Fig6x2 =
Plot[W[s nano]/atto/.case,
{s,sWzero/nano/.case,2},
FrameLabel ->{"s [nm]","W [nnJ]"},
Evaluate[opt]];

Lennard-Jones Force

Clear[F];
F[s_] = -D[W[s],s];
Print["F(s) = ",Simplify[F[s]]]

sFzero = Solve[F[s]==0,s][[2,1,2]];
Print["sFzero = ",sFzero," = ",
N[sFzero/nano/.case]," [nm]"]

sFmin = Solve[D[F[s],s]==0,s][[2,1,2]];
Print["sFmin = ",sFmin," = ",
N[sFmin/nano/.case]," [nm]"]

Print["Fmin = ",F[sFmin]," = ",
N[F[sFmin]/.case]/nano," [nN]"]

Fig6x3 =
Plot[F[s nano]/nano/.case,
{s,sFzero/nano/.case,2},
FrameLabel ->{"s [nm]","F [nN]"},
Evaluate[opt]];

Lennard-Jones Force Derivative

Clear[F1];
F1[s_] = D[F[s],s];
Print["F1(s) = ",Simplify[F1[s]]]

sF1zero = Solve[F1[s]==0,s][[2,1,2]];
Print["sF1zero = ",sF1zero," = ",
N[sF1zero/nano/.case]," [nm]"]

sF1max = Solve[D[F1[s],s]==0,s][[2,1,2]];
Print["sF1max = ",sF1max," = ",
N[sF1max/nano/.case]," [N/m]"]

F1max = F1[sF1max];
Print["F1max = ",F1max," = ",
N[F1max/.case]," [N/m]"]

Fig6x4 =
Plot[F1[s nano]/.case,
{s,sF1zero/nano/.case,2},
FrameLabel ->{"s [nm]","F1 [N/m]"},
Evaluate[opt]];

Morse Potential

Clear[FMorse];
s2 = sFmin;
FMorse[s_]:=c1 (Exp[-2 c2 (s-s2)]-2 Exp[-c2 (s-s2)]);

c1 = 
-N[Rtip A/(6 sigma^2) (1/30 (15/2)^(8/6)-
(15/2)^(1/3))]/.case;
c2 = 
N[-Log[2]/sigma 1/(30^(-1/6)-
(2/15)^(1/6))]/.case;

Fig6x5 =
Plot[{
FMorse[s nano]/nano/.case,
F[s nano]/nano/.case},
{s,sFzero/nano/.case,2},
FrameLabel ->{"s [nm]","F [nN]"},
Evaluate[opt]];

Hysteresis Loop

Snap-in and Snap-out Points

Print["max k < ",N[F1max]/.case," [N/m]"];

Print["chosen k      = ",kk/.case," [N/m]"]
kmax = N[F1max/.case];
Print["max allowed k = ",kmax," [N/m]"]
k = If[kk>0.9 kmax,.9 kmax,kk]/.case;
Print["working k     = ",k," [N/m]"]

Clear[u,d];
u[s_] := s-F[s]/k/.case;
d[s_] := F[s]/k/.case;

sol1 = N[Solve[F1[s]==k,s]/.case];
dim  = Dimensions[sol1][[1]];
tb1  = Table[sol1[[i,1,2]],{i,1,dim}];
cs1  = Cases[tb1, x_/; Abs[Im[x]]<10^-20 && Re[x]>0];
sIn  = Max[{Re[cs1[[1]]],Re[cs1[[2]]]}];
sOut = Min[{Re[cs1[[1]]],Re[cs1[[2]]]}];

uIn  = N[sIn-F[sIn]/k]/.case;
uOut = N[sOut-F[sOut]/k]/.case;

dIn  = N[F[sIn]/k]/.case;
dOut = N[F[sOut]/k]/.case;

Print[TableForm[{{"Table I","snap-in [nm]",
"snap-out [nm]"},
{"s ",sIn/nano,sOut/nano},
{"u ",uIn/nano,uOut/nano},
{"d ",dIn/nano,dOut/nano}}]];

Calculated Hysteresis Loop

sW0   = sWzero/nano/.case;
p1    = sW0;
p2    = 1.5 uOut/nano;
range = {{0,p2},{-p2,p2/10}};

hystGraphicsA =
ParametricPlot[{
u[s nano]/nano,
d[s nano]/nano},
{s,p1,p2},
AxesOrigin     ->{0,1},
AspectRatio    ->1,
FrameLabel     ->{"u [nm]","d [nm]"},	
DefaultFont    ->{"Times-Roman",8},
PlotStyle      ->{Thickness[0.02]},
Frame          ->True,PlotRange->range,
GridLines      ->Automatic,
DisplayFunction->Identity];

startGraphics =
Graphics[Disk[{.95 p2,d[p2 nano]/nano},
uOut/nano/20]];

Fig6x6 =
Show[{hystGraphicsA,startGraphics},
DisplayFunction->$DisplayFunction];

Observed Hysteresis Loop

hystGraphicsB =
ParametricPlot[{
u[s nano]/nano,
d[s nano]/nano},
{s,sIn/nano,p2},
AxesOrigin     ->{0,1},
AspectRatio    ->1,
FrameLabel     ->{"u [nm]","d [nm]"},	
DefaultFont    ->{"Times-Roman",8},
PlotStyle      ->{Thickness[0.02]},
GridLines      ->Automatic,
Frame          ->True,
PlotRange      ->range,
DisplayFunction->Identity];

Fig6x7 =
Show[{hystGraphicsB,startGraphics},
DisplayFunction->$DisplayFunction];

case4=Solve[u[s]==uIn,s];
dim2=Dimensions[case4][[1]];
case5=Table[case4[[i,1,2]],{i,1,dim2}];
case6=Cases[case5, x_/; Im[x]==0 && Re[x]>0];
p3=d[case6[[1]]]/nano;

CGraphics =
Graphics[Arrow[{uIn/nano,dIn/nano},
{uIn/nano,p3}]];

DGraphics =
Graphics[Text["in",{uIn/nano,p3-uOut/nano/10}]];

Fig6x8 =
Show[{Fig6x7,CGraphics,DGraphics},
DisplayFunction->$DisplayFunction];

hystGraphicsF =
ParametricPlot[{
u[s nano]/nano,
d[s nano]/nano},
{s,case6[[1]]/nano,p1},
FrameLabel     ->{"u [nm]","d [nm]"},    
DefaultFont    ->{"Times-Roman",8},
PlotStyle      ->{Thickness[0.02]},
Frame          ->True,
PlotRange      ->range,
AxesOrigin->{0,1},
DisplayFunction->Identity];

Fig6x9 =
Show[{Fig6x8,hystGraphicsF},
DisplayFunction->$DisplayFunction];

hystGraphicsG =
ParametricPlot[{
u[s nano]/nano,
d[s nano]/nano},
{s,case6[[1]]/nano,sOut/nano},
FrameLabel     ->{"u [nm]","d [nm]"},    
DefaultFont    ->{"Times-Roman",8},
PlotStyle      ->{Thickness[0.02]},
Frame          ->True,
PlotRange      ->range,
AxesOrigin     ->{0,1},
DisplayFunction->Identity];

Fig6x10 =
Show[{Fig6x9,hystGraphicsG},
DisplayFunction->$DisplayFunction];

case1 = Solve[u[s]==uOut,s];
dim1  = Dimensions[case1][[1]];
case2 = Table[case1[[i,1,2]],{i,1,dim1}];
case3 = Cases[case2, x_/; Im[x]==0 && Re[x]>0];
pp2   = d[case3[[3]]]/nano;

HGraphics =
Graphics[Arrow[
{uOut/nano,dOut/nano},{uOut/nano,pp2}]];

IGraphics =
Graphics[Text["out",
{uOut/nano,dOut/nano-uOut/nano/3}]];

Fig6x11 =
Show[{Fig6x10,HGraphics,IGraphics},    
DisplayFunction->$DisplayFunction];

$A R_{tip}$ Product

Product Obtained from the Snapping Points

Clear[F1b];
F1b[s_] := -D[Wb[s],{s,2}]/(6 sigma);
Print["F1b = ",Simplify[F1b[s]]]

Print["evaluated A Rtip = ",
k/F1b[s]/nano^3/.s->sOut/.case," [nm^3]"]

Print["chosen A Rtip = ",
Rtip A/nano^3/.case," [nm^3]"]

Product Obtained from the Area

deld = dOut-dIn;
dels = sOut-sIn;
delu = uOut-uIn;

Print["sOut-sIn = ",dels/nano," [nm]"];
Print["uOut-uIn = ",delu/nano," [nm]"];
Print["dOut-dIn = ",deld/nano," [nm]"];

Ah = 1/2(deld^2-(deld+delu)^2);
Print["Ah             = ",Ah/nano^2," [nm^2]"];
Print["Rtip A         = ",Rtip A/nano^3/.case," [nm^3]"];
Print["Ah/(Rtip A)^2 = ",Ah/(Rtip A)^2 nano^4/.case,
                        " [nm^-4]"]

Total Tip-Sample Energy

Total Energy

Clear[Wk];
Wk[s_,u_] := 1/2 k (u-s)^2;

Clear[Wt];
Wt[s_,u_] := Wk[s,u] + W[s];

Clear[Ft];
Ft[s_,u_] := F[s] + k(u-s)

Separate Energy Minima

sol2 = Solve[Ft[s,uIn]/nano==0,s]/.case;
dim2 = Dimensions[sol2][[1]];
tb2  = Table[sol2[[i,1,2]],{i,1,dim2}];
cs2  = Cases[tb2, x_/; Im[x]==0 && Re[x]>0][[2]];

sol3 = Solve[Ft[s,uOut]/nano==0,s]/.case;
dim3 = Dimensions[sol3][[1]];
tb3  = Table[sol3[[i,1,2]],{i,1,dim3}];
cs3  = Cases[tb3,x_/; Im[x]==0 && Re[x]>0][[2]];

Print["sIn from energy  = ",cs2/nano," [nm]"];
Print["sOut from energy = ",cs3/nano," [nm]"];

stop1 = 1.5 uOut/nano;
Fig6x12 =
Plot[{
Wk[s nano,uIn]/atto/.case,
W[s nano]/atto/.case},
{s,sW0,stop1},
PlotRange  ->{
-1.5 W[sWmin]/atto/.case,
1.5 W[sWmin]/atto/.case},
FrameLabel ->{"s [nm]","Wk & W [nnJ]"},
Evaluate[opt]];

Fig6x13 =
Plot[{
Wk[s nano,uOut]/atto/.case,
W[s nano]/atto/.case},
{s,sW0,stop1},
FrameLabel ->{"s [nm]","Wk & W [nnJ]"},	
DefaultFont->{"Times-Roman",8},
Frame      ->True,
PlotRange  ->{-1.5 W[sWmin]/nano/nano/.case,
1.5 W[sWmin]/nano/nano/.case},
GridLines  ->Automatic];

Total Energy Minima

Fig6x14 =
Plot[Wt[s nano,uIn]/atto/.case,
{s,sW0,stop1},
FrameLabel ->{"s [nm]","Wt [nnJ]"},
Evaluate[opt]];

Fig6x15 =
Plot[Wt[s nano,uOut]/atto/.case,
{s,sW0,stop1},
FrameLabel ->{"s [nm]","Wt [nnJ]"},
Evaluate[opt]];

Fig6x16 =
Plot3D[Wt[s nano,u nano]/atto/.case,
{s,sW0,stop1},
{u,uIn/nano,uOut/nano},          
DefaultFont->{"Times-Roman",8},
AxesLabel->{"s [nm]","d [nm]","Wt [nnJ]  "},
DefaultFont->{"Times-Roman",8}];

Animation

Appendix

Figure 1

Animation

fig1a =
Graphics[{Circle[{1,1},.1],
Text[FontForm["u",{"Times-Roman",10}],{1.9,1-.1}],               
Text[FontForm["Sample",
{"Times-Roman",8}],{0,-1}],
Text[FontForm["Cantilever",{"Times-Roman",8}],{0,1.5}],
Text[FontForm["Bimorph",{"Times-Roman",8}],{-1.7,1.5}],
Text[FontForm["Tip",{"Times-Roman",8}],{1,1.5}]},               
PlotRange  ->{{-2,2.5},{-1.5,2}},
AspectRatio->Automatic,PlotLabel->"Animation",
DefaultFont->{"Times-Roman",8}];

mm = 8;
tb    = Table[test1=Solve[u[s]==uuu,s];
dim1  = Dimensions[test1][[1]];
test2 = Table[test1[[i,1,2]],{i,1,dim1}];
test3 = Cases[test2, x_/; Im[x]==0 && Re[x]>0];
uss   = {uuu/uOut,d[test3][[1]]/dOut},
{uuu,-1.5 uOut/mm,1.5 uOut,1.5 uOut/mm}];

Do[fig1b=Graphics[
{Text[FontForm["g",{"Times-Roman",8}],
{1.5,1-tb[[j,1]]-.15}],
Text[FontForm["s",{"Times-Roman",8}],
{1.75,1-tb[[j,2]]-.1}],
Line[{{-1.5,1},{1,1-tb[[j,2]]}}],
{Dashing[{0.01}],Line[{{-1.5,1},{1.1,1}}]},
Disk[{1,1-tb[[j,2]]},.1],
Table[Disk[{i,1-tb[[j,1]]-.15},.05],
{i,-1.5,1.25,.125}]}];
pl1 = Show[{fig1a,fig1b},Frame->True],{j,1,mm}];