Newton trajectories for the tilted Frenkel–Kontorova model
by    W.Quapp   and J.M.Bofill
in:    Molecular Physics,117:9-12,1541-1558 (2019)
DOI: 10.1080/00268976.2019.1576930
To link to this article:
https://doi.org/10.1080/00268976.2019.1576930
See also 
http://www.math.uni-leipzig.de/~quapp/refs_wq.html#2019

(* Figure 12: data points are calculated by a FORTRAN program: 
  FK3DmodelFigure12.f
It calculates the Newton trajectory to the chain potential with 
output energy file: FKmketen.weg , 
  the list energy3D is copyed from this file into the Mma nb   *)
(* The program has 1380 lines, it is changable to any dimension N *)
See also: 
http://www.math.uni-leipzig.de/~quapp/refs_wq.html#2019

energy3D={2.0741933783143400,2.0756158042383945,2.0798667175039798,2.0868905805054845,2.0965960457972379,2.1088578021027873,2.1235190992278330,2.1403949251847951,2.1592757784524030,2.1799319667487387,2.2021183473501935,2.2255794047544106,2.2500545397187914,2.2752834210317818,2.3010112308182276,2.3269923507146610,2.3529992050382345,2.3788203587090075,2.4042669583058309,2.4291740898942589,2.4534019520147181,2.4768360869387758,2.4993867427006364,2.5209874887023789,2.5415932425863597,2.5611778826771867,2.5797316188913166,2.5972582785217768,2.6137726363076257,2.6283027532332111,2.6406281085318453,2.6527028151067227,2.6644192141057297,2.6756977851138988,2.6864871680292080,2.6967478430426621,2.7064527614245213,2.7155820269547881,2.7235627427167550,2.7308529476428878,2.7378232316020581,2.7443677059809763,2.7504008803665805,2.7558465369441105,2.7605554743106899,2.7644810372022390,2.7676892409741871,2.7700359005428634,2.7713720203030645,2.7715359878102990,2.7703070436712718,2.7674846558044179,2.7628635188871007,2.7562496183483818,2.7466283861760674,2.7344522606429296,2.7199153790094392,2.7031603077621265,2.6836458527678939,2.6605700805060857,2.6378249869234462,2.6159458544485510,2.5956470155151372,2.5776013881260011,2.5623269686471923,2.5491350735956235,2.5399582662212370,2.5342160994049041,2.5312796014782259,2.5305118776130904,2.5312911955566166,2.5330417954985616,2.5352583554485704,2.5375202651761937,2.5394966970046231,2.5409454345806295,2.5417087472685131,2.5417090690090895,2.5409463679876438,2.5394981453973697,2.5375220637000897,2.5352602669276600,2.5330435075472124,2.5312923218424781,2.5305119665873952,2.5312781554465174,2.5342126048481668,
2.5399522319333285,2.5491260648594647,2.5623151253602789,2.5775870285770934,2.5956305358714533,2.6159278307575184,2.6378061135213802,2.6605510653063997,2.6836272323911636,2.7031451322756044,2.7199020809530330,2.7344410520960736,2.7466193090552027,2.7562431594823793,2.7628588360250430,2.7674815835069237,2.7703053959637174,2.7715355818344642,2.7713726593041002,2.7700374279679143,2.7676915268479139,2.7644839579043130,2.7605589056395896,2.7558506052480598,2.7504054430334497,2.7443727035883918,2.7378286003669392,2.7308586120766822,2.7235686032738249,2.7155886902015602,2.7064598894780811,2.6967554257671913,2.6864951896136162,2.6757062209063198,2.6644280273361693,2.6527119505942176,2.6406374891497064,2.6283122726087571,2.6137839554951499,2.5972704191641292,2.5797446062572447,2.5611917339758943,2.5416079647865280,2.5210030762537485,
2.4994031752497383,2.4768533271574387,2.4534199436807427,2.4291927563740625,2.4042862015850917,2.3788400590977479,2.3530192216420276,2.3270125227171636,2.3010313797619926,2.2753033529934030,2.2500740495337359,2.2255982797027016,2.2021363714832485,2.1799489254083113,2.1592914628279085,2.1404091367692688,2.1235316540507556,2.1088685346369243,2.0966048124543346,2.0868972626512479,2.0798712239362787,2.0756180730580907};

arr1=Graphics[{Black,Arrow[{{49.5,2.5},{49.5,2.75}}]}];
arr2=Graphics[{Black,Arrow[{{105,2.5},{105,2.75}}]}];
arr3=Graphics[{Black,Arrow[{{75,2.2},{72,2.5}}]}];
arr4=Graphics[{Black,Arrow[{{75,2.2},{81,2.5}}]}];

xxEn=Show[Graphics[{Text[Style["pre-SP",FontSize->20],{48,2.44}],
Text[Style["post-SP",FontSize->20],{106,2.44}],
Text[Style["anti-kink",FontSize->20],{73,2.144}]},
FormatType->StandardForm,PlotRange->{{1,153},{2.0,3.0}}]];

llen=ListPlot[energy3D,PlotStyle->{PointSize[Large]},ImageSize->Automatic,FrameStyle->Directive[20],FrameLabel->{"Node L of NT","PES"},Axes->False,Frame->True,FrameTicks->{{{2.1,2.3,2.5,2.7},None},{{1,51,102,153},None}}]

bbps2={{25,2.53},{130,2.53}};
DieBBPs=ListPlot[bbps2,PlotStyle->{Green,PointSize[0.0345]},ImageSize->Automatic,FrameStyle->Directive[20]];

bildEn=Show[llen,arr1,arr2,arr3,arr4,xxEn,DieBBPs]

Export["FKmodelxyzEnergy153.pdf",bildEn,ImageResolution->Automatic,
ImageSize->Automatic]