TIP-SAMPLE FORCE CURVE

Remove["Global`*"]

Highlights

Abstract

Introduction

Off[General::"spell", General::"spell1"]; Needs["Graphics`Arrow`"]; tera = (10^12); micro = (1/(10^6)); giga = (10^9); nano = (1/(10^9)); mega = (10^6); pico = (1/(10^12)); kilo = (10^3); femto = (1/(10^15)); milli = (1/(10.^3)); atto = (1/(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. π)/(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[{.0001}]}};

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[(∂_s) W[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 in nm", "W in nnJ"}, Evaluate[opt]];

Lennard-Jones Force

Clear[F]; F[s_] = -(∂_s) W[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[(∂_s) F[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 in nm", "F in nN"}, Evaluate[opt]];

Lennard-Jones Force Derivative

Clear[F1]; F1[s_] = (∂_s) F[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[(∂_s) F1[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 in nm", "F1 in N over 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 
                ((1/30) ((((15/2)))^(8/6)) - ((((15/2)))^(1/3)))
                  )/(6 (sigma^2)))] /. case; c2 = 
      N[-Log[2]/(sigma 
                  ((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 in nm", "F in 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, 0.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]] < (1/(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 in nm", "d in 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 in nm", "d in 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 in nm", "d in 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 in nm", "d in 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_] := \(-\(∂\_{s, 2}Wb[s]\/\(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 (nano^4))/(((Rtip A))^2)) /. 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 in nm", "Wk & W in nnJ"}, 
        Evaluate[opt]];

Fig6x13 = 
      Plot[{Wk[s nano, uOut]/atto /. case, W[s nano]/atto /. case}, {s, 
          sW0, stop1}, 
        FrameLabel -> {"s in nm", "Wk & W in 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 in nm", "Wt in nnJ"}, Evaluate[opt]];

Fig6x15 = 
      Plot[Wt[s nano, uOut]/atto /. case, {s, sW0, stop1}, 
        FrameLabel -> {"s in nm", "Wt in 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 in nm", "d in nm", "Wt in nnJ  "}, 
        DefaultFont -> {"Times-Roman", 8}];

Animation

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