In my Monte Carlo simulations, hard particles aggregate into sets of triple particles due to the energy minimization. The particles cannot overlap, but they touch at the minimum of the energy. The potential between them is a pair potential which depends on the distance between the pairs and orientation of each particles.
The orientation is measured based on the angle between the orientation vector of each particle and the line which connects the centre of them.
I do understand how the Monte Carlo works, but I would like to use Mathematica to find the minimum energy of only 3 particles besides the relevant parameters like orientation angles. From the Monte Carlo I know they form equilateral triangle so it is possible to fix the distance by putting the particles on the vertices of an equilateral triangle. Then the energy will be minimized by changing the orientation angles.
How can I do such constraint minimization in Mathematica?
I thought something like what happen in Monte Carlo simulation, iterative minimization, should work, but I could not put it together correctly.
Could you please let me know how should I handle it correctly?
Below you can find a minimal version of the problem. The radius of each particle is R=10 which makes the minimum distance, r= 20. The goal is to minimize v12+v13+v23 and finding B1, B2, B3.
Thank you.
Clear["Global`*"]
(*r12=r13=r23= r ; the distance between the particles. The goal is to minimize v12+v13+v23*)
v12[B1_ , B2_] =
10^6 r^-3 E^-r (-r^2 Cos[B1] Cos[B2] + r Sin[B1] Sin[B2]) ;
v13[B1_, B3_] =
10^6 r^-3 E^-r (-r^2 Cos[B1] Cos[B3] + r Sin[B1] Sin[B3]) ;
v23[B2_, B3_] =
10^6 r^-3 E^-r (-r^2 Cos[B2] Cos[B3] + r Sin[B2] Sin[B3]) ;
R = 10.0;
r = 20.0;
b1 = 0; b2 = 0; b3 = 0; aa0 = 10^4; aa = 0; a1 = 0; a2 = 0; a3 = 0;
{a1, {b1 , b2}} =
While[Abs[aa - aa0] > 10^-5, aa0 = aa;
NMinimize[
v12[B1 ,
B2 ], {{B1, b1 - 0.1, b1 + 0.1}, {B2, b2 - 0.1, b2 + 0.1}},
AccuracyGoal -> 20, PrecisionGoal -> 18,
WorkingPrecision -> 10] /. sol : {__Rule} :> Values[sol];
{a2, {b1 , b3}} =
NMinimize[
v13[B1 ,
B3], {{B1, b1 - 0.1, b1 + 0.1}, {B3, b3 - 0.1, b3 + 0.1}},
AccuracyGoal -> 20, PrecisionGoal -> 18,
WorkingPrecision -> 10] /. sol : {__Rule} :> Values[sol];
{a3, {b2 , b3}} =
NMinimize[
v23[B2, B3], {{B2, b2 - 0.1, b2 + 0.1}, {B3, b3 - 0.1,
b3 + 0.1}}, AccuracyGoal -> 20, PrecisionGoal -> 18,
WorkingPrecision -> 10] /. sol : {__Rule} :> Values[sol];
aa = a1 + a2 + a3;]