MNR (2 espins)

ClearAll["Global`*"]

\(M1 = 
      \(1\/2\) {{1, 0, 0, 0}, {0, 1, 0, 0}, {0, 0, \(-1\), 0}, {0, 0, 0, 
            \(-1\)}}; 

    M2 = \(1\/2\) {{1, 0, 0, 0}, {0, \(-1\), 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 
            \(-1\)}}; 

    M3 = \(1\/4\) {{1, 0, 0, 0}, {0, \(-1\), 0, 0}, {0, 0, \(-1\), 0}, {0, 0, 
            0, 1}}; 

    M4 = {{0, 0, 0, 0}, {0, 0, 1, 0}, {0, 1, 0, 0}, {0, 0, 0, 0}}; \)

k = 10; a = 0.5; b = 0.5; j = 0;

\(M = k\ \((1 - a)\)\ M1 + k\ \((1 - b)\)\ M2 + \ j\ M3 + \(j\/2\) M4; 

    sol = Eigensystem[M]\)

\(frec = Table[0, {i, 4}, {j, 4}]; 
int = Table[0, {i, 4}, {j, 4}]; 

    For[i = 1, i <= 4, \(i++\), 
	
      For[j = i + 1, j <= 4, \(j++\), 
		
        int[\([i, j]\)] = 
          \((sol[\([2, i, 1]\)] + sol[\([2, i, 4]\)])\)\ 
              \((sol[\([2, j, 2]\)] + sol[\([2, j, 3]\)])\) + 
            \((sol[\([2, i, 2]\)] + sol[\([2, i, 3]\)])\) 
              \((sol[\([2, j, 1]\)] + sol[\([2, j, 4]\)])\); 
		
        frec[\([i, j]\)] = Abs[sol[\([1, i]\)] - sol[\([1, j]\)]]; 
		]]; 
    
w = {}; s = {}; 

    For[i = 1, i <= 4, \(i++\), 
	
      For[j = i + 1, j <= 4, \(j++\), 
		
        If[int[\([i, j]\)]\^2 > 10\^\(-6\), 
			
          AppendTo[s, int[\([i, j]\)]]; 
				
          \(AppendTo[w, 1000\ frec[\([i, j]\)]]; \), \ \ Continue\ ]

        					]]; Print["w = ", w]; Print["s = ", s]; \)

\(aa = 100; 

    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, 10000}, PlotRange -> All]\)

\(ClearAll[M, k, a, b, j, sol]; 
k = 5; 
      a = 0.3; b = 0.3; j = 10; \)

\(M = k\ \((1 - a)\)\ M1 + k\ \((1 - b)\)\ M2 + \ j\ M3 + \(j\/2\) M4; 

    sol = Eigensystem[M]\)

\(frec = Table[0, {i, 4}, {j, 4}]; 
int = Table[0, {i, 4}, {j, 4}]; 

    For[i = 1, i <= 4, \(i++\), 
	
      For[j = i + 1, j <= 4, \(j++\), 
		
        int[[i, j]] = 
          \((sol[[2, i, 1]] + sol[[2, i, 4]])\)\ 
              \((sol[[2, j, 2]] + sol[[2, j, 3]])\) + 
            \((sol[[2, i, 2]] + sol[[2, i, 3]])\) 
              \((sol[[2, j, 1]] + sol[[2, j, 4]])\); 
		
        frec[[i, j]] = Abs[sol[[1, i]] - sol[[1, j]]]; 
		]]; 
w = {}; 
    s = {}; 
For[i = 1, i <= 4, \(i++\), 
	
      For[j = i + 1, j <= 4, \(j++\), 
		
        If[int[\([i, j]\)]\^2 > 10\^\(-6\), 
			
          AppendTo[s, int[\([i, j]\)]]; 
				
          \(AppendTo[w, 1000\ frec[\([i, j]\)]]; \), \ \ Continue\ ]

        					]]; Print["w = ", w]; Print["s = ", s]; \)

\(aa = 100; 

    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, 10000}, PlotRange -> All]\)

\(ClearAll[M, k, a, b, j, sol]; 
k = 10; 
      a = 0.3; b = 0.7; j = 0; \)

\(M = k\ \((1 - a)\)\ M1 + k\ \((1 - b)\)\ M2 + \ j\ M3 + \(j\/2\) M4; 

    sol = Eigensystem[M]\)

\(frec = Table[0, {i, 4}, {j, 4}]; 
int = Table[0, {i, 4}, {j, 4}]; 

    For[i = 1, i <= 4, \(i++\), 
	
      For[j = i + 1, j <= 4, \(j++\), 
		
        int[[i, j]] = 
          \((sol[[2, i, 1]] + sol[[2, i, 4]])\)\ 
              \((sol[[2, j, 2]] + sol[[2, j, 3]])\) + 
            \((sol[[2, i, 2]] + sol[[2, i, 3]])\) 
              \((sol[[2, j, 1]] + sol[[2, j, 4]])\); 
		
        frec[[i, j]] = Abs[sol[[1, i]] - sol[[1, j]]]; 
		]]; 
w = {}; 
    s = {}; 
For[i = 1, i <= 4, \(i++\), 
	
      For[j = i + 1, j <= 4, \(j++\), 
		
        If[int[\([i, j]\)]\^2 > 10\^\(-6\), 
			
          AppendTo[s, int[\([i, j]\)]]; 
				
          \(AppendTo[w, 1000\ frec[\([i, j]\)]]; \), \ \ Continue\ ]

        					]]; Print["w = ", w]; Print["s = ", s]; \)

\(aa = 100; 

    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, 10000}, PlotRange -> All]\)

(* Cas acoblament diagonal  i distinta pantalla, a  ≠  b, 
En aquest cas fem j ≠ 0 i j petit, però NO incloem M4 *)
\(ClearAll[M, k, a, b, j, sol]; 
k = 10; a = 0.3; b = 0.7; j = 1; 
      \)

\(M = k\ \((1 - a)\)\ M1 + k\ \((1 - b)\)\ M2 + \ j\ M3; 

    sol = Eigensystem[M]\)

\(frec = Table[0, {i, 4}, {j, 4}]; 
int = Table[0, {i, 4}, {j, 4}]; 

    For[i = 1, i <= 4, \(i++\), 
	
      For[j = i + 1, j <= 4, \(j++\), 
		
        int[[i, j]] = 
          \((sol[[2, i, 1]] + sol[[2, i, 4]])\)\ 
              \((sol[[2, j, 2]] + sol[[2, j, 3]])\) + 
            \((sol[[2, i, 2]] + sol[[2, i, 3]])\) 
              \((sol[[2, j, 1]] + sol[[2, j, 4]])\); 
		
        frec[[i, j]] = Abs[sol[[1, i]] - sol[[1, j]]]; 
		]]; 
w = {}; 
    s = {}; 
For[i = 1, i <= 4, \(i++\), 
	
      For[j = i + 1, j <= 4, \(j++\), 
		
        If[int[\([i, j]\)]\^2 > 10\^\(-6\), 
			
          AppendTo[s, int[\([i, j]\)]]; 
				
          \(AppendTo[w, 1000\ frec[\([i, j]\)]]; \), \ \ Continue\ ]

        					]]; Print["w = ", w]; Print["s = ", s]; \)

\(aa = 100; 

    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, 10000}, PlotRange -> All]\)

(* Cas acoblament diagonal  i distinta pantalla, a  ≠  b, 
En aquest cas fem j ≠ 0 i j gran, però NO incloem M4 *)
\(ClearAll[M, k, a, b, j, sol]; 
k = 10; a = 0.3; b = 0.7; j = 5; 
      \)

\(M = k\ \((1 - a)\)\ M1 + k\ \((1 - b)\)\ M2 + \ j\ M3; 

    sol = Eigensystem[M]\)

\(frec = Table[0, {i, 4}, {j, 4}]; 
int = Table[0, {i, 4}, {j, 4}]; 

    For[i = 1, i <= 4, \(i++\), 
	
      For[j = i + 1, j <= 4, \(j++\), 
		
        int[[i, j]] = 
          \((sol[[2, i, 1]] + sol[[2, i, 4]])\)\ 
              \((sol[[2, j, 2]] + sol[[2, j, 3]])\) + 
            \((sol[[2, i, 2]] + sol[[2, i, 3]])\) 
              \((sol[[2, j, 1]] + sol[[2, j, 4]])\); 
		
        frec[[i, j]] = Abs[sol[[1, i]] - sol[[1, j]]]; 
		]]; 
w = {}; 
    s = {}; 
For[i = 1, i <= 4, \(i++\), 
	
      For[j = i + 1, j <= 4, \(j++\), 
		
        If[int[\([i, j]\)]\^2 > 10\^\(-6\), 
			
          AppendTo[s, int[\([i, j]\)]]; 
				
          \(AppendTo[w, 1000\ frec[\([i, j]\)]]; \), \ \ Continue\ ]

        					]]; Print["w = ", w]; Print["s = ", s]; \)

\(aa = 100; 

    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, 12000}, PlotRange -> All]\)

\(ClearAll[M, k, a, b, j, sol]; 
k = 10; 
      a = 0.3; b = 0.7; j = 1; \)

\(M = k\ \((1 - a)\)\ M1 + k\ \((1 - b)\)\ M2 + \ j\ M3 + \(j\/2\) M4; 

    sol = Eigensystem[M]\)

\(frec = Table[0, {i, 4}, {j, 4}]; 
int = Table[0, {i, 4}, {j, 4}]; 

    For[i = 1, i <= 4, \(i++\), 
	
      For[j = i + 1, j <= 4, \(j++\), 
		
        int[[i, j]] = 
          \((sol[[2, i, 1]] + sol[[2, i, 4]])\)\ 
              \((sol[[2, j, 2]] + sol[[2, j, 3]])\) + 
            \((sol[[2, i, 2]] + sol[[2, i, 3]])\) 
              \((sol[[2, j, 1]] + sol[[2, j, 4]])\); 
		
        frec[[i, j]] = Abs[sol[[1, i]] - sol[[1, j]]]; 
		]]; 
w = {}; 
    s = {}; 
For[i = 1, i <= 4, \(i++\), 
	
      For[j = i + 1, j <= 4, \(j++\), 
		
        If[int[\([i, j]\)]\^2 > 10\^\(-6\), 
			
          AppendTo[s, int[\([i, j]\)]]; 
				
          \(AppendTo[w, 1000\ frec[\([i, j]\)]]; \), \ \ Continue\ ]

        					]]; Print["w = ", w]; Print["s = ", s]; \)

s = (-1) s

\(aa = 100; 

    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, 10000}, PlotRange -> All]\)

(* Cas  limit,  J gran,  i distinta pantalla,  
          a  ≠  b,  *)
\(ClearAll[M, k, a, b, j, sol]; 
k = 10; 
      a = 0.3; b = 0.7; j = 12; \)

\(M = k\ \((1 - a)\)\ M1 + k\ \((1 - b)\)\ M2 + \ j\ M3 + \(j\/2\) M4; 

    sol = Eigensystem[M]\)

\(frec = Table[0, {i, 4}, {j, 4}]; 
int = Table[0, {i, 4}, {j, 4}]; 

    For[i = 1, i <= 4, \(i++\), 
	
      For[j = i + 1, j <= 4, \(j++\), 
		
        int[[i, j]] = 
          \((sol[[2, i, 1]] + sol[[2, i, 4]])\)\ 
              \((sol[[2, j, 2]] + sol[[2, j, 3]])\) + 
            \((sol[[2, i, 2]] + sol[[2, i, 3]])\) 
              \((sol[[2, j, 1]] + sol[[2, j, 4]])\); 
		
        frec[[i, j]] = Abs[sol[[1, i]] - sol[[1, j]]]; 
		]]; 
w = {}; 
    s = {}; 
For[i = 1, i <= 4, \(i++\), 
	
      For[j = i + 1, j <= 4, \(j++\), 
		
        If[int[\([i, j]\)]\^2 > 10\^\(-6\), 
			
          AppendTo[s, int[\([i, j]\)]]; 
				
          \(AppendTo[w, 1000\ frec[\([i, j]\)]]; \), \ \ Continue\ ]

        					]]; Print["w = ", w]; Print["s = ", s]; \)

s = (-1) s

\(aa = 100; 

    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, 22000}, PlotRange -> All]\)