TAPPING MODE

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}]}};

opt1= {
PlotRange  ->All,
AxesOrigin ->{0,0},
Frame      ->True,
GridLines  ->Automatic,           
DefaultFont->{"Times-Roman",8}};

Operating Conditions

Operation = {
abm -> 1 nano,
k   -> 20.,
f0  -> 100 kilo,
Q   -> 100,
set -> 75 nano
};

w0=2 Pi f0/.Operation;

TipSample = {
Rtip  -> 10 nano,
E1    -> ESi,
E2    -> ESi,
nu1   -> 0.3,
nu2   -> 0.3,
sigma -> 0.34 nano,
A     -> 0.1 atto
};

fresonance = f0/.Operation;

fminus = f0(1-0.35/Q)/.Operation;

fplus = f0(1+0.35/Q)/.Operation;

Frequency = fminus;
fandw     = {
f->Frequency,
w->2 Pi Frequency,
w0->2 Pi f0/.Operation};

case  = Union[TipSample,Operation,fandw];

Tip-Sample Interaction

Lennard-Jones Potential

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

Clear[FLJ];
FLJ[s_] = -D[WLJ[s],s];

sFzero = Solve[FLJ[s]==0,s][[6,1,2]];
Print["sFzero = ",
N[sFzero/nano]," [nm]"]

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

Indentation Repulsive Force

kappa1   = (1-nu1^2)/(Pi E1);
kappa2   = (1-nu2^2)/(Pi E2);
kappaeff = kappa1 + kappa2;

ks = N[4/(3 Pi kappaeff)]/.case;
Print["ks = ",ks nano," [nN/m^2]"]

Total Tip-Sample Force

Clear[Ftotal,s,kk];
Ftotal[s_,kk_] :=
If[s<sFzero,
kk Sqrt[Rtip](Abs[s-sFzero])^(3/2)/.case,
FLJ[s]];

tableI =
Table[
ListPlot[
Table[{s/nano,Ftotal[s,kk]/nano},
{s,0.1 nano,0.5 nano,0.01 nano}],
PlotJoined     ->True,
FrameLabel     ->{"s [nm]","F [nN]"},
DisplayFunction->Identity,
Evaluate[opt1]],
{kk,ks,10 ks,2 ks}];

Fig9x3 =
Show[
tableI,
DisplayFunction->$DisplayFunction];

Clear[Force];
Force[s_] := Ftotal[s,ks]

Equation of Motion

nn    = 2 Q/.case;
cycle = 1/f/.case;
stop  = nn cycle;

Clear[z,v,x1,x2];
eq1 = x1'[t] == x2[t];
eq2 = x2'[t] ==
-w0/Q x2[t] - 
w0^2 (x1[t]-set-abm Sin[2 Pi f t])+
(w0^2)/k F[x1[t]]/.case;

General Solution

Clear[z,v,x1,x2];
{z,v} = {x1,x2}/.
NDSolve[{eq1,eq2,
x1[0]==set/.case,x2[0]==0}//.
F->Force,
{x1,x2},
{t,0,stop},
MaxSteps -> 100000][[1]];

Clear[x,fun,phifree];
fun[x_]     := If[x==1,-Pi/2,ArcTan[1/Q/(1/x-x)]/.case];
phifree[x_] := -If[x<1,fun[x],Pi+fun[x]]

Clear[x,zfree0];
zfree0[x_] := abm Q/Sqrt[x^2+Q^2 (1-x^2)^2]/.case

Clear[zfree];
x = w/w0/.case;
zfree[t_] :=
set +
zfree0[x](1-Exp[-w/(2 Q)t])*
Sin[w t+phifree[x]]/.case;

Transient Regime

Fig9x4 =
Plot[Evaluate[{
z[t cycle]/nano,
zfree[t cycle]/nano}],
{t,0,10}, 
FrameLabel ->{"cycles","z and zfree [nm]"},
Evaluate[opt]];

Steady-State Regime

Fig9x5 =
Plot[{
z[t cycle]/nano,
zfree[t cycle]/nano},
{t,nn-2,nn},
FrameLabel ->{"cycles","z and za [nm]"},
Evaluate[opt]];

Tapping Phase Diagram

Fig9x6 =
ParametricPlot[{
z[t cycle]/nano,
zfree[t cycle]/nano},
{t,nn-2,nn},
AspectRatio->1, 
FrameLabel ->{"z [nm]","za [nm]"},
Evaluate[opt]];

Displacement-Velocity Phase Diagram

Fig9x7 =
ParametricPlot[{
z[t cycle]/nano,
v[t cycle]},
{t,nn-3,nn},
AspectRatio->1,
FrameLabel ->{"z [nm]","v [m/sec]"},
Evaluate[opt]];

Numerical Value of the Phase Shift

Clear[vfree];
vfree[t_]= D[zfree[t],{t,1}];

Fig9x8 =
Plot[Evaluate[{
v[t cycle],
vfree[t cycle]/.case}],
{t,(nn-2),nn},
FrameLabel ->{"cycles","v [m/s]"},
Evaluate[opt]];

tfree =
FindRoot[vfree[t cycle]==0,
{t,nn-.2,nn-.8}][[1,2]];
Print["tfree = ",tfree," [cycle]"]

ttap = 
FindRoot[v[t cycle]==0,
{t,nn-.2,nn-.8}][[1,2]];
Print["ttap = ",ttap," [cycle]"]

deltaphi = ttap-tfree;
Print["deltaphi = ",deltaphi 360," [deg]"]

Summary of Results

List of Key Results

Maximum Indentation, Force, and Pressure

tmin=FindRoot[v[t cycle]==0,{t,nn-1.5,nn-1}][[1,2]];
tmax=FindRoot[v[t cycle]==0,{t,nn-1,nn-.5}][[1,2]];

zave = Abs[(z[tmax cycle]+z[tmin cycle])/2];
Anew = Abs[(z[tmin cycle]-z[tmax cycle])/2];

dmax = If[z[tmin cycle]<sFzero,z[tmin cycle]-sFzero,0];

Fmax = N[Force[z[tmin cycle]]];

rmax = If[dmax<0,N[(Rtip Fmax/ks)^(1/3)]/.case,0];

Pmax = If[dmax<0,
N[3/(2 Pi) (ks/Rtip)^(2/3) Fmax^(1/3)]/.case,0];

Operating Parameters

Print["Rtip    = ",Rtip/nano/.case, " [nm]"]
Print["Hamaker = ",A/atto/.case, " [aJ]"]
Print["sigma   = ",sigma/nano/.case, " [nm]"]
Print["abm     = ",abm/nano/.case," [nm]"]
Print["Q       = ",Q/.case]
Print["f0      = ",N[f0/kilo]/.case," [kHz]"]
Print["set     = ",set/nano/.case," [nm]"]

Key Results

Print["f       = ",N[f/kilo]/.case," [kHz]"]
Print["ampl    = ",zfree0[x]/nano,"->",Anew/nano," [nm]"]
Print["zave    = ",set/nano/.case,"->",zave/nano," [nm]"]
Print["phase   = ",N[0],"->",N[deltaphi 360]," [deg]"]
Print["dmax    = ",dmax/nano," [nm]"]
Print["Fmax    = ",Fmax/nano," [nN]"]
Print["rmax    = ",N[rmax/nano]," [nm]"]
Print["Pmax    = ",N[Pmax/giga]," [GPa]"]

Four Figures

Displacement

zGraphics =
Plot[z[t cycle]/nano,
{t,nn-1,nn},
FrameLabel     ->{"cycles","z [nm]"},
PlotLabel      ->"(a)",
DisplayFunction->Identity,
Evaluate[opt]];

Velocity

vGraphics =
Plot[v[t cycle],
{t,nn-1,nn},
FrameLabel     ->{"cycles","v [m/sec]"},
PlotLabel      ->"(b)",
DisplayFunction->Identity,
Evaluate[opt]];

leftshift = .2;
Fig9x9 = 
Show[Graphics[{
Rectangle[{0,0},{1,1},zGraphics],
Rectangle[{1-leftshift,0},
{2-leftshift,1},vGraphics]}],
AspectRatio->.5/GoldenRatio];

Indentation

clear[ind];
ind[t_] := If[z[t]<sFzero,z[t],sFzero]

indGraphics =
Plot[ind[t cycle]/nano,
{t,nn-1,nn},
FrameLabel     ->{"cycles","d [nm]"},
PlotLabel      ->"(a)",
DisplayFunction->Identity,
Evaluate[opt]];

Force

FGraphics =
Plot[Force[z[t cycle]]/nano,
{t,nn-1,nn}, 
FrameLabel     ->{"cycles","F [nN]"},
PlotLabel      ->"(b)",
DisplayFunction->Identity,
Evaluate[opt]];

leftshift = .2;
Fig9x10 = 
Show[Graphics[{
Rectangle[{0,0},{1,1},indGraphics],
Rectangle[{1-leftshift,0},
{2-leftshift,1},FGraphics]}],
AspectRatio->.5/GoldenRatio];