MNR 3 ESPINS (termes diagonals)

ClearAll["Global`*"]

\(\(ener
       = {\(1\/2\) k \((a + b + c)\) + \(1\/4\) \((Jab + Jac + Jbc)\), 
		
        \(1\/2\) k \((a + b - c)\) + \(1\/4\) \((Jab - Jac - Jbc)\), 
        \(1\/2\) k \((a - b + c)\) + \(1\/4\) \((\(-Jab\) + Jac - Jbc)\), 
        \(1\/2\) k \((\(-a\) + b + c)\) + 
          \(1\/4\) \((\(-Jab\) - Jac + Jbc)\), 
        \(1\/2\) k \((a - b - c)\) + \(1\/4\) \((\(-Jab\) - Jac + Jbc)\), 
        \(1\/2\) k \((\(-a\) + b - c)\) + 
          \(1\/4\) \((\(-Jab\) + Jac - Jbc)\), 
        \(1\/2\) k \((\(-a\) - b + c)\) + \(1\/4\) \((Jab - Jac - Jbc)\), 
        \(1\/2\) k \((\(-a\) - b - c)\) + \(1\/4\) \((Jab + Jac + Jbc)\)}; 
    \)\)

int
       = {{0, 1, 1, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 1, 0, 0}, {0, 0, 0, 0, 1, 
          0, 1, 0}, {0, 0, 0, 0, 0, 1, 1, 0}, {0, 0, 0, 0, 0, 0, 0, 1}, {0, 
          0, 0, 0, 0, 0, 0, 1}, {0, 0, 0, 0, 0, 0, 0, 1}};

\(ClearAll[k, a, b, c, Jab, Jac, Jbc, aa]; 
k = 250; a = 0.5; b = 0.5; 
    c = 0.5; Jab = 0; Jac = 0; Jbc = 0; 
w = {}; s = {}; 

    For[i = 1, i <= 8, \(i++\), 
	
      For[j = i + 1, j <= 8, \(j++\), 
		
        If[int[[i, j]] > 10\^\(-3\), 
			AppendTo[s, int[[i, j]]]; 

          				\(AppendTo[w, 10\ Abs[ener[[j]] - ener[[i]]]]; \), \ \ 
          Continue\ ]
					]]; 
     (*\ Print["w = ", w]; Print["s = ", s]; *) 
aa = 10; 

    loren[i_, f_] := \ aa^2\ s[\([i]\)]/\((aa^2 + \((f - w[\([i]\)])\)^2)\); 
    
f[x_] = 0; 
	
    For[i = 1, i <= Length[w], \(i++\), 
	\ \ \ \ \ aux = loren[i, x]; 

      	\ \ \ \ f[x_] = f[x] + aux]; 

    Plot[f[x], {x, 0, 2000}, PlotRange -> All]\)

\(ClearAll[k, a, b, c, Jab, Jac, Jbc, aa]; k = 250; a = 0.2; b = 0.3; 
    c = 0.4; Jab = 0; Jac = 0; Jbc = 0; 
aa = 7; 
w = {}; s = {}; 

    For[i = 1, i <= 8, \(i++\), 
	
      For[j = i + 1, j <= 8, \(j++\), 
		
        If[int[[i, j]] > 10\^\(-3\), 
			AppendTo[s, int[[i, j]]]; 

          				\(AppendTo[w, \ 10  Abs[ener[[j]] - ener[[i]]]];\), \ \ 
          Continue\ ]
					]]; 
     (*\ Print["w = ", w]; Print["s = ", s]; *) 

    loren[i_, f_] := \ aa^2\ s[\([i]\)]/\((aa^2 + \((f - w[\([i]\)])\)^2)\); 
    
f[x_] = 0; 
	
    For[i = 1, i <= Length[w], \(i++\), 
	\ \ \ \ \ aux = loren[i, x]; 

      	\ \ \ \ f[x_] = f[x] + aux]; 

    Plot[f[x], {x, 0, 1500}, PlotRange -> All]\)

\(ClearAll[k, a, b, c, Jab, Jac, Jbc, aa]; k = 250; a = 0.1; b = 0.3; 
    c = 0.5; Jab = 5; Jac = 5; Jbc = 5; 
aa = 5; 
w = {}; s = {}; 

    For[i = 1, i <= 8, \(i++\), 
	
      For[j = i + 1, j <= 8, \(j++\), 
		
        If[int[[i, j]] > 10\^\(-3\), 
			AppendTo[s, int[[i, j]]]; 

          				\(AppendTo[w, \ 10  Abs[ener[[j]] - ener[[i]]]];\), \ \ 
          Continue\ ]
					]]; 
     (*\ Print["w = ", w]; Print["s = ", s]; *) 

    loren[i_, f_] := \ aa^2\ s[\([i]\)]/\((aa^2 + \((f - w[\([i]\)])\)^2)\); 
    
f[x_] = 0; 
	
    For[i = 1, i <= Length[w], \(i++\), 
	\ \ \ \ \ aux = loren[i, x]; 

      	\ \ \ \ f[x_] = f[x] + aux]; 

    Plot[f[x], {x, 0, 1500}, PlotRange -> All]\)

\(ClearAll[k, a, b, c, Jab, jac, jbc, aa]; k = 250; a = 0.1; b = 0.3; 
    c = 0.5; Jab = 10; Jac = 10; Jbc = 4; 
aa = 7; 
w = {}; s = {}; 

    For[i = 1, i <= 8, \(i++\), 
	
      For[j = i + 1, j <= 8, \(j++\), 
		
        If[int[[i, j]] > 10\^\(-3\), 
			AppendTo[s, int[[i, j]]]; 

          				\(AppendTo[w, \ 10  Abs[ener[[j]] - ener[[i]]]];\), \ \ 
          Continue\ ]
					]]; 
     (*\ Print["w = ", w]; Print["s = ", s]; *) 

    loren[i_, f_] := \ aa^2\ s[\([i]\)]/\((aa^2 + \((f - w[\([i]\)])\)^2)\); 
    
f[x_] = 0; 
	
    For[i = 1, i <= Length[w], \(i++\), 
	\ \ \ \ \ aux = loren[i, x]; 

      	\ \ \ \ f[x_] = f[x] + aux]; 

    Plot[f[x], {x, 0, 1500}, PlotRange -> All]\)