\(drift[
              l_] := {{1, l, 0, 0, 0}, 
			{0, 1, 0, 0, 0}, 
			{0, 
                0, 1, l, 0}, 
			{0, 0, 0, 1, 0}, 
			{0, 0, 0, 0, 
                1}}\)
\(\(sq[k_] := \@Abs[k];\)\(
\)
          \(		\)\)
c[k_, l_] := 
            Which[k < 0.0, Cosh[l sq[k]], k == 0, 1. , k > 0.0, 
              Cos[l sq[k]], True, Cosh[I l (Sqrt[k])]]
s[k_, l_] := 
            Which[k < 0.0, Sinh[l sq[k]]/sq[k], k == 0, l, k > 0, 
              Sin[l sq[k]]/sq[k], True, Sinh[I l (Sqrt[k])]/((Sqrt[k]) I)]
cs[k_, l_] := Cos[l (Sqrt[k])]

ch[k_, l_] := Cosh[l (Sqrt[-k])]
sh[k_, l_] := Sinh[l (Sqrt[-k])]/(Sqrt[-k])
\(quad[k_, 
              l_] := {{c[k, l], s[k, l], 0, 0, 
                0}, 
				{\(-k\)\ s[k, l], c[k, l], 0, 0, 
                0}, 
			\ \ \ \ \ \ \ \ \ \ {0, 0, c[\(-k\), l], 
                s[\(-k\), l], 0}, 
				{0, 0, k\ s[\(-k\), l], 
                c[\(-k\), l], 0}, 
				{0, 0, 0, 0, 1}}\)
\(qf[k_, 
              l_] := {{cs[k, l], ss[k, l], 0, 0, 
                0}, 
				{\(-k\)\ ss[k, l], cs[k, l], 0, 0, 
                0}, 
				{0, 0, ch[\(-k\), l], sh[\(-k\), l], 
                0}, 
				{0, 0, k\ sh[\(-k\), l], ch[\(-k\), l], 
                0}, 
				{0, 0, 0, 0, 1}}\)
\(qd[k_, 
              l_] := {{ch[k, l], sh[k, l], 0, 0, 
                0}, 
					{\(-k\)\ sh[k, l], ch[k, l], 0, 0, 
                0}, 
					{0, 0, cs[\(-k\), l], ss[\(-k\), l], 
                0}, 
					{0, 0, k\ ss[\(-k\), l], cs[\(-k\), l], 
                0}, 
					{0, 0, 0, 0, 1}}\)
\(quaddelta[
              k_] := {{1, 0, 0, 0, 0}, 
					{\(-k\), 1, 0, 0, 
                0}, 
					{0, 0, 1, 0, 0}, 
						{0, 0, k, 1, 
                0}, 
					{0, 0, 0, 0, 1}}\)
qel[k_, l_] := 
            drift[(l/2)] . quaddelta[k l] . drift[(l/2.) ]
\(edge[rho_, teta_, gap_] := 
            Block[{t}, 
              t = \(0.5\ gap\ \((1 + Sin[teta]\^2)\)\)\/\(rho\ Cos[teta]\); 
											{{1, 0, 0, 0, 
                  0}, 
											{Tan[teta]\/rho, 1, 0, 0, 
                  0}, 
											{0, 0, 1, 0, 
                  0}, 
											{0, 0, \(-\(Tan[teta]\/rho\)\), 
                  1, 0}, 
											{0, 0, 0, 0, 1}}]\)
\(\(	\)\(bend[rho_, k_, l_, e1_, e2_, gap_] := 
            Block[{t, z}, 
              t = 1\/rho\^2 - k; 
										z = 
                edge[rho, e2, 
                    gap] . {{c[t, l], s[t, l], 0, 
                      0, \(1 - c[t, l]\)\/\(t\ rho\)}, 
																																	{\(-t\)\ s[t, l], c[t, l], 0, 
                      0, s[t, l]\/rho}, 
																																	{0, 0, c[k, l], s[k, l], 
                      0}, 
																																	{0, 0, \(-k\)\ s[k, l], c[k, l], 
                      0}, 
																																	{0, 0, 0, 0, 1}} . edge[rho, e1, gap]; Return[z]]\)\)
\(miror[
              m_] := {{m[[2, 2]], 
                m[[1, 2]], 0, 0, 
                m[[2, 
                      5]]\ m[[1, 
                      2]] - 
                  m[[1, 
                      5]]\ m[[2, 
                      2]]}, 
													{m[[2, 1]], 
                m[[1, 1]], 0, 0, 
                m[[2, 
                      5]]\ m[[1, 
                      1]] - 
                  m[[1, 
                      5]]\ m[[2, 
                      1]]}, 
													{0, 0, m[[4, 4]], 
                m[[3, 4]], 
                0}, 
													{0, 0, 
                m[[4, 3]], 
                m[[3, 3]], 
                0}, 
													{0, 0, 0, 0, 1}}\)
tune[a_, b_, c_, n_] := 
            Block[{z, t}, z =  ArcCos[0.5 (a + b)]/(2 N[π]); 
              If[c > 0, t = n z, t = n (1 - z), t = n z]; Return[t]]
(*cette transformation est pour obtenir la matrice de transfer en betah,alfah,
gamah,betav,alfav,gamav,D,D',dp/p,ctg[uh],ctg[uv]*)
\(totwiss[
        m_] := {{m[\([1, 1]\)]^2, \(-2\)*m[\([1, 1]\)]*m[\([1, 2]\)], 
          m[\([1, 2]\)]^2, 0, 0, 0, 0, 0, 0, 0, 
          0}, 
	\ {\(-m[\([1, 1]\)]\)*m[\([2, 1]\)], 
          m[\([1, 1]\)]*m[\([2, 2]\)] + 
            m[\([1, 2]\)]*m[\([2, 1]\)], \(-m[\([1, 2]\)]\)*m[\([2, 2]\)], 0, 
          0, 0, 0, 0, 0, 0, 
          0}, 
	\ {m[\([2, 1]\)]^2, \(-2\)*m[\([2, 1]\)]*m[\([2, 2]\)], 
          m[\([2, 2]\)]^2, 0, 0, 0, 0, 0, 0, 0, 0}, 
	\ {0, 0, 0, 
          m[\([3, 3]\)]^2, \(-2\)*m[\([3, 3]\)]*m[\([3, 4]\)], 
          m[\([3, 4]\)]^2, 0, 0, 0, 0, 0}, 
	{0, 0, 
          0, \(-m[\([3, 3]\)]\)*m[\([4, 3]\)], 
          m[\([3, 3]\)]*m[\([4, 4]\)] + 
            m[\([3, 4]\)]*m[\([4, 3]\)], \(-m[\([3, 4]\)]\)*m[\([4, 4]\)], 0, 
          0, 0, 0, 0}, 
	{0, 0, 0, 
          m[\([4, 3]\)]^2, \(-2\)*m[\([4, 3]\)]*m[\([4, 4]\)], 
          m[\([4, 4]\)]^2, 0, 0, 0, 0, 0}, 
	\ {0, 0, 0, 0, 0, 0, 
          m[\([1, 1]\)], m[\([1, 2]\)], m[\([1, 5]\)], 0, 0}, 
	{0, 0, 0, 
          0, 0, 0, m[\([2, 1]\)], m[\([2, 2]\)], m[\([2, 5]\)], 0, 
          0}, 
	\ {0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 
          0}, 
	{m[\([1, 1]\)]/m[\([1, 2]\)], \(-1\), 0, 0, 0, 0, 0, 0, 0, 
          0, 0}, 
	{0, 0, 0, m[\([3, 3]\)]/m[\([3, 4]\)], \(-1\), 0, 0, 0, 
          0, 0, 0}}\)
dgam[d_, r_, rho_, k_, l_] := 
        Block[{t, z}, t = (1/(rho^2)) - k; 
          z = (((d[[1]] - (1. /(t rho))) r[[1, 2]] + ((d[[2]] (1.  - r[[1, 1]]) + (l/rho))/t))/rho); Return[z]]
twiss[m_]:=\(Module[{smuh, smuv, md}, 
        smuh = Sign[m[\([1, 2]\)]]*
            Sqrt[1 - \((m[\([1, 1]\)] + m[\([2, 2]\)])\)^2/4]; 
	
        smuv = Sign[m[\([3, 4]\)]]*
            Sqrt[1 - \((m[\([3, 3]\)] + m[\([4, 4]\)])\)^2/4]; 
        md = m[\([1, 1]\)] + m[\([2, 2]\)] - 2; 
	{m[\([1, 2]\)]/
            smuh, \(\((m[\([1, 1]\)] - m[\([2, 2]\)])\)/2\)/
            smuh, \(-m[\([2, 1]\)]\)/smuh, 
		m[\([3, 4]\)]/
            smuv, \(\((m[\([3, 3]\)] - m[\([4, 4]\)])\)/2\)/
            smuv, \(-m[\([4, 3]\)]\)/
            smuv, 
	\((\((m[\([2, 2]\)] - 1)\)\ m[\([1, 5]\)] - 
                m[\([1, 2]\)]\ m[\([2, 5]\)])\)/
            md, \((\((m[\([1, 1]\)] - 1)\)\ m[\([2, 5]\)] - 
                m[\([2, 1]\)]\ \ m[\([1, 5]\)])\)/md, 1, 0, 0}]\)
Null

ClearAll[mat,matg]
nelem=10;
l1=2.654;l2=0.368;l3=0.653;l4=0.653;l5=0.368;nper=16;radius=25;
kfo=0.762408;lf=0.5035;qh0=4.17;qv0=5.23;
kde=-0.814989;ld=0.879;
teta=.19635;lb=1.6177;edg=teta/2;bd=bend[lb/teta,0,lb,edg,edg,0.07];
epsh=160;epsv=120;dpsp=0.002;
sl={l1,lb,l2,lf,l3,ld,l4,lf,l5,lb};
spos=Table[0,{i,1,nelem+1}];Do[spos[[i]]=spos[[i-1]]+sl[[i-1]],{i,2,nelem+1}]
matg[kf_,kd_]:=bd.drift[l5].quad[kf,lf].drift[l4].quad[kd,ld].drift[l3].quad[kf,lf].drift[l2].bd.drift[l1]
(*calcul de la matrice dq to dk, this is mqtok this is computed  for PSB*)
mqtok=Inverse[{{9.343,4.266},{-9.976,-20.95}}];
MatrixForm[mqtok]

(* compute the quad strength for the wanted tune qh,qv and return the real tune and the twiss params at the beginning of straigth sections*)
param[qh_,qv_]:=Module[{mq,mat,kkfo,kkde,qhc,qvc,smuh,smuv,twisc,alltwiss,mm,mr},
	mq=mqtok.{qh-qh0,qv-qv0};kkfo=kfo+mq[[1]];kkde=kde+mq[[2]];
	mat=matg[kkfo,kkde];
	qhc=tune[mat[[1,1]],mat[[2,2]],mat[[1,2]],nper];
	qvc=tune[mat[[3,3]],mat[[4,4]],mat[[3,4]],nper];
	Print["qh= ",qhc," qv=",qvc];
	smuh=Sin[2 Pi qh/nper];smuv=Cos[2 Pi qv/nper];
	twisc=twiss[mat];
	alltwiss={twisc,twisc,twisc,twisc,twisc,twisc};
	mm={bd.drift[l1],quad[kkfo,lf].drift[l2],quad[kkde,ld].drift[l3],quad[kkfo,lf].drift[l4],bd.drift[l5]};
	mr=mm;Do[mr[[i]]=totwiss[mm[[i]]],{i,1,5}];
	Do[alltwiss[[i]]=mr[[i-1]].alltwiss[[i-1]],{i,2,6}];
	Do[alltwiss[[i,10]]=ArcTan[1/alltwiss[[i,10]]]+alltwiss[[i-1,10]];
		alltwiss[[i,11]]=ArcTan[1/alltwiss[[i,11]]]+alltwiss[[i-1,11]],{i,2,6}];{{qhc,qvc},alltwiss}]

(* print the twiss params in a readable manner*)		
infop[par_]:=Module[{info,infox,allinfo},
	info={"posit ","beg L1", "beg L2","beg L3","beg L4","beg L5","end B2"};
	infox={info[[1]],"betah","alfah","betav","alfav","disp","ddisp","muh","muv"};
	allinfo=Table[infox,{i,1,7}];
	Do[allinfo[[i+1]]={info[[i+1]],Chop[par[[i,1]]],Chop[par[[i,2]]],Chop[par[[i,4]]],Chop[par[[i,5]]],
		Chop[par[[i,7]]],Chop[par[[i,8]]],Chop[par[[i,10]]],Chop[par[[i,11]]]},{i,1,6}];allinfo]

par=param[4.29,4.2][[2]]
alinfo=infop[par];

TableForm[alinfo,TableAlignments->Center]

(*CALCUL DE LA RESONANCE*)
ClearAll[hr]
tobet[b0_,a0_,d_]:=b0-2*d*a0+(1+a0^2)/b0*d^2;(*beta at a given distance*)
toalfa[b0_,a0_,d_]:=a0-(1+a0^2)/b0*d^2;(*alfa at a given distance*)
tomu[b0_,a0_,d_]:=ArcTan[d/(b0-d a0)];(*phase advance at a given distance*)
h[n_,m_,p_,qhc_,qvc_,betah_,betav_,muh_,muv_,s_,k_]:=Module[{nt,nx,ny},nt=(Abs[n]+Abs[m])/2;
	nx=Abs[n];ny=Abs[m];
	k*betah^(nx/2) betav^(ny/2)*Exp[I (n muh+m muv-(n qhc+m qvc -p)*s/radius)]
	/2/Pi/(2 radius)^(nt)/Factorial[nx]/Factorial[ny]](* compute the hijklp for the résonance*)

(* compute the hijklp for each corrector*)
calres[res_,cor_,icor_]:=Module[{hu,par1,par,j,bh,bv,mh,mv,ssect,d,s,ncr},hu=0;ncr=Length[cor];
	par1=param[res[[4]],res[[5]]];
	par=par1[[2]];qhc=par1[[1,1]];qvc=par1[[1,2]];
	Do[Do[j=2+4*(i-1);ssect=cor[[k,j+1]];d=cor[[k,j+2]];s=(cor[[k,j]]-1)*2*Pi*radius/nper+d;
	bh=tobet[par[[ssect,1]],par[[ssect,2]],d];
	mh=(cor[[k,j]]-1)*par[[6,10]]+tomu[par[[ssect,1]],par[[ssect,2]],d]+par[[ssect,10]];
	bv=tobet[par[[ssect,4]],par[[ssect,5]],d];
	mv=(cor[[k,j]]-1)*par[[6,11]]+tomu[par[[ssect,4]],par[[ssect,5]],d]+par[[ssect,11]];
	hu=hu+h[res[[1]],res[[2]],res[[3]],qhc,qvc,bh,bv,mh,mv,s,cor[[k,j+3]]*icor[[k]]],{i,1,1}],{k,1,ncr}];hu];

(*compute the resonance width*)
reswidth[res_,kapa_,epsh_,epsv_]:=Module[{kap,n1x,n1y,nt},kap=Abs[kapa];
		n1x=(res[[1]]-2)/2;n2x=(res[[2]]-2)/2;nt=(n1x+n2x-2)/2;2 kap *(radius/2/Pi)]
		
(*gives betah,muh,betav,muv at a given position*)		
thedat[mach_,cor_,npos_]:=Module[{hr,par1,par,bh,bv,mh,mv,ssect,d,s},hr=Table[{0,0,0,0},{i,1,npos}];
	par1=param[mach[[1]],mach[[2]]];
	par=par1[[2]];qhc=par1[[1,1]];qvc=par1[[1,2]];
	Do[ssect=cor[[i,3]];d=cor[[i,4]];s=(cor[[i,2]]-1)*2*Pi*radius/nper+d;bh=tobet[par[[ssect,1]],par[[ssect,2]],d];
	mh=(cor[[i,2]]-1)*par[[6,10]]+tomu[par[[ssect,1]],par[[ssect,2]],d]+par[[ssect,10]];
	bv=tobet[par[[ssect,4]],par[[ssect,5]],d];
	mv=(cor[[i,2]]-1)*par[[6,11]]+tomu[par[[ssect,4]],par[[ssect,5]],d]+par[[ssect,11]];
	hr[[i]]={bh,mh,bv,mv},{i,1,npos}];hr];

(*________________________________________________________*)
(*sextupoles skew type A in L1, Type B in L4*)
ClearAll[thecurrent]
kskewa=2.33/270;kskewb=3.0/270;anal="BR1.";
corrector={{anal<>"XSK2L4",2,4,l4/2,kskewb,i2l4},
		   {anal<>"XSK4L1",4,1,0.33,kskewa,i4l1},
		   {anal<>"XSK6L1",6,1,0.33,kskewa,i6l1},
		   {anal<>"XSK6L4",6,4,l4/2,kskewb,i6l4},
		   {anal<>"XSK9L1",9,1,2.1,kskewa,i9l1},
		   {anal<>"XSK11L4",11,4,0.33,kskewb,i11l4},
		   {anal<>"XSK12L1",12,1,2.1,kskewa,i12l1},
		   {anal<>"XSK12L4",12,4,0.33,kskewb,i12l4}};

ncor=Length[corrector]
dy=1/ncor;
allsext=Show[Table[Graphics[{Hue[1-dy*(i-1)],Rectangle[{0.0,1-dy*i},{0.5,1-dy*(i-1)}],
      RGBColor[1,1,1],Text[corrector[[i,1]],{0.25,1-dy*(i-0.5)}]}],{i,1,ncor}],TextStyle->{FontSize->14},DisplayFunction->Identity]
machina={4.29,4.2};
resonance={0,3,13,machina[[1]],machina[[2]]};toc=z_Complex->{Re[z],Im[z]};
icorrector=Table[Table[0,{i,1,ncor}],{i,1,ncor}];
h0030=calres[resonance,corrector,{0,0,0,0,31,0,0,0}]
reswidth[resonance,h0030,40 e-6, 30 e-6]
resonanc1={2,1,13,machina[[1]],machina[[2]]};
h2010=calres[resonanc1,corrector,{0,0,0,0,31,0,0,0}]
reswidth[resonanc1,h2010,40 e-6, 30 e-6]

Do[icorrector[[i,i]]=100,{i,1,ncor}]
resonance={0,3,13,machina[[1]],machina[[2]]};
h0030a=Table[calres[resonance,corrector,icorrector[[i]]],{i,1,ncor}]
Abs[h0030a]
um=Max[%]
allg=Table[Graphics[{Hue[1-dy*(i-1)],Thickness[0.01],Line[{{0,0},{Re[h0030a[[i]]],Im[h0030a[[i]]]}}]}],{i,1,ncor}]
Show[GraphicsArray[{Show[allg,Frame->True,
        PlotRange->{{-um,um},{-um,um}},AspectRatio->1,
        PlotLabel->"h0030 pour I=100A",DisplayFunction->Identity],
      allsext},GraphicsSpacing->.1]]

resonanc1={2,1,13,machina[[1]],machina[[2]]};
h2010a=Table[calres[resonanc1,corrector,icorrector[[i]]],{i,1,ncor}]
Abs[h2010a]
um= Max[%]
allg=Table[Graphics[{Hue[1-dy*(i-1)],Thickness[0.01],Line[{{0,0},{Re[h2010a[[i]]],Im[h2010a[[i]]]}}]}],{i,1,ncor}]
Show[GraphicsArray[{Show[allg,Frame->True,
        PlotRange->{{-um,um},{-um,um}},AspectRatio->1,
        PlotLabel->"h2010 pour I=100A",DisplayFunction->Identity],
      allsext},GraphicsSpacing->.1]]
      h2010a=Table[calres[resonanc1,corrector,icorrector[[i]]],{i,1,ncor}]

resonanc2={2,-1,4,machina[[1]],machina[[2]]};
h2001a=Table[calres[resonanc2,corrector,icorrector[[i]]],{i,1,ncor}]
Abs[h2001a]
um= Max[%]
allg=Table[Graphics[{Hue[1-dy*(i-1)],Thickness[0.01],Line[{{0,0},{Re[h2001a[[i]]],Im[h2001a[[i]]]}}]}],{i,1,ncor}]
Show[GraphicsArray[{Show[allg,Frame->True,
        PlotRange->{{-um,um},{-um,um}},AspectRatio->1,
        PlotLabel->"h2001 pour I=100A",DisplayFunction->Identity],
      allsext},GraphicsSpacing->.1]]

r0h3v13={0, 3, 13, machina[[1]], machina[[2]]}
r2h1v13={2, 1, 13, machina[[1]], machina[[2]]}
r0h3v14={0, 3, 14, machina[[1]], machina[[2]]}
r2hm1v4={2, -1, 4, machina[[1]], machina[[2]]}


mes1 = 
          calres[r0h3v13, corrector, {5, 0, 0, 0, 0, 0, 0, 0}]


cal1 = 
          calres[r0h3v13, corrector, {i2l4, i4l1, i6l1, i6l4, 0, 0, 0, 0}]
mes2 = 
          calres[r2h1v13, corrector, {5, 0, 8, 0, 0, 0, 0, 0}]
mes2 = 
          calres[r2h1v13, corrector, {5, 0, 0, 0, 0, -4, 0, 0}]
cal2 = 
          calres[r2h1v13, corrector, {i2l4, i4l1, i6l1, i6l4, 0, 0, 0, 0}]
toput = 
          Solve[Reduce[
              mes1 == cal1 && 
                mes2 == 
                  cal2  && (i2l4 | i4l1 | i6l1 | i6l4) ∈ 
                  Reals, {i2l4, i4l1, i6l1, i6l4}], {i2l4, i4l1, i6l1, 
              i6l4}]

calres[r0h3v14, 
            corrector, {i2l4, i4l1, i6l1, i6l4, 0, 0, 0, 0}] /. toput
Abs[%]

ClearAll[thecurrent]
knora = 2.25/270; 
        kskewb = 3.0/270; anal = "BR1.";
\(corrector = {{anal <> "XNO3L1", 3, 1, 
                1.4, knora, 
                i4l1}, 
		\ \ \ {anal <> "XNO4L1", 4, 
                1, 0.33, knora, 
                i4l1}, 
	\ \ \ \ \ \ \ \ \ \ \ \ {anal <> "XNO6L1", 6, 1, 0.33, knora, 
                i6l1}, 
		\ \ \ {anal <> "XNO8L1", 8, 
                1, 0.33, knora, 
                i8l1}, 
		\ \ \ {anal <> "XNO9L1", 9, 
                1, 2.1, knora, 
                i9l1}, 
		\ \ \ {anal <> "XNO12L1", 
                12, 1, 2.1, knora, i12l1}};\)
ncor = Length[corrector]
dy = 1/ncor;
allsext = 
          Show[Table[
              Graphics[{Hue[1 - dy*(i - 1)], 
                  Rectangle[{0.0, 1 - dy*i}, {0.5, 1 - dy*(i - 1)}], 
                  RGBColor[1, 1, 1], 
                  Text[corrector[[i, 1]], {0.25, 
                      1 - dy*(i - 0.5)}]}], {i, 1, ncor}], 
            TextStyle -> {FontSize -> 14}, 
            DisplayFunction -> Identity]

Do[
          icorrector[[i, i]] = 100, {i, 1, ncor}]
resonance={3, 0, 13, 4.33, machina[[2]]};h3000a = 
            Table[calres[resonance, corrector, icorrector[[i]]], {i, 1, 
                ncor}]
Abs[h3000a]
um = Max[Abs[h3000a]]
allg = 
          Table[Graphics[{Hue[1 - dy*(i - 1)], Thickness[0.01], 
                Line[{{0, 0}, {Re[h3000a[[i]]], 
                      Im[h3000a[[i]]]}}]}], {i, 1, ncor}]
Show[
          GraphicsArray[{Show[allg, Frame -> True, 
                PlotRange -> {{-um, um}, {-um, um}}, 
                AspectRatio -> 1, 
                PlotLabel -> "h3000 pour I=100A", 
                DisplayFunction -> Identity], allsext}, 
            GraphicsSpacing ->  .1]]

resonanc1={1, 2, 13, machina[[1]], machina[[2]]};
h1020a = 
          Table[calres[resonanc1, corrector, icorrector[[i]]], {i, 1, 
              ncor}]
Abs[h1020a]
um = Max[%]
allg = 
          Table[Graphics[{Hue[1 - dy*(i - 1)], Thickness[0.01], 
                Line[{{0, 0}, {Re[h1020a[[i]]], 
                      Im[h1020a[[i]]]}}]}], {i, 1, ncor}]
Show[
          GraphicsArray[{Show[allg, Frame -> True, 
                PlotRange -> {{-um, um}, {-um, um}}, 
                AspectRatio -> 1, 
                PlotLabel -> "h1020 pour I=100A", 
                DisplayFunction -> Identity], Show[allsext]}, 
            GraphicsSpacing ->  .1]]

r3h0v13={3, 0, 13, machina[[1]], machina[[2]]}
r1h2v13={2, 1, 13, machina[[1]], machina[[2]]}
mes1 = 
      calres[r3h0v13, 
        corrector, {0, 15, 0, 0, 0, 10}]
cal1 = 
      calres[r3h0v13, 
        corrector, {i3l1, i4l1, i6l1, 0, i9l1, 
          0}]
mes2 = 
      calres[r1h2v13, 
        corrector, {0, 20, 0, 0, 0, 1}]
cal2 = 
        calres[r1h2v13, corrector, {i3l1, i4l1, i6l1, 0, i9l1, 0}]

toput = 
      Solve[Reduce[
          mes1 == cal1 && 
            mes2 == 
              cal2  && (i4l1 | i6l1 | i9l1 | i3l1) ∈ 
              Reals, {i4l1, i6l1, i9l1, i3l1}], {i4l1, i6l1, i9l1, 
          i3l1}]
uu = 
      calres[r3h0v13, corrector, {0, -15, 0, 0, 0, -10}] + 
        calres[r3h0v13, 
          corrector, {0, 20, 0, 0, 0, 1}]
Abs[
      uu]
Abs[mes1]

ClearAll[thecurrent]
knora = 183.5/270; 
        anal = "BR1.";
\(corrector = {{anal <> "ONO3L1", 3, 1, 
                1.4, knora, 
                i4l1}, 
		\ \ \ {anal <> "ONO4L1", 4, 
                1, 0.33, knora, 
                i4l1}, 
	\ \ \ \ \ \ \ \ \ \ \ \ {anal <> "ONO6L1", 6, 1, 0.33, knora, 
                i6l1}, 
		\ \ \ {anal <> "ONO8L1", 8, 
                1, 0.33, knora, 
                i8l1}, 
		\ \ \ {anal <> "ONO9L1", 9, 
                1, 2.1, knora, 
                i9l1}, 
		\ \ \ {anal <> "ONO12L1", 
                12, 1, 2.1, knora, i12l1}};\)
ncor = Length[corrector]
dy = 1/ncor;
allsext = 
          Show[Table[
              Graphics[{Hue[1 - dy*(i - 1)], 
                  Rectangle[{0.0, 1 - dy*i}, {0.5, 1 - dy*(i - 1)}], 
                  RGBColor[1, 1, 1], 
                  Text[corrector[[i, 1]], {0.25, 
                      1 - dy*(i - 0.5)}]}], {i, 1, ncor}], 
            TextStyle -> {FontSize -> 14}, 
            DisplayFunction -> Identity]

Do[icorrector[[i, i]] = 100, {i, 1, ncor}]
resonance={0, 4, 18, machina[[1]], machina[[2]]};h004018 = 
            Table[calres[resonance, corrector, icorrector[[i]]], {i, 1, 
                ncor}]
Abs[h004018]
um = Max[%]
allg = 
          Table[Graphics[{Hue[1 - dy*(i - 1)], Thickness[0.01], 
                Line[{{0, 0}, {Re[h004018[[i]]], 
                      Im[h004018[[i]]]}}]}], {i, 1, ncor}]
Show[
          GraphicsArray[{Show[allg, Frame -> True, 
                PlotRange -> {{-um, um}, {-um, um}}, 
                AspectRatio -> 1, 
                PlotLabel -> "h004018 pour I=100A", 
                DisplayFunction -> Identity], allsext}, 
            GraphicsSpacing ->  .1]]

resonanc1={0, 4, 17, machina[[1]], machina[[2]]};
h004017 = 
          Table[calres[resonanc1, corrector, icorrector[[i]]], {i, 1, 
              ncor}]
Abs[h004017]
um = Max[%]
allg = 
          Table[Graphics[{Hue[1 - dy*(i - 1)], Thickness[0.01], 
                Line[{{0, 0}, {Re[h004017[[i]]], 
                      Im[h004017[[i]]]}}]}], {i, 1, ncor}]
Show[
          GraphicsArray[{Show[allg, Frame -> True, 
                PlotRange -> {{-um, um}, {-um, um}}, 
                AspectRatio -> 1, 
                PlotLabel -> "h004017 pour I=100A", 
                DisplayFunction -> Identity], Show[allsext]}, 
            GraphicsSpacing ->  .1]]

h3000a
Abs[%]
Max[%]