Sliding paths for series of Frenkel-Kontorova models: 
a contribution to the concept of 1D-superlubricity

       by    Wolfgang Quapp  and Josep Maria Bofill

       Eur.Phys.J. B  (2019) Vol 92, Iss.5,  p.95
       https://doi.org/10.1140/epjb/e2019-100198-0

(*  Calculate Global Minimum for N=6 of a Chain by Mma *)
(*  Figure 1 panel left above *)

(* Guess of minimum in Fortran Programm with ENERGY 4.6034786 and 
det Hessian 7.8581454 at node LA125 *)
LA125={0.97588, 5.98387, 10.69701, 14.45439, 19.16187, 24.17661};

(* Setxx is the guess, SetXX is the guess + variables A[j] for optimization *)
Setxx=LA125;
SetAA=Table[A[i],{i,6}];
SetXX=Setxx+SetAA;
as=6.283185307180;
a0=4.188790204787;

(* The formula for the FK model PES for N=6 *)
k=1.0 ;
VVV=Sum[1- Cos[SetXX[[i]]] ,{i,6}]+Sum[k/2.*(SetXX[[i+1]]-SetXX[[i]]-a0)^2 ,{i,5}];
(* Gradient *)
GGG=Table[D[VVV,A[i] ],{i,6}];
(* Put borders for optimization *)
Set00=Table[-0.172,{i,6}];
Set22=Table[0.172,{i,6}];
SetAA00=Riffle[SetAA,Set00];
SetA0=Partition[SetAA00,2];
SetAA22=Riffle[SetA0,Set22];
SetFl=Flatten[SetAA22];
SetFin=Partition[SetFl,3];
(* squares of the gradients 
G2G2G2=Sum[GGG[[i]]^2,{i,6}];
can also be optimized if the SP is searched *)

NMinimize[VVV,SetFin]

(* The calculation gives correctness for the guess *)

(* put in the results for A[j] by hand to the variablen vector SetXX *)

SetXX/.{A[1]->-0.009903273245177185`,A[2]->-0.006498379554402748`,A[3]->-0.009312694188843331`,A[4]->-0.009346077092812932`,A[5]->-0.006500391727252174`,A[6]->-0.00984549803647696`}

(* Again put in by hand the variables vector name before the SetXX file *)
SetXX={0.9659766992470813`,5.9773715804277066`,10.687697220826438`,14.445043837662682`,19.15536957556792`,24.166764481863947`};

(* And if one is interested in the Eigenvalues, one can put the results for A[j] by hand to the variablen vector HHH *)

HHH=Table[D[GGG,A[j] ],{j,6}];
HHH/.{A[1]->-0.009903273245177185`,A[2]->-0.006498379554402748`,A[3]->-0.009312694188843331`,A[4]->-0.009346077092812932`,A[5]->-0.006500391727252174`,A[6]->-0.00984549803647696`};

Eigensystem[%]

(* Now comes the Figure 1 *)

SetAA00=Riffle[SetXX,1-Cos[SetXX]];
XXX=Partition[SetAA00,2];
Bild=Show[Graphics[ {PointSize[0.02135],Black,Point[ XXX]}] ,FormatType->StandardForm,PlotRange->All]
Bildline=ListLinePlot[XXX,PlotRange->All]
sidePot=Plot[
1.-Cos[x] ,{x,0,8.*Pi},Axes->{True,True},AxesStyle->Directive[20],AxesLabel->{"x","1-cos(x)"},AspectRatio->0.36]

gMin6D=Show[sidePot,Bild,Bildline]

Export["FKmod6DGlobMin.pdf",gMin6D,ImageResolution->Automatic,
ImageSize->Automatic]