Vectorial Platform for Manipulating Polarization Mode Train Realized with Jones Vectors in  Mathematica

Hee-Joong Yun, 
                  Professor of Physics Emeritus 
                  Mokwon University
                                   Korea Institute of Science and Technology Information(KISTI)

Join the Conversation #WolframTechConf

I. Coherent characteristics of the polarized electromagnetic wave

Coherent characteristics of  the polarized electromagnetic(EM) waves is 
        to be a cardinal key word  of knowledge-information-oriented society. 
         
         \[KernelIcon]  radio, optical, and space communication            
          \[KernelIcon]  quantum key distribution(QKD) cryptography           
          \[KernelIcon]  cosmic micro background(CMB) observation
          \[KernelIcon]  gravitational-wave observation
          \[KernelIcon]  gauge boson in Standard Model
          \[KernelIcon]  chiral photons(QED)
          \[KernelIcon]   handedness of an elementary particle(QED)
          \[KernelIcon]  imaging polarization navigation algorithm
          \[KernelIcon]  terahertz  generation
          \[KernelIcon]  desert ant(cataglyphis), honey bee(dung beetle), Frischs(1973,Nobel Prize)
          \[KernelIcon]  vectorial propagation modes of polarized waves
         
         ⇒  We propose a polarized EM wave should be described as 
              a spiral vector field with helicity(±ℏ) in QED(quantum electrodynamics).

II. Electromagnetic wave propagation with Jones vectors in the  medium

Subsection head (*Subsection*)

1.  Jones Vector

 Maxwell eq. in the medium    
 
          ∇×(OverVector[H]) =(OverVector[ J ]) + ((∂(OverVector[D]))/(∂t))             Ampere-Maxwell's   law  
           ∇×(OverVector[E]) = -((∂(OverVector[B]))/(∂t))          Faraday's  law 
           ∇·(OverVector[D])= ρ                     Gauss's  law 
           ∇·(OverVector[B])= 0                      Monopole                (1)                                           
               
            if  (OverVector[J])=0 and  (OverVector[P])=(Subscript[χϵ, 0]) (OverVector[E])  
                      
           then wave equation in the medium with  χ  is  
                         
             (OverVector[k])  × (  ∇×(OverVector[E]) ) +  ((ω^2)/(c^2)) (OverVector[E]) = - ((ω^2)/(c^2))χ (OverVector[E])                                       (2)          
                
         ,  and           
         
                    (OverVector[k]) ·(OverVector[E]) = (OverVector[k]) ·(OverVector[B]) = 0
      (OverVector[B]) =(Sqrt[μϵ]) (OverVector[k]) × (OverVector[E])
       (OverVector[S])  = (OverVector[E]) ×  (OverVector[H])                                                                                       (3) 
            
            with    
            
              (OverVector[D]) = ϵ (OverVector[E]), (OverVector[B])=μ(OverVector[H]),   (OverVector[J]) = g (OverVector[E])                                                                                             (4)
             
The solution of the eq. will be the spherical wave:

            (OverHat[E]) ((OverVector[r]) ,t) =(Subscript[(OverHat[E]), 0]) (1/r)  (e^(i( (OverHat[κ]) .(OverVector[r])- ωt) ))                                                    (5) 
        if   the source not near   in  vacuumn, plane wave
(Subscript[(OverHat[E]), 0]) is the complex constant vector amplitude    

        (OverHat[E]) ((OverVector[r]) ,t) =( (Subscript[(OverVector[ϵ]), 1]) (Subscript[E, 0]) (e^(Subscript[iϕ, x])) +    (Subscript[(OverVector[ϵ]), 2]) (Subscript[E, 0])(e^(Subscript[iϕ, y]))  )   (e^(i( (OverHat[κ]) .(OverVector[r])- ωt) )) 
               = ((Subscript[(OverVector[E]), x])+(Subscript[(OverVector[E]), y]) (e^(±i∆ϕ  )))(e^(i((OverVector[k]) .(OverVector[r])- ωt) )) 
               = ( (Subscript[(OverHat[E]), x])  + (Subscript[(OverHat[E]), y]) )(e^(i((OverVector[k]) .(OverVector[r])- ωt) )) 
               ⇒   (({{A}, {B±iC}}))(e^(i((OverVector[k]) .(OverVector[r])- ωt) ))           (6)                    
               
    , where ∆ϕ =(Subscript[ϕ, y])- (Subscript[ϕ, x]) , A, B, and C are real numbers. Thus we shall write electric field vector       (OverHat[E]) ((OverVector[r]) ,t)  as Jones vector as
              
       ⇒       (OverHat[E]) ((OverVector[r]) ,t) =  (({{A}, {B±iC}}))(e^(i((OverVector[k]) .(OverVector[r])- ωt) ))                                          (7)   
              
      then  we may get the  (OverHat[B])((OverVector[r]) ,t)  field as      

         ⇒        (OverHat[B])((OverVector[r]) ,t)  = (Sqrt[μϵ]) (OverVector[k]) × (OverHat[E]) ((OverVector[r]) ,t)                                                     (8)
         
If C=0 then the wave is a linearly polarized(LP), otherwise (({{A}, {B+iC}})),  then right-handed elliptical polarized(RHEP)  with  helicity  of  “+1” ,  if (({{A}, {B-iC}})),   then left-handed elliptical polarized(LHEP)  with   helicity of  “-1 ”.  

Especially,  B=0 and  A=C,    then right-handed circular polarized (RHCP) with helicity of “+1”, or  left-handed circular polarized (LHCP) with helicity of “-1”  whether the complex amplitude, 
    
    {A,  iB} of the (OverHat[E]) field is in the upper region  of the complex phase lag plane, 
or {A, -iB} is in the lower region  of the complex phase lag plane.           
                                   
Therefore we may visualize the electromagnetic fields with two vector   fields (OverHat[E]) and (OverHat[B])   with Jones vectors using the Graphics3D in  Mathematica.                                      
                                
2.   Jones Matrix
                                
 Optical elements are represented 2×2 matrix called Jones matrix. 
 Let the incident light be  (({{A}, {B+iC}}))(e^(i((OverVector[k]) .(OverVector[r])- ωt) )),  emerging vector from the   through the optical element written by the Jones matrix ,  (({{a  b }, {c   d }})) simply like as below when we cancel the oscillating term (e^(i((OverVector[k]) .(OverVector[r])- ωt) )),
                            
                                      (({{a, b}, {c, d}})) (({{A}, {B}}))=  (({{A'}, {B'}}))                                             (9)
                
, here we let  A and A’ are real numbers and B and B’ are complex numbers with conveniency.  General form of matrices converting Jones vector from n-train of the optical elements as follows:
 
                    (({{(Subscript[a, n]), (Subscript[b, n])}, {(Subscript[c, n]), (Subscript[d, n])}})) ...(({{(Subscript[a, 2]), (Subscript[b, 2])}, {(Subscript[c, 2]), (Subscript[d, 2])}})) (({{(Subscript[a, 1]), (Subscript[b, 1])}, {(Subscript[c, 1]), (Subscript[d, 1])}})) (({{A}, {B}})) =  (({{A'}, {B'}}))                     (10)  
                    
, where n train of optical elements consists with one lineup polarizer with p polarizers and n-1  lineup with q wave plates repeated three lineup for four-train polarization modes platform in this work. In our four-train modes platform, p4=P(6,1).PR(7,3)=6.(7^3) = 2,058 cases of propagation modes of simulation are possible(P2=42 only case possible).

3.   Optical elements  for jdpmp4t Platform 

     Jones vectors for polarizer:
 
     [0]  Null,  No wave,
     [1 ]  LP,    Linearly polarized :                                                    (OverVector[E])0 =   (({{Cos[α]}, {Sin [α]}}))        
     
     [2,3]CPV(H),    Right/left-handed Circularly :                       (OverVector[E])0 =  1/(Sqrt[2])(({{1}, {±i}}))       
     
     [4,5] EPV(H),    Right/left-handed Ellipically :       (OverVector[E])0 =  1/(Sqrt[(A^2)+(B^2)+(C^2)])(({{A}, {B±iC}}))      
                                 
  Jones Matrices for retarders:    
                             
      [1]   LW,    Linear polarizer(β,  TA)   :                         M=    (({{(Cos^2)β  , Cosβ Sinβ}, {Cosβ Sinβ, (Sin^2)β }}))           
                       
     [2,3]  QWV(H), Quarter-wave plate(FA, V/H)  :        M=(e^(-iπ/4))(({{1, 0}, {0, ±i}}))        
            
     [4,5]  HWV(H),  Half-wave plate (FA,V/H)  :            M=(e^(∓iπ/2))(({{1, 0}, {0, -1}}))      
                         
     [6,7]   EWV(H) ,   Eighth-wave plate (FA,V/H)  :        M=  (({{1, 0}, {0, (e^(±iπ/4))}}))                                                   
                                                                   
     [9]     IPR,  Isotropic phase retarder :                            M=  (({{(e^(Subscript[iϕ, x])), 0}, {0, (e^(Subscript[iϕ, y]))}}))    
       

 Polarization process through the optical elements.          
      
      (0)  before the polarizer : unpolarized wave 
       (1)  Train-1 lineup: polarizer(dichroism):  
                 [0]       Null
                 [1]        LP
               [2,3]     CPV(H)
               [4,5]    EPV(H)
     (2)  Train2-4 lineup: Optical elements(bifringence):
                 [1]       LW
               [2,3]     QWV(H)
               [4,5]     HWV(H)
               [6,7]      EWV(H)

   4.  Helicity operater of the photons   

                       
(OverHat[h])  =  (OverVector[S]). (OverVector[p])/|p|=ℏ    (OverVector[α]).(OverHat[p])          
             
             (OverHat[h])  |(OverHat[p]) (SubPlus[]) ⟩   =    +ℏ |(OverHat[p]) (SubPlus[]) ⟩ 
             (OverHat[h])  |(OverHat[p]) (SubMinus[]) ⟩   =    -ℏ |(OverHat[p]) (SubMinus[]) ⟩ 
            
                , where (OverVector[α])  is the Pauli spin matrices.
                 Photon is a boson have the helicity a ±ℏ .  If  we let ℏ=1,  then  helicity of the photon is ±1 respectively 
                 according to the  its spin  ( angular momentum vector (OverVector[L]) in light wave scheme).
             
       
         
                   
                   
          
    
    
   💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡💡

✓ \[MathematicaIcon]  Confirm the Jones Vector calculation in Mathematica.

ClearAll[α];ClearAll[β];
E0={1,1};
LP={Cos[α], Sin[α]};
CPV=1/(Sqrt[2]){1, I};
CPH=1/(Sqrt[2]){1, -I};
LW={{ Cos[β]^2, Sin[β] Cos[β]},{ Sin[β] Cos[β], Sin[β]^2}};
QWV={{1,0},{0,I}};
QWH={{1,0},{0,-I}};
HWV={{1,0},{0,-1}};
EWV=1/(Sqrt[3]){{1,0},{0,Exp[I 1/4 π]}};
EWH=1/(Sqrt[3]){{1,0},{0,Exp[-I 1/4 π]}};
l1=E0*LP/.α->1/4  π;
l2=LW/.β->3/4 π;
"== Output== "
l1.l2/.{α->1/4  π,β->3/4 π}
l1.l2/.{α->1/6  π,β->2/3 π}
l1.l2/.{α->1/3  π,β->5/6 π}
l1.QWV/.{α->1/4  π}
l1.QWH/.{α->1/4  π}
l1.HWV/.{α->1/4  π} 
E0*CPH.QWV
E0*CPH.QWH
E0*CPH.HWV
E0*CPV.HWV.EWV//N
E0*CPH.HWV.EWH//N

III. Manipulating of jdpmp4t platform

(1)  New platform jdpmp4t manipulates five zones graphically by using the   
                 Piecewise    function  in  Mathematica   for 
                 the  four-train polarization modes effectively rather than    
                 two-platform  ( possible number of simulations   42 -> 2058).   
        
        (2)  Platform jdpmp4t  starts on clicking the button ⊳   
                 on the pop up ⊕ of the t1 panel on the platform

        (3)  Platform jdpmp4t   will run one of            
                 four - tain modes automatically while user selects one of modes in the panel. 
                 On selecting the train mode, 
                the platform simulates the selected polarization mode dynamically in 
                presenting a train of lineup,phase lags and helicity train on the platform. 
      
       (4) Platform jdpmp4t   presents  precisely the helicity of the polarization 
               mode on the panel with it' s   phase lag of  the block. All the vector fields      
               used  in Graphics3D  are calculated and cross checked  
               in Mathematica.
       
       (5)  Snapshots of  the running platform are saved and printed. 
                The platform is programed in Mathematica 10.4 .
                If    your pc have not been installed Mathematica yet, 
                you will run thejdpmp4t.cdf instead in the  Wolfram CDF Player.
                You will download jdpmp.nb  and jdpmp4t.cdf  at the cite ;

jdpmp4t_v7:  Polarization with Jones vectors(jtrain4)   
  jdpmp47_v7 © H.J.Yun  Oct 10,2016

(*Manipulate[*)
Manipulate[
If[JvC ==1,init=True,init=False];
If[JmC ==1,polarize=True,{polarize=False;βdeg = 0}];
 view={{200,0.0,0.0},{-200,0,0}   ,{2.311,-2.0961,1.176}, {2.0311,-2.0961,1.376}}  ; 

α=π αdeg /180.;
β=π βdeg /180.;
E1 = Evaluate[E0*Jv];
Jv = Piecewise[{{JvLinear[α],JvC == 1},{JvCircularV,JvC == 2},{JvCircularH,JvC == 3},{JvEWV,JvC == 4},{JvEWH,JvC == 5}}];
Jm = Piecewise[{{JmLinear[β],JmC == 1},{JmQWPV,JmC == 2},{JmQWPH,JmC == 3},{JmHWPV, JmC == 4},{JmHWPH, JmC ==5},{JmEWPV, JmC == 6},{JmEWPH, JmC == 7}}];
Jt = Piecewise[{{JmLinear[β],JtC == 1},{JmQWPV,JtC == 2},{JmQWPH,JtC == 3},{JmHWPV, JtC == 4},{JmHWPH, JtC ==5},{JmEWPV, JtC == 6},{JmEWPH, JtC == 7}}];
Js = Piecewise[{{JmLinear[β],JsC == 1},{JmQWPV,JsC == 2},{JmQWPH,JsC == 3},{JmHWPV, JsC == 4},{JmHWPH, JsC ==5},{JmEWPV, JsC == 6},{JmEWPH, JsC == 7}}];
E2 = Evaluate[Jm.E1];
 E3= Evaluate[Jt.E2];
 E4= Evaluate[Js.E3];
prr=2.11739;
pr=1;

E1 = Evaluate[E0*Jv];
E11 = Evaluate[E0*Jv]/.x->x2/.t->(t2)/.{α->π/4}//.{x2->14.700,t2->14.770};
E12 = Evaluate[E0*Jv]/.x->x2/.t->(t2)/.{α->π/4}//.{x2->14.701,t2->14.701};
E13 = Evaluate[E0*Jv]/.x->x2/.t->(t2)/.{α->π/4}//.{x2->14.702,t2->14.702};
      (* ϕ_Ez      *)
dp11=pr* (Arg[E11[[2]]]-Arg[E11[[1]]]);
dp12=pr* (Arg[E12[[2]]]-Arg[E12[[1]]]);
dp13= pr*(Arg[E13[[2]]]-Arg[E13[[1]]]);

If[ j==1, And[dp21==1234,dp31==1235,dp41==1236],Null];
If[ j== 2, And[dp31==1235,dp41==1236],Null];
If[ j== 3, dp41==1237,Null];
 
helicity1[dp11_]:=Which[   dp11 ==  1/8 π || dp11 == 1/4 π ,1     ,          dp11==1/2 π || dp11== 3/4 π ,1,
                                                       dp11 == - 1/8 π || dp11 == -1/4 π ,-1  ,        dp11==-1/2 π || dp11== -3/4 π ,-1,
                                                     
                                                         dp11 == - 5/4 π || dp11 ==- 6/4 π ,1 ,      dp11==-7/4 π  ,1,
                                                          dp11 ==  5/4 π || dp11 == 6/4 π ,-1,        dp11==7/4 π  ,-1,
                                                  
                                                        dp11 ==  3/8 π || dp11 == 5/8 π ,1 ,          dp11==7/8 π  ,1,
                                                         dp11 == - 3/8 π || dp11 ==- 5/8 π ,-1,      dp11==-7/8 π  ,-1,
                                                   
                                                        dp11== 0  || dp11== π ,0,       dp11==-π  ,   0     
                                                             ];      
             
E21 = Evaluate[Jm.E1]/.x->x2/.t->(t2)/.{α->π/4}/.{β->π/4}//.{x2->27.200, t2->27.200};
E22 = Evaluate[Jm.E1]/.x->x2/.t->(t2)/.{α->π/4}/.{β->π/4}//.{x2->27.201, t2->27.201};
E23 = Evaluate[Jm.E1]/.x->x2/.t->(t2)/.{α->π/4}/.{β->π/4}//.{x2->27.201, t2->27.201};
dp21=pr*(Arg[E21[[2]]]-Arg[E21[[1]]]); 
dp22= pr*(Arg[E22[[2]]]-Arg[E22[[1]]]);
dp23=  pr*(Arg[E23[[2]]]-Arg[E23[[1]]]); 
helicity2[dp21_]:=  Which[   dp21 ==  1/8 π || dp21 == 1/4 π ,1     ,          dp21==1/2 π || dp21== 3/4 π ,1,
                                                       dp21 == - 1/8 π || dp21 == -1/4 π ,-1  ,        dp21==-1/2 π || dp21== -3/4 π ,-1,                                                     
                                                         dp21 == - 5/4 π || dp21 ==- 6/4 π ,1 ,      dp21==-7/4 π  ,1,
                                                          dp21 ==  5/4 π || dp21 == 6/4 π ,-1,        dp21==7/4 π  ,-1,                                                  
                                                        dp21 ==  3/8 π || dp21 == 5/8 π ,1 ,          dp21==7/8 π  ,1,
                                                         dp21 == - 3/8 π || dp21 ==- 5/8 π ,-1,      dp21==-7/8 π  ,-1,                                                   
                                                
                                               0.738363-0.001     <dp21 < 0.738363+0.001   ,1,     - 0.738363-0.001     <dp21 < -0.738363+0.001   ,-1,

                                                    0.371748-0.001     <dp21 < 0.371748+0.001   ,  1,
                                                - 0.366615-0.001     <dp21 < -0.366615+0.001   ,-1,  
                                        -1.45038-0.0081     <dp21 <-1.45038+0.0081   ,0,1.45038-0.0081     <dp21 <1.45038+0.0081   ,0,
                                                      
                                                       dp21== 0  || dp21== π ,0,       dp21==-π  ,   0                                                          
                                                               ];      
    
E31 = Evaluate[Jt.E2]/.x->x2/.t->(t2)/.{α->π/4}/.{β->π/4}//.{x2->39.800,t2->39.800 };
E32 = Evaluate[Jt.E2]/.x->x2/.t->(t2)/.{α->π/4}/.{β->π/4}//.{x2->39.801,t2->39.801 };
E33 = Evaluate[Jt.E2]/.x->x2/.t->(t2)/.{α->π/4}/.{β->π/4}//.{x2->39.802,t2->39.802 };
(*Print["E21"];*)

dp31= pr*(Arg[E31[[2]]]-Arg[E31[[1]]]); 
dp32= pr*(Arg[E32[[2]]]-Arg[E32[[1]]]);
dp33=  pr*(Arg[E33[[2]]]-Arg[E33[[1]]]);

helicity3[dp31_]:=  Which[   dp31==  1/8 π || dp31== 1/4 π ,1     ,         dp31==1/2 π ||dp31== 3/4 π ,1,
                                                       dp31== - 1/8 π || dp31== -1/4 π ,-1  ,       dp31==-1/2 π ||dp31== -3/4 π ,-1,                                                     
                                                         dp31== - 5/4 π || dp31==- 6/4 π ,1 ,     dp31==-7/4 π  ,1,
                                                          dp31==  5/4 π || dp31== 6/4 π ,-1,       dp31==7/4 π  ,-1,                                                  
                                                        dp31==  3/8 π || dp31== 5/8 π ,1 ,         dp31==7/8 π  ,1,
                                                         dp31== - 3/8 π || dp31==- 5/8 π ,-1,     dp31==-7/8 π  ,-1,						
						
                                                          - 0.335922 -0.0001  < dp31< - 0.335922 +0.0001, 0,   0.335922 -0.0001  < dp31<  0.335922 +0.0001, 0,
                                                             - 3.47751 -0.0001  < dp31<  - 3.47751 +0.0001, 0,     3.47751 -0.0001  < dp31<   3.47751 +0.0001, 0,
                                                           1.69179 -0.0001  < dp31< 1.69179 +0.0001, 0,     -1.69179 -0.0001  < dp31< -1.69179 +0.0001, 0, 
                                                            1.23487-0.0081  < dp31< 1.23487+0.0081,-1 , - 1.23487-0.0081  < dp31< -1.23487+0.0081,1 , 
                                                           5.04831-0.0081  < dp31< 5.04831  +0.008,1 ,                                                    
                                                       -1.38945-0.0081     <dp31 <  -1.38945+0.0081     ,1,
                                                          -2.10495-0.0081  < dp31< -2.10495+0.008,  + 1 ,
                                                       -0.604049-0.0081  < dp31< -0.604049  +0.0081,  1 , 
                                                        1.30267-0.0081  < dp31<1.30267+0.0081, 1 , 
                                                         2.87347-0.0081  < dp31<2.87347+0.0081  , 1 ,     -2.87347-0.0081  < dp31<-2.87347+0.0081  , -1 ,
            -2.69212-0.0081  < dp31<-2.69212+0.0081  , 1 , 2.69212-0.0081  < dp31<2.69212+0.0081  , -1 , 
                                                        -3.40972-0.0081  < dp31<-3.40972+0.0081  , 1 , 
                                                       - 5.04831-0.0081  < dp31< -5.04831  +0.008,-1 ,   
                                                        2.94336-0.0081  < dp31< 2.94336+0.0081,  - 1 ,
                                                           4.51416-0.0081  < dp31< 4.51416+0.008,  - 1 ,                                
                                                          2.69212 -0.0001  < dp31<  2.69212 +0.0001,-1,                                                         
                                                          -1.05352-0.0081  < dp31<-1.05352+0.0081, -1 , 
                                                          -1.83892-0.0081  < dp31<-1.83892+0.0081, -1 ,   1.83892-0.0081  < dp31<1.83892+0.0081, 1 ,                     
                                
                       -1.12131-0.0081  < dp31<-1.12131+0.0081  , 1 , 1.12131-0.0081  < dp31<1.12131+0.0081  , -1 , 
                          1.69179-0.0081  < dp31< 1.69179 +0.008,   0 , -1.69179-0.008  < dp31< -1.69179 +0.008,   0 ,
                         2.30891-0.0081  < dp31< 12.30891-0.0081 ,   0 ,
                                                   -1.33227 (10^(-5 ))-5.0 (10^(-6 )) < dp31<   -1.33227 (10^(-5 ))+5.0 (10^(-6 )),0 , 
                                                      dp31== 0  || dp31== π ,0,       dp31==-π  ,   0      
                                                    ];      

E41 = Evaluate[Js.E3]/.x->x2/.t->(t2)/.{α->π/4}/.{β->π/4}//.{x2->52.400,t2->52.400 };
E42 = Evaluate[Js.E3]/.x->x2/.t->(t2)/.{α->π/4}/.{β->π/4}//.{x2->52.401,t2->52.401 };
E43 = Evaluate[Js.E3]/.x->x2/.t->(t2)/.{α->π/4}/.{β->π/4}//.{x2->52.402,t2->52.402 };
(*Print["E21"];*)

dp41= pr*(Arg[E41[[2]]]-Arg[E41[[1]]]); 
dp42= pr*(Arg[E42[[2]]]-Arg[E42[[1]]]);
dp43=  pr*(Arg[E43[[2]]]-Arg[E43[[1]]]);

helicity4[dp41_]:= Which[   dp41==  1/8 π || dp41== 1/4 π ,1     ,         dp41==1/2 π ||dp41== 3/4 π ,1,
                                                       dp41== - 1/8 π || dp41== -1/4 π ,-1  ,       dp41==-1/2 π ||dp41== -3/4 π ,-1,                                                     
                                                         dp41== - 5/4 π || dp41==- 6/4 π ,1 ,     dp41==-7/4 π  ,1,
                                                          dp41==  5/4 π || dp41== 6/4 π ,-1,       dp41==7/4 π  ,-1,                                                  
                                                        dp41==  3/8 π || dp41== 5/8 π ,1 ,         dp41==7/8 π  ,1,
                                                         dp41== - 3/8 π || dp41==- 5/8 π ,-1,     dp41==-7/8 π  ,-1,						
						
                                                           3.8797-0.0081  < dp41< 3.8797  +0.0081,-1 ,  -3.8797-0.0081  < dp41< -3.8797  +0.0081,1 ,
                                                           4.83398-0.0081  < dp41< 4.83398  +0.0081,0 ,    - 4.83398-0.0081  < dp41< -4.83398  +0.0081,0 ,
                                                      0.0472868-0.0081  < dp41< 0.0472868 +0.0081,-1 , -0.0472868-0.0081  < dp41< -0.0472868 +0.0081, ,                                                     
                                                      -1.61808-0.0081  < dp41< -1.61808  +0.008,-1 , 1.61808-0.0081 < dp41< 1.61808  +0.008,1 , 
                                                      -4.6651-0.0081  < dp41< -4.6651+0.0081,   1 , 4.6651-0.0081  < dp41< 4.6651+0.0081,   -1 ,
                                                         3.00907-0.0081  < dp41< 3.00907+0.008,  0 ,      -3.00907-0.0081  < dp41< -3.00907+0.008,  0 ,
                                                       1.43827-0.0081  < dp41< 1.43827 +0.0081,    1 ,      -1.43827-0.0081  < dp41< -1.43827 +0.0081,   - 1 ,
                                                        3.18888-0.0081  < dp41< 3.18888+0.0081,   1 ,     -3.18888-0.0081  < dp41< -3.18888+0.0081,   -1 ,  
                                                     -3.09431-0.0081  < dp41< -3.09431 +0.0081,   1 ,        3.09431-0.0081  < dp41< 3.09431 +0.0081,   -1 ,
                                                     0.700162-0.0081  < dp41< 0.700162+0.0081 ,  1 ,          -0.700162-0.0081  < dp41< -0.700162+0.0081 ,  -1 ,   
                                                     0.738111-0.0081  < dp41< 0.738111+0.0081 ,  1 ,   -0.738111-0.0081  < dp41< -0.738111+0.0081 ,-1 ,  
                                                         0.870634-0.0081  < dp41< 0.870634+0.0081, 1 ,   -0.870634-0.0081  < dp41< -0.870634+0.0081,  -1 , 
                                                         5.3762-0.0081  < dp41< 5.3761 +0.0081,   1 ,            -5.3762-0.0081  < dp41< -5.3761 +0.0081,   -1 ,  
                                                      0.785396-0.0081  < dp41< 0.785396+0.0088,  1 ,   -0.785396-0.0081  < dp41< -0.785396+0.0088,  -1 ,
                                                         -0.906986-0.0081  < dp41< -0.906986 +0.0088,   1 ,  0.906986-0.0081  < dp41< 0.906986 +0.0088,   -1 ,
                                                         -3.8054-0.0081  < dp41<-3.8054  +0.0081,1 ,   3.8054-0.0081  < dp41<3.8054  +0.0081,-1 ,
                                                          2.44143-0.0081 < dp41<2.44143  +0.0081,0 ,   -2.44143-0.0081 < dp41<-2.44143  +0.0081,0 , 
                                                      1.44921-0.0081 < dp41<1.44921  +0.0081,0 ,  -1.44921-0.0081 < dp41<-1.44921  +0.0081,0 , 
                                                      -3.97428-0.0081 < dp41<-3.97428 +0.0081,0 , 3.97428-0.0081 < dp41<3.97428 +0.0081,0 , 
                                                        2.30891-0.0081 < dp41<2.30891+0.0081,0 , -2.30891-0.0081 < dp41<-2.30891+0.0081,0 , 
                                                       2.72792-0.0081 < dp41<2.72792+0.0081,0 ,-2.72792-0.0081 < dp41<-2.72792+0.0081,0 , 
                                                       -1.93718-0.0081  < dp41< -1.93718+0.0081,  - 1 ,  -1.93718-0.0081  < dp41< -1.93718+0.0081,  - 1 ,
                                                         1.94252-0.0081 < dp41< 1.94252 +0.0081,1 ,     -1.94252-0.0081 < dp41< -1.94252 +0.0081,-1 , 
                                                      2.40348-0.0081 < dp41< 2.40348 +0.0081,1 ,     -2.40348-0.0081 < dp41< -2.40348 +0.0081,-1 , 
                                                 0.371724-0.0081 < dp41< 0.371724 +0.0081,1 ,-0.371724-0.0081 < dp41< -0.371724 +0.0081,-1 ,
                                                      0.37124-0.0081  < dp41< 0.37124 +0.0081,0 ,    -0.37124-0.0081  < dp41< -0.37124 +0.0081,0 , 
                                                     -0.413675-0.0081  < dp41< -0.413675 +0.0081,0 , 
                                                      0.832685-0.0081  < dp41< 0.832685 +0.0081,0 ,  -0.832685-0.0081  < dp41< -0.832685 +0.0081,0 , 
                                                     -3.51332-0.0081<dp41< -3.51332+0.0081 ,1,  3.51332-0.0081<dp41< 3.51332+0.0081 ,-1,
                                                       -5.08411-0.0081<dp41< -5.08411+0.0081 ,1,   5.08411-0.0081<dp41< 5.08411+0.0081 ,-1,
                                                        -4.346-0.0081<dp41<  - 4.346+0.0081 ,1,             4.346-0.0081<dp41<   4.346+0.0081 ,-1,
                                                     0.366388-0.0081<dp41< 0.366388+0.0081 ,1,    -0.366388-0.0081<dp41<- 0.366388+0.0081 ,-1,
                                                       -5.07878-0.0081<dp41< -5.07878+0.0081 ,1,    5.07878-0.0081<dp41< 5.07878+0.0081 ,-1,
                                                       1.98981-0.0081<dp41< 1.98981+0.0081 ,1,  -1.98981-0.0081<dp41< -1.98981+0.0081 ,-1,
                                                   -4.29338-0.0081<dp41< -4.29338+0.0081 ,1,     4.29338-0.0081<dp41< 4.29338+0.0081 ,-1,
                                                     -5.5512 (10^(-17 ))-1.0 (10^(-17 )) < dp41< -5.5512 (10^(-17 ))+1.0 (10^(-17 )),0 , 
                                                         dp41== 0  || dp41== π ,0,       dp41==-π  ,   0      
                                                    ];      


E1L =Insert[Re[ Evaluate[E0*Jv]],x,1]/.x->x1/. t->(t1);
E1LO1 =Insert[Re[ Evaluate[E01*JvO1]],x,1]/.x->x1/. t->(t1);
E1LO2 =Insert[Re[ Evaluate[E01*JvO2]],x,1]/.x->x1/. t->(t1);
E1LO3 =Insert[Re[ Evaluate[E01*JvO3]],x,1]/.x->x1/. t->(t1);
E1LO4 =Insert[Re[ Evaluate[E01*JvO4]],x,1]/.x->x1/. t->(t1);
B1L= ReplacePart[Cross[{1,0,0},E1L], 1-> x]/.x->x1/. t->(t1);
B1LO1= ReplacePart[Cross[{1,0,0},E1LO1],1-> x]/.x->x1/. t->(t1);
B1LO2= ReplacePart[Cross[{1,0,0},E1LO2],1-> x]/.x->x1/. t->(t1);
B1LO3= ReplacePart[Cross[{1,0,0},E1LO3],1-> x]/.x->x1/. t->(t1);
B1LO4= ReplacePart[Cross[{1,0,0},E1LO4],1-> x]/.x->x1/. t->(t1);
B1D=B1L/.x1->5.21 Pi;
B11=ReplacePart[B1L,1->17.81 Pi];
 
 
e1poly1=E1L;
b1poly1=B1L; 
e1poly101=E1LO1;
e1poly102=E1LO2;
e1poly103=E1LO3;
e1poly104=E1LO4;
b1poly101=B1LO1; 
b1poly102=B1LO2; 
b1poly103=B1LO3; 
b1poly104=B1LO4; 

arrow01=  {{Thickness[0.00021],Arrowheads[0.00253]
           , {Hue[0.135]
        ,Table[ Arrow[{{ x1,0,0}, e1poly1}] ,{x1,0, 1.2 Pi-0.151 ,0.1}],     
             {Hue[0.135]
      ,Table[ Arrow[ {{x1,0,0},b1poly1}],{x1,0, 1.2 Pi-0.151 ,0.1} ]},                 
                                                          ControllerLinking -> All} } } ;

arrow02=  {{Thickness[0.00021],Arrowheads[0.00253]
           ,{Hue[0.135]
        ,Table[ Arrow[{{ x1,0,0}, e1poly102}] ,{x1,0, 1.2 Pi-0.151 ,0.1}],     
            { Hue[0.135]
      ,Table[ Arrow[ {{x1,0,0},b1poly102}],{x1,0, 1.2 Pi-0.151 ,0.1} ]},                 
                                                          ControllerLinking -> All} } } ;

arrow03=  {{Thickness[0.00021],Arrowheads[0.00253]
           ,{Hue[0.135]
        ,Table[ Arrow[{{ x1,0,0}, e1poly103}] ,{x1,0, 1.2 Pi-0.151 ,0.1}],     
           {Hue[0.135]
      ,Table[ Arrow[ {{x1,0,0},b1poly103}],{x1,0, 1.2 Pi-0.151 ,0.1} ]},                 
                                                          ControllerLinking -> All} } } ;
arrow04=  {{Thickness[0.00021],Arrowheads[0.00253]
           ,{Hue[0.135]
        ,Table[ Arrow[{{ x1,0,0}, e1poly104}] ,{x1,0, 1.2 Pi-0.151 ,0.1}],     
          {Hue[0.135]
      ,Table[ Arrow[ {{x1,0,0},b1poly104}],{x1,0, 1.2 Pi-0.151 ,0.1} ]},                 
                                                          ControllerLinking -> All} } } ;

arrow1=  {{Thickness[0.000121],Arrowheads[0.001253]
           ,{Hue[0.6]
        ,Table[ Arrow[{{ x1,0,0}, e1poly1}] ,{x1,1.2Pi , 5.21 Pi-0.01 ,0.145}],     
            { Hue[0.016]
      ,Table[ Arrow[ {{x1,0,0},b1poly1}],{x1,1.2Pi,    5.21 Pi-0.01 ,0.145} ]},                 
                                                          ControllerLinking -> All} } } ;

arrow11=  {{Thickness[0.000121],Arrowheads[0.001253]
           ,{Hue[0.6]
        ,Table[ Arrow[{{ x1,0,0}, e1poly1}] ,{x1,1.2Pi , 17.81 Pi-0.01 ,0.145}],     
            { Hue[0.016]
      ,Table[ Arrow[ {{x1,0,0},b1poly1}],{x1,1.2Pi,   17.81 Pi-0.01 ,0.145} ]},                 
                                                          ControllerLinking -> All} } } ;


u={1,0,0};
E2C =Insert[Re[ Evaluate[Jm. E1]],x,1]/. x->x1/. t->(t1);
B2C= ReplacePart[Cross[{1,0,0},E2C],1-> x]/.x->x1/. t->(t1);
B2D=ReplacePart[B2C,1->9.41Pi];
B22=ReplacePart[B2C, 1-> 17.81Pi];
(*B2R=ReplacePart[B2C,x1->17.81 Pi];
B2D=ReplacePart[B2C,x1->17.81 Pi];*)
(* t1=4 π;  *)
e2poly1=E2C;
b2poly1=B2C;

(*helicity={+1,-1,0};*)
arrow2=  {{Thickness[0.000121],Arrowheads[0.001253]
           ,{Hue[0.6]
        ,Table[ Arrow[{{ x1,0,0}, e2poly1}] ,{x1, 5.21 Pi+0.10,9.41π,0.145}],     
            { Hue[0.016]
      ,Table[ Arrow[ {{x1,0,0},b2poly1}],{x1, 5.21  Pi+0.10,9.41π,0.145}],                      
                                                          ControllerLinking -> All} } }} ;
arrow22=  {{Thickness[0.000121],Arrowheads[0.001253]
           ,{Hue[0.6]
        ,Table[ Arrow[{{ x1,0,0}, e2poly1}] ,{x1, 5.21 Pi+0.10,17.81π,0.145}],     
            { Hue[0.016]
      ,Table[ Arrow[ {{x1,0,0},b2poly1}],{x1, 5.21  Pi+0.10,17.81π,0.145}],                      
                                                          ControllerLinking -> All} } }} ;




u={1,0,0};
E3C =Insert[Re[ Evaluate[Jt. E2]],x,1]/. x->x1/. t->(t1);
B3C= ReplacePart[Cross[{1,0,0},E3C],1-> x]/.x->x1/. t->(t1);
B33=ReplacePart[B3C,1->17.81 Pi];
B3D=ReplacePart[B3C,1->13.61 Pi];
(* t1=4 π;  *)
e3poly1=E3C;
b3poly1=B3C;
(*E3C B3C *)

arrow3=  {{Thickness[0.000121],Arrowheads[0.001253]
             ,{Hue[0.6]
          ,Table[ Arrow[{{ x1,0,0}, e3poly1}] ,{x1, 9.41 Pi+0.10,13.61π,0.135}],     
            { Hue[0.016]
       ,Table[ Arrow[ {{x1,0,0},b3poly1}],{x1, 9.41 Pi+0.10,13.61π,0.135}],                     
          ControllerLinking                                                           -> All} } } };


arrow33=  {{Thickness[0.000121],Arrowheads[0.001253]
             ,{Hue[0.6]
          ,Table[ Arrow[{{ x1,0,0}, e3poly1}] ,{x1, 9.41 Pi+0.10,17.81π,0.135}],     
            { Hue[0.016]
       ,Table[ Arrow[ {{x1,0,0},b3poly1}],{x1, 9.41 Pi+0.10,17.81π,0.135}],                     
          ControllerLinking                                                           -> All} } } };


(*     arrow 4  *)
u={1,0,0};
E4C =Re[Insert[ Evaluate[Js. E3],x,1]]/. x->x1/. t->(t1);
B4C= ReplacePart[Cross[{1,0,0},E4C],1-> x]/.x->x1/. t->(t1);
B4R=B4C/.x1->17.81 Pi;
B4D=ReplacePart[B4C,1 -> 17.81 Pi];
(* t1=4 π;  *)
e4poly1=E4C;
b4poly1=B4C;
(*E3C B3C *)

arrow4=  {{Thickness[0.000121],Arrowheads[0.001253]
             ,{Hue[0.6]
          ,Table[ Arrow[{{ x1,0,0}, e4poly1}] ,{x1, 13.61 Pi+0.10,17.81π,0.135}],     
            { Hue[0.016]
       ,Table[ Arrow[ {{x1,0,0},b3poly1}],{x1, 13.61 Pi+0.10,17.81π,0.135}],                 
                                                          ControllerLinking -> All} } }} ;


(*     arrow 4  *)
(* Thickness[0.00183],Arrowheads[0.01176],*)
coord={{Thickness[0.00043],Arrowheads[0.00876],Arrow[{{{0,0,0},{18.95π,0,0}}, {{0,0,0},{0,1.18,0}}
          ,{{0,0,0},{0,0,1.18}}}]}};

pb1 = Graphics3D[ {Black,
                                   Line[{{1.20π,1,0},{1.20π,-1,0}}],
                               Black,GrayLevel[.065,.065],Cuboid[{1.20 Pi-.2250,-0.971  ,-0.971  },{1.20Pi+.2250,0.971  ,0.971  }]}   ];
  
pb2 = Graphics3D[ {Black,
                                Rotate[Line[{{5.21 Pi,1,0},{5.21 Pi,-1,0}}],β,{1,0,0}],
                               Black,GrayLevel[.045,.045],Rotate[Cuboid[{5.21 Pi-.2250,-0.971  ,-0.971  },{5.21 Pi+.2250,0.971  ,0.971  }],β,{1,0,0}]}   ];
                           (* coorde = Re[Insert[E2,8.5Pi,1]]/. x->8.5Pi /.t->(t1);
            coordb = B2R/. x1-> 8.5Pi ; *)
pb3 = Graphics3D[ {Black,
                                Rotate[  Line[{{9.41Pi,1,0},{9.41 Pi,-1,0}}],β,{1,0,0}],
                               Black,GrayLevel[.035,.035],Rotate[Cuboid[{9.41 Pi-.2250,-0.971  ,-0.971  },{9.41 Pi+.2250,0.971  ,0.971  }],β,{1,0,0}]}   ];

pb4 = Graphics3D[ {Black,
                                  Rotate[ Line[{{13.61Pi,1,0},{13.61Pi,-1,0}}],β,{1,0,0}],
                               Black,GrayLevel[.025,.025],Rotate[Cuboid[{13.61 Pi-.2250,-0.971  ,-0.971  },{13.61 Pi+.2250,0.971 ,0.8111}],β,{1,0,0}]}   ];

               coorde4 =E4C/.x1->17.810  Pi;
               coordb4 = B4D/.x1->17.810 Pi ;
 
               coorde3 =E3C/.x1->13.61  Pi;
               coordb3 = B3D/.x1->13.61 Pi ;
coorde33 =E3C/.x1->17.81  Pi;
               coordb33 = B33/.x1->17.81 Pi;

                 coorde2 =E2C/.x1->9.41  Pi;
               coordb2 = B2D/.x1->9.41Pi ;

coorde22 =E2C/.x1->17.81  Pi;
               coordb22 = B22/.x1->17.81Pi ;

                coorde1 =E1/.x1->5.21  Pi;
               coordb1 = B1D/.x1->5.21Pi ;
coorde11 =E1L/.x1->17.81  Pi;
               coordb11 = B11/.x1->17.81Pi ;

 seb1 = Graphics3D[{Purple,Thick, Line[{{{5.21Pi,0,0},coorde1},{{ 5.21Pi,0,0 },coordb1} }]} ];

 se1 = ParametricPlot3D[Re[Insert[E1L,5.21Pi,1]]/.x->x1/.t->(t1) ,{x1,1.2 Pi+0.2,5.21Pi}
             , ImageSize-> {525,625}
              ,PlotStyle->{Blue,Thin}];

 sb1 = ParametricPlot3D[B1D,{x1,1.2 Pi+0.2,5.21Pi}
             , ImageSize-> {525,625}
              ,PlotStyle->{Orange,Thick} ]; 

(* seb11 = Graphics3D[{Purple,Thick, Line[{{{17.81Pi,0,0},coorde11},{{ 17.81Pi,0,0 },coordb11} }]} ];*)
seb11 = Graphics3D[{Cyan,Thickness[0.004121],Arrowheads[0.00233],  Arrow[{{{17.81Pi,0,0},coorde11},{{ 17.81Pi,0,0 },coordb11} }]} ];

 se11 = ParametricPlot3D[Re[Insert[E1,17.81Pi,1]]/.x->x1/.t->(t1) ,{x1,1.2 Pi+0.2,17.81Pi}
             , ImageSize-> {525,625}
              ,PlotStyle->{Blue,Thin}];

 sb11 = ParametricPlot3D[B11,{x1,1.2 Pi+0.2,17.81Pi}
             , ImageSize-> {525,625}
              ,PlotStyle->{Orange,Thick} ]; 


  seb2 = Graphics3D[{Purple,Thick, Line[{{{9.41Pi,0,0},coorde2},{{ 9.41Pi,0,0 },coordb2} }]} ];

 se2 = ParametricPlot3D[Re[Insert[E2,9.41Pi,1]]/.x->x1/.t->(t1) ,{x1,5.21 Pi+0.2,9.41Pi}
             , ImageSize-> {525,625}
              ,PlotStyle->{Blue,Thin}];

 sb2 = ParametricPlot3D[B2D,{x1,5.21 Pi+0.2,9.41Pi}
             , ImageSize-> {525,625}
              ,PlotStyle->{Orange,Thick} ]; 

seb22 = Graphics3D[{Cyan,Thickness[0.004121],Arrowheads[0.00233],  Arrow[{{{17.81Pi,0,0},coorde22},{{17.81Pi,0,0 },coordb22} }]} ];


 se22 = ParametricPlot3D[Re[Insert[E2,17.81Pi,1]]/.x->x1/.t->(t1) ,{x1,5.21 Pi+0.2,17.81Pi}
             , ImageSize-> {525,625}
              ,PlotStyle->{Blue,Thin}];

 sb22 = ParametricPlot3D[B22,{x1,5.21 Pi+0.2,17.81Pi}
             , ImageSize-> {525,625}
              ,PlotStyle->{Orange,Thick} ]; 


  seb3 = Graphics3D[{Purple,Thick, Line[{{{13.61Pi,0,0},coorde3},{{ 13.61Pi,0,0 },coordb3} }]} ];

se3 = ParametricPlot3D[Re[Insert[E3,13.61Pi,1]]/.x->x1/.t->(t1) ,{x1,9.41 Pi+0.2,13.61Pi}
             , ImageSize-> {525,625}
              ,PlotStyle->{Blue,Thin}];

sb3 = ParametricPlot3D[B3D,{x1,9.41 Pi+0.2,13.61Pi}
             , ImageSize-> {525,625}
              ,PlotStyle->{Orange,Thick} ]; 

 seb33 = Graphics3D[{Green,Thickness[0.004121],Arrowheads[0.00233],  Arrow[{{{17.81Pi,0,0},coorde33},{{ 17.81Pi,0,0 },coordb33} }]} ];
 

se33 = ParametricPlot3D[Re[Insert[E3,17.81Pi,1]]/.x->x1/.t->(t1) ,{x1,9.41 Pi+0.2,17.81Pi}
             , ImageSize-> {525,625}
              ,PlotStyle->{Blue,Thin}];

sb33 = ParametricPlot3D[B33,{x1,9.41 Pi+0.2,17.81Pi}
             , ImageSize-> {525,625}
              ,PlotStyle->{Orange,Thick} ]; 

  seb4 = Graphics3D[{Cyan,Thickness[0.004121],Arrowheads[0.00233],  Arrow[{{{17.81Pi,0,0},coorde4},{{ 17.81Pi,0,0 },coordb4} }]} ];


se4 = ParametricPlot3D[Re[Insert[E4,17.81Pi,1]]/.x->x1/.t->(t1) ,{x1,13.61 Pi+0.2,17.81Pi}
             , ImageSize-> {525,625}
              ,PlotStyle->{Blue,Thin}];

sb4 = ParametricPlot3D[B4D,{x1,13.61 Pi+0.2,17.81Pi}
             , ImageSize-> {525,625}
              ,PlotStyle->{Orange,Thick} ]; 



(* ==========phase 1246 ======*) 
point11={PointSize[0.0261],GrayLevel[0.32], Point[{0,0}]};
ppoint21={PointSize[0.020],Purple, Point[{{0,0.90},{0,0.64}}]};
bpoint31={PointSize[0.020],GrayLevel[0.3], Point[{{0.90,0},{0.64,0}}]};
spoint41={PointSize[0.020],Blue, Point[{{0,-0.890},{0,-0.890},{0,-0.64},{0.642053,-0.6420530}}]};
spoint1264={PointSize[0.020],Blue, Point[{0.642053,-0.6420530}]};
spoint124={PointSize[0.020],Blue, Point[{{0,-0.890},{0,-0.64}}]};
fahspin11={Thickness[0.0000071],  Arrow[{ {-0.459601, 0.445384},{-0.452548,0.452548}}  ],HeadCenter->0.1,HeadLength->0.1};
fahspin17={Thickness[0.0000071],  Arrow[ {{-0.5269,-0.533452},{-0.5299,-0.5307}} ],HeadCenter->0.1,HeadLength->0.41};
favspin1246={Thickness[0.0000071],  Arrow[ {{0.4482,-0.45679},{0.4518,-0.4532}} ],HeadCenter->0.1,HeadLength->0.41};
favspin1264={Thickness[0.0000071],  Arrow[ { {{-0.4443,0.4606},{-0.4514,0.4536}} , {{0.4443,-0.4606},{0.45148,-0.453613}}   }],HeadCenter->0.1,HeadLength->0.41};
favarrow1 =  {Thickness[0.0001],Arrowheads[Medium],    Arrow[{ {0.9826,0.6163},{0.8880,0.7624}} ]};
faharrow1=  {Thickness[0.0001],Arrowheads[Medium],    Arrow[{{ {0.9826,-0.5163},{0.8980,-0.6524}} } ]};
ptext11={Text[StyleForm["<",FontSize->18, Black],{0.061,0.64516}]};
ptext21={Text[StyleForm[">",FontSize->18, Black],{-0.0526,-0.627}]};
ptrain11={Text[StyleForm["[1000]",FontSize->15, Black],{1.3760,0.08512}]};
helicity11={Text[StyleForm["(0,0,0,0)",FontSize->13],{1.3760,-0.085122}]};
ptrain21={Text[StyleForm["[1200] ",FontSize->15 ],{0.00630,1.5131}]};
helicity21={Text[StyleForm["(0,+1,0,0)",FontSize->13],{0.00630,1.311}]};

ptrain126={Text[StyleForm["[1260] ",FontSize->15],{-1.0000,0.9982}]};
helicity126={Text[StyleForm["(0,+1,+1,0)",FontSize->13],{-0.9992,0.8392}]};
ptrain1264={Text[StyleForm["[1264] ",FontSize->15],{0.9992,-0.89992}]};
helicity1264={Text[StyleForm["(0,+1,+1,-1)",FontSize->13],{1.0000,-1.0992}]};

ptrain31={Text[StyleForm["[1240] ",FontSize->15],{0,-1.3160}]};
helicity31={Text[StyleForm["(0,+1,-1,0)",FontSize->13],{0,-1.5260}]};
ptrain41={Text[StyleForm["[1246]",FontSize->16],{0.9415,-0.8815}]};
helicity41={Text[StyleForm["(0,+1,-1,-1)",FontSize->13],{0.9415,-1.0515}]};
ptrain51={Text[StyleForm["[1247]",FontSize->15],{-0.9415,-0.8815}]};
helicity51={Text[StyleForm["(0,+1,-1,-1)",FontSize->13],{-0.9415,-1.0515}]};
dphase11={Text[StyleForm["(Subscript[δϕ, p1])",FontSize->11, Black],{0.5878,0.4737}]};
dphase21={Text[StyleForm["(Subscript[δϕ, p2])",FontSize->11, Black],{-0.7399,0.0837}]};
dphase126={Text[StyleForm["(Subscript[δϕ, p2])",FontSize->11, Black],{-0.2889,0.6975}]}; 
dphase1264={Text[StyleForm["(Subscript[δϕ, p3])",FontSize->11, Black],{-0.5338,-0.5338}]};
dphase31={Text[StyleForm["(Subscript[δϕ, p3])",FontSize->11, Black],{0.2870,-0.6929}]};
dphase41={Text[StyleForm["(Subscript[δϕ, p4])",FontSize->11, Black],{-0.3252,-0.7452}]};
bvectors1 =  {Thickness[0.0075],Arrowheads[Large],    Arrow[{{0.05, 0.0}, {1.07, 0}}]};	              
vvectors1 =  {Thickness[0.0075],Arrowheads[Large],   Arrow[{{{0, 0.05}, {0, 1.07}} }]};	            
vvectors126 =  {Thickness[0.0075],Arrowheads[Large],   Arrow[{{{0, 0.05}, {0, 1.07}},{{-0.035,0.035}, {-0.771,0.771 }}  }]};	  

svectors1 =  {Thickness[0.0075],Arrowheads[Large],   Arrow[{  {{0.0,-0.05}, {0.0,-1.07 }},{{0.035,-0.035}, {0.771,-0.771 }}  } ]};	        
svectors1264 =  {Thickness[0.0075],Arrowheads[Large],   Arrow[{{{0.035,-0.035}, {0.771,-0.771 }}}]};	                    
svectors124 =  {Thickness[0.0075],Arrowheads[Large],   Arrow[{  {{0.0,-0.05}, {0.0,-1.07 }}}]};	      

outspinsv1 =  {Thickness[0.0001],Arrowheads[Large],  Arrow[{{{0.03137,0.9074},{0.0028,0.9079}}, {{-0.0313,-0.9079},{-0.00285,-0.907995}}, {{0.5787,-0.69962 },{0.5842,-0.6950} }} ]};	 
outspinsv124 =  {Thickness[0.0001],Arrowheads[Large],  Arrow[{{{0.03137,0.9074},{0.0028,0.9079}}, {{-0.0313,-0.9079},{-0.00285,-0.907995}}} ]};	
outspinsv1264 =  {Thickness[0.0001],Arrowheads[Large],  Arrow[{{{0.03137,0.9074},{0.0028,0.9079}}, {{-0.6303,0.65354},{-0.64053,0.6435}},{{0.63035,-0.65354},{0.6405,-0.64356}}} ]};	
outspinsv12 =  {Thickness[0.0001],Arrowheads[Large],  Arrow[{{{0.03137,0.9074},{0.0028,0.9079}}} ]};
          

circle01={Thickness[0.004], Circle[{0,0},0.908,{0, 7/4 Pi}]};
circle012={Thickness[0.004], Circle[{0,0},0.908,{0, 3/2 Pi}]};
circle12={Thickness[0.004], Circle[{0,0},0.908,{0, 1/2 Pi}]};
cdashed1= {Thickness[0.00001],{Dashed,Circle[{0,0}, 0.908,{7/4 Pi,2Pi} ] }};
cdashed124= {Thickness[0.00001],{Dashed,Circle[{0,0}, 0.908,{3/2 Pi,2Pi} ] }};
cdashed012= {Thickness[0.00001],{Dashed,Circle[{0,0}, 0.908,{1/2 Pi,2Pi} ] }};
cphase11= { Thickness[0.001],Circle[{0,0}, 0.64,{0, 7/4 Pi} ] };
cphase124= { Thickness[0.001],Circle[{0,0}, 0.64,{1/2 Pi, 3/2  Pi} ] };
cphase12= { Thickness[0.001],Circle[{0,0}, 0.64,{0, 1/2 Pi} ] };
cphase41= {Thickness[0.001],Circle[{0,0}, 0.75,{ 5/4 Pi, 6/4 Pi} ] };

disk111= {Hue[0.1437], Disk[{0,0}, 0.85,{0, 1/2 Pi} ] };
disk211= {Hue[0.1137], Disk[{0,0}, 0.87,{1/2Pi,  Pi} ] };
disk126= {Hue[0.1337], Disk[{0,0}, 0.87,{1/2Pi, 3/4  Pi} ] };
disk1263= {Hue[0.1137], Disk[{0,0}, 0.87,{3/4 Pi,4/4  Pi} ] };
disk1264= {Hue[0.5102], Disk[{0,0}, 0.87,{4/4 Pi,7/4  Pi} ] };
disk221= {Hue[0.1988], Disk[{0,0}, 0.87,{Pi, 3/2  Pi} ] };
disk311= {Hue[0.51012],  Disk[{0,0}, 0.85,{3/2 Pi , 7/4 Pi} ] };
disk411= {Hue[0.2651898], Disk[{0,0}, 0.81,{ 3/2 Pi, 5/4 Pi} ] };
vhline1={Line[{{-1.25,0},{1.65,0}}],Line[{{0,-1.25},{0,1.251}}],Hue[0.1], Thickness[0.000004]};

phase1246=Graphics[Join[disk111,disk211,disk221,disk311,{Black,cphase11},{Purple,circle01},{Blue,vhline1},{GrayLevel[0.3],bvectors1},{Purple,vvectors1},{Blue,svectors1},{Purple,outspinsv1,favspin1246},{ptext11,ptext21,ptrain11,ptrain21,ptrain31,{GrayLevel[0.3],{ptrain11,helicity11}},{Purple,{ptrain21,helicity21}},{Blue,{ptrain31,helicity31}},{Blue,{ptrain41,helicity41}},dphase11,dphase21,dphase31,cdashed1},{point11,ppoint21,bpoint31,spoint41},{faxv,faxh},{Purple,favarrow1},{Blue,faharrow1}], ImageSize->283,  AspectRatio->Automatic];

phase1264=Graphics[Join[disk111,disk126,disk1263,disk1264,{Purple,circle01},{Blue,vhline1},{GrayLevel[0.3],bvectors1},{Purple,vvectors126},{Blue,svectors1264},{Purple,{outspinsv1264,favspin1264}},{ptext11,ptrain11,ptrain21,{GrayLevel[0.3],{ptrain11,helicity11}},{Purple,{ptrain21,ptrain126,helicity21,helicity126}},{Blue,{ptrain1264,helicity1264}},dphase11,dphase126,dphase1264,cphase11, cdashed1},{point11,ppoint21,bpoint31,spoint1264},{faxv,faxh},{Purple,favarrow1}], ImageSize->283,  AspectRatio->Automatic];


phase1240=Graphics[Join[disk111,disk211,disk221,{Black,{cphase12,cphase124}},{Purple,circle012},{Blue,vhline1},{GrayLevel[0.3],bvectors1},{Purple,vvectors1},{Blue,svectors124},{Purple,outspinsv124},{ptext11,ptext21,ptrain11,ptrain21,ptrain31,{GrayLevel[0.3],{ptrain11,helicity11}},{Purple,{ptrain21,helicity21}},{Blue,{ptrain31,helicity31}},dphase11,dphase21,cdashed124},{point11,ppoint21,bpoint31,spoint124},{faxv,faxh},{Purple,favarrow1},{Blue,faharrow1}], ImageSize->283,  AspectRatio->Automatic];

phase1200=Graphics[Join[disk111,{Purple,circle12},{Blue,vhline1},{Black,cphase12},{GrayLevel[0.3],bvectors1},{Purple,vvectors1},{Purple,outspinsv12}, {ptext11,ptrain11,ptrain21,{GrayLevel[0.3],{ptrain11,helicity11}},{Purple,{ptrain21,helicity21}},dphase11,cdashed012},{point11,ppoint21,bpoint31},{faxv,faxh},{Purple,favarrow1},{Blue,faharrow1}], ImageSize->283,  AspectRatio->Automatic];

" phase 1357 ----------------------------";
point1={PointSize[0.0261],GrayLevel[0.3], Point[{0,0}]};
bpoint1={PointSize[0.020],GrayLevel[0.32], Point[{0.90,0 }]};
bpoint2={PointSize[0.020],GrayLevel[0.32], Point[{{0.90,0}, {0.64,0} }]};
ppoint3={PointSize[0.020],Purple, Point[{{0,0.90},{0.0,0.64},{0.0,0.785},{0.642053,0.6420530},{-0.642053,0.6420530}}]};
ppoint37={PointSize[0.020],Purple, Point[{{0,0.90},{0.0,0.64}}]};
ppoint32={PointSize[0.020],Purple, Point[{{0,0.90},{0.0,0.64}}]};
ppoint32={PointSize[0.020],Purple, Point[{{0,0.90},{0.0,0.64}}]};
spoint4={PointSize[0.020],Blue, Point[{{0.0,-0.6420530},{0.0,-0.90}}]};
faxv0={Text[StyleForm["FA vertical ", Italic, FontSize->14, Purple ],{1.32133, 0.39863}]};
faxh0={Text[StyleForm["FA horizonatal ",Italic, FontSize->14, Blue],{1.50372, -0.32113}]};
faxv={Text[StyleForm["FAV ", Italic, FontSize->14, Purple ],{1.2133, 0.3863}]};
faxh={Text[StyleForm["FAH ",Italic, FontSize->14, Blue],{1.24133, -0.4113}]};

fahspin={Thickness[0.000071],  Arrow[{ {-0.459601, 0.445384},{-0.452548,0.452548}}  ],HeadCenter->0.1,HeadLength->0.1};
favspin={Thickness[0.000071],  Arrow[ {{0.538595,0.421935}, {0.53033, 0.44033}} ],HeadCenter->0.1,HeadLength->0.41};
ptext1={Text[StyleForm["≻",FontSize->18, Black],{-0.05,0.6413}]};
ptext17={Text[StyleForm["≻",FontSize->18, Black],{-0.4529,0.4521}] };
ptext2={Text[StyleForm["≺",FontSize->18, Black],{0.05,-0.6316}]};
ptrain2={Text[StyleForm["[1300]",FontSize->15, Blue],{0.00630,-1.22431}]};
ptrain27={Text[StyleForm["[1700]",FontSize->15, Blue],{0.861256,-0.8612}]};
htrain27={Text[StyleForm["(0,-1,0,0 )",FontSize->13, Blue],{0.861256,-0.9612}]};
htrain2={Text[StyleForm["(0,-1,0,0 )",FontSize->13, Blue],{0.00630,-1.3811}]};
ptrain1={Text[StyleForm["[1000]",FontSize->15,Black],{1.32760,0.0812}]};
htrain1={Text[StyleForm["(0,0,0,0)",FontSize->13, Black],{1.32760,-0.0812}]};
ptrain3={Text[StyleForm["(0,-1,+1,0)",FontSize->13, Black],{0.00630,1.12431}]};
ptrain3={Text[StyleForm["[1350]",FontSize->15, Purple],{0.00630,1.36431}]};
htrain3={Text[StyleForm["(0,-1,+1,0)",FontSize->13, Purple],{0.00630,1.24431}]};
ptrain37={Text[StyleForm["[1757]",FontSize->15, Purple],{0.0065304,1.376431} ]};
htrain37={Text[StyleForm["(0,-1,+1,+1)",FontSize->13, Purple],{0.0065304,1.254431}]};
ptrain4={Text[StyleForm["(0,-1,+1,+1)",FontSize->13,Purple],{-0.9615,0.8315}]};
htrain4={Text[StyleForm["[1356]",FontSize->15, Purple],{-0.9615,0.9515}]};
htrain5={Text[StyleForm["(0,-1,+1,+1)",FontSize->13, Purple],{0.9977,0.8577}]};
ptrain47={Text[StyleForm["[1750]",FontSize->15, Purple],{-0.963154,0.95165}]};
htrain47={Text[StyleForm["(0,-1,+1,0)",FontSize->13, Purple],{-0.963154,0.85165}]};
ptrain5={Text[StyleForm["[1357]",FontSize->16, Purple],{0.9977,0.9977}]};
dphase1={Text[StyleForm["(Subscript[δϕ, p3])",FontSize->11, Black],{0.2812,0.6790}]};
dphase2={Text[StyleForm["(Subscript[δϕ, p1])",FontSize->11, Black],{0.5878,-0.1357}]};
dphase17={Text[StyleForm["(Subscript[δϕ, p1])",FontSize->11, Black],{0.6878,-0.2317}]};
dphase27={Text[StyleForm["(Subscript[δϕ, p2])",FontSize->11, Black],{-0.765,0.0121}]};
dphase37={Text[StyleForm["(Subscript[δϕ, p3])",FontSize->11, Black],{-0.3099,0.686121}]};
dphase4={Text[StyleForm["(Subscript[δϕ, p4])",FontSize->11, Black],{-0.3065,0.77400}]};
phase123 =  {Thickness[0.01],Arrowheads[Large],
	                Arrow[{{{0, 0.05}, {0, 1.07}}, {{0.05,0}, {1.07,0 }} ,{{-0.035,0.035}, {-0.7751,0.7751 }}, {{-0.025,-0.025}, {-0.771,-0.771 }}}]};
bvectors =  {Thickness[0.0075],Arrowheads[Large],
	                Arrow[{{{0.05, 0.0}, {1.07, 0}}}]};	              
vvectors =  {Thickness[0.0075],Arrowheads[Large],
	                Arrow[{{{0, 0.05}, {0, 1.07}},{{-0.035,0.035}, {-0.7751,0.7751 }} ,{{0.035,0.035}, {0.7751,0.7751 }} }]};	        
vvectors175 =  {Thickness[0.0075],Arrowheads[Large],
	                Arrow[{{{-0.035,0.035}, {-0.7751,0.7751 }}  }]};	            
vvectors22 =  {Thickness[0.0075],Arrowheads[Large],
	                Arrow[{{{0, 0.05}, {0, 1.07}} }]};	              
svectors =  {Thickness[0.0075],Arrowheads[Large],
	                Arrow[  {{0.0,-0.035}, {0.0,-1.07 }}  ]};	    
svector17 =  {Thickness[0.0075],Arrowheads[Large],
	                Arrow[{{{0.035,-0.035}, {0.7751,-0.7751 }} }]};	
vvectors57 =  {Thickness[0.0075],Arrowheads[Large],
	                Arrow[{{{0, 0.05}, {0, 1.07}},{{-0.035,0.035}, {-0.7751,0.7751 }}  }]};	

          
outspins =  {Thickness[0.0001],Arrowheads[Large],      Arrow[{ {{0.01423,-0.9078},{0.01394,-0.9078}},{{-0.01397,0.9078},{-0.01112,0.9079}},  {{0.63188, 0.6520},{0.6420, 0.6420}}      }]};
outspins21 =  {Thickness[0.0001],Arrowheads[Large],  Arrow[ {{0.01423,-0.9078},{0.01394,-0.9078}}      ]};
outspins22 =  {Thickness[0.0001],Arrowheads[Large],   Arrow[{ {{0.01423,-0.9078},{0.01394,-0.9078}},{{-0.01397,0.9078},{-0.01112,0.9079}}    }]};
outspins227 =  {Thickness[0.0001],Arrowheads[Large],   Arrow[{ {{-0.6414,0.64265},{-0.6359,0.6480}},{{-0.01397,0.9078},{-0.01112,0.9079}}    }]};
outspins175 =  {Thickness[0.0001],Arrowheads[Large],   Arrow[{ {{-0.6414,0.64265},{-0.6359,0.6480}}    }]};
outspins228 =  {Thickness[0.0001],Arrowheads[Large],   Arrow[ {{0.69039,-0.5897},{0.68989,-0.5903}}   ]};
vinnerspin =  {Thickness[0.0001],Arrowheads[Medium],Purple,        Arrow[  {{-0.5462, 0.5637},{-0.5550, 0.5550}}  ]};
hinnerspin =  {Thickness[0.0001],Arrowheads[Medium],Blue,     Arrow[  {{0.4453, 0.4596},{0.45250, 0.45250}} ]};
hinnerspin17 =  {Thickness[0.0001],Arrowheads[Medium],Blue,     Arrow[  {{-0.4579,0.4471},{-0.4564,0.44858}} ]};
hinnerspin170 =  {Thickness[0.0001],Arrowheads[Medium],Blue,     Arrow[  {{0.4934,-0.4075},{0.4599,-0.4449}} ]};
hinnerspin1757 =  {Thickness[0.0001],Arrowheads[Medium],Blue,     Arrow[{{-0.0607,0.6371},{-0.01060,0.6399}} ]};
favarrow =  {Thickness[0.0051],Arrowheads[Medium],      Arrow[{ {0.95826,0.47163},{0.8180,0.67524}} ]};
   faharrow =  {Thickness[0.0051],Arrowheads[Medium],      Arrow[{{ {0.9826,-0.5163},{0.8980,-0.6524}} } ]};

circle0={Thickness[0.004], Circle[{0,0},0.908,{1/4 Pi, 1.99 Pi}]};
circle07={Thickness[0.004], Circle[{0,0},0.908,{2/4 Pi, 1.99 Pi}]};
circle175={Thickness[0.004], Circle[{0,0},0.908,{3/4 Pi, 1.99 Pi}]};
circle21={Thickness[0.004], Circle[{0,0},0.908,{0,-1/2 Pi}]};
circle17={Thickness[0.004], Circle[{0,0},0.908,{0,-1/4 Pi}]};
circle22={Thickness[0.004], Circle[{0,0},0.908,{-1/2 Pi,-3/2 Pi}]};
circle23={Thickness[0.004], Circle[{0,0},0.908,{-3/2 Pi,-7/4 Pi}]};

cphase21= { Thickness[0.001],Circle[{0,0}, 0.64,{0, -1/2  Pi} ] };
cphase170= { Thickness[0.001],Circle[{0,0}, 0.64,{0, -1/4  Pi} ] };
cphase22= { Thickness[0.001],Circle[{0,0}, 0.64,{-1/2  Pi, -3/2 Pi} ] };
cphase23= { Thickness[0.001],Circle[{0,0}, 0.64,{1/4  Pi, 2/4 Pi} ] };
cphase1= { Thickness[0.001],Circle[{0,0}, 0.64,{1/4 Pi, 1.99 Pi} ] };
cphase17= { Thickness[0.001],Circle[{0,0}, 0.64,{1/2 Pi, 1.99 Pi} ] };
cphase175= { Thickness[0.001],Circle[{0,0}, 0.64,{3/4 Pi, 1.99 Pi} ] };
cphase4= {Thickness[0.001],Circle[{0,0}, 0.785,{ 1/2Pi, 3/4 Pi} ] };
cdashed0= {Thickness[0.00001],{Dashed,Circle[{0,0}, 0.908,{ 0,2Pi} ] }};
cdashed1= {Thickness[0.00001],{Dashed,Circle[{0,0}, 0.908,{ 0,-1/4Pi} ] }};
cdashed2= {Thickness[0.00001],{Dashed,Circle[{0,0}, 0.908,{ 0,1/4Pi} ] }};

disk21= {Hue[0.1998], Disk[{0,0}, 0.85,{0, - 1/2 Pi} ] };
disk17= {Hue[0.1998], Disk[{0,0}, 0.85,{0, - 1/4 Pi} ] };
disk751= {Hue[0.2311], Disk[{0,0}, 0.85,{-1/4 Pi,-4/4 Pi} ] };
disk752= {Hue[0.1413], Disk[{0,0}, 0.85,{-4/4 Pi,-5/4 Pi} ] };
disk22= {Hue[0.1537], Disk[{0,0}, 0.87,{1/2 Pi, 3/2 Pi} ] };
disk23= {Hue[0.09437], Disk[{0,0}, 0.87,{1/2 Pi, 1/4 Pi} ] };

disk11= {Hue[0.1998], Disk[{0,0}, 0.85,{0,  1/2 Pi} ] };
disk12= {Hue[0.14137], Disk[{0,0}, 0.85,{1/2 Pi,3/2 Pi} ] };
disk13= {Hue[0.14137], Disk[{0,0}, 0.85,{3/2 Pi,7/4 Pi} ] };

disk1= {Hue[0.11437], Disk[{0,0}, 0.87,{1/2 Pi, 1/4 Pi} ] };
disk2= {Hue[0.1998], Disk[{0,0}, 0.85,{0, - 1/2 Pi} ] };
disk4= {Hue[0.14137], Disk[{0,0}, 0.85,{1/2 Pi,Pi} ] };
disk3= {Hue[0.2311], Disk[{0,0}, 0.85,{-1/2 Pi,-Pi} ] };
disk5= {Hue[0.10237], Disk[{0,0}, 0.785,{ 1/2 Pi, 3/4 Pi} ] };
disk57= {Hue[0.10237], Disk[{0,0}, 0.85,{ 1/2 Pi, 3/4 Pi} ] };
vhline={Line[{{-1.25,0},{1.65,0}}],Line[{{0,-1.25},{0,1.251}}],Hue[0.1], Thickness[0.000004]};

phase00=Graphics[Join[cdashed0,{Blue,vhline},{faxv0,faxh0},{Purple,favarrow},{Blue,faharrow} ], ImageSize-> 243, AspectRatio->Automatic] ;
phase10=Graphics[Join[cdashed0,{Blue,vhline},{faxv,faxh},{Purple,favarrow},{Blue,faharrow} ,{GrayLevel[0.3],bvectors},{Black,bpoint1},point1,{ptrain1,htrain1}], ImageSize-> 243, AspectRatio->Automatic] ;
GraphicsRow[{phase00,phase2}, ImageSize-> 775];
phase13=Graphics[Join[cdashed0,{Blue,vhline},{faxv,faxh},{Purple,favarrow},{Blue,faharrow},disk21,{Blue,{circle21,cphase21}},{Blue,svectors},{GrayLevel[0.3],bvectors},{Blue,outspins21},{point1,bpoint2,spoint4},ptext2,{ptext2,ptrain1,ptrain2,htrain1,htrain2,dphase2}], ImageSize-> 283, AspectRatio->Automatic] ;

phase17=Graphics[Join[cdashed0,{Blue,vhline},{faxv,faxh},{Purple,favarrow},{Blue,faharrow},disk17,{Blue,{circle17,cphase170}},{Blue,svector17},{GrayLevel[0.3],bvectors},{point1,bpoint2},{ptrain1,ptrain27,htrain1,htrain27,dphase2}], ImageSize-> 283, AspectRatio->Automatic] ;

 
phase135=Graphics[Join[cdashed0,{Blue,vhline},{faxv,faxh},{Purple,favarrow},{Blue,faharrow},disk21,disk2,disk3,disk4,{Blue,{circle21,cphase21,cphase22,circle22}},{Blue,svectors},{GrayLevel[0.3],bvectors},{Purple, vvectors22},{Blue,{outspins21,outspins22}},{point1,bpoint2,ppoint32, spoint4},ptext2,{ptext1,ptext2,ptrain1,ptrain2,htrain1,htrain2,dphase2,dphase37,ptrain3,htrain3}], ImageSize-> 283, AspectRatio->Automatic] ;

 

phase1357=Graphics[Join[cdashed0,{Blue,vhline},{faxv,faxh},{Purple,favarrow},{Blue,faharrow},disk1,disk2,disk3,disk4,disk5,{Blue,{circle21,cphase21,cphase22,cphase23,cphase4,circle22,circle23}},{Blue,svectors},{GrayLevel[0.3],bvectors},{Purple, vvectors},{Blue,{outspins21,outspins22,outspins,vinnerspin, hinnerspin}},{point1,ppoint3,bpoint2,ppoint32, spoint4},ptext2,{ptext1,ptext2,ptrain1,ptrain2,htrain1,htrain2,dphase2,dphase37,dphase1,dphase4,ptrain3,htrain3,ptrain4,htrain4,ptrain5,htrain5}], ImageSize-> 283, AspectRatio->Automatic] ;



phase1757=Graphics[Join[cdashed0,{Blue,vhline},{faxv,faxh}, {Purple,favarrow},{Blue,faharrow},disk17,disk751,disk752,disk57,{Black,cphase17},{Blue,{circle07,svector17}},{GrayLevel[0.3],bvectors},{Purple, vvectors57},{Blue,{outspins227,outspins228,hinnerspin17,hinnerspin170,hinnerspin1757}},{point1,ppoint37,bpoint2,ppoint32},{ptrain1,htrain1,dphase17,dphase27,dphase37,{Blue,vhline},ptrain27,htrain27,ptrain37,htrain37,ptrain47,htrain47}], ImageSize-> 283, AspectRatio->Automatic] ;

phase175=Graphics[Join[cdashed0,{Blue,vhline},{faxv,faxh}, {Purple,favarrow},{Blue,faharrow},disk17,disk751,disk752,{Black,cphase175,circle175},{Blue,{circle07, svector17}},{GrayLevel[0.3],bvectors},{Purple, vvectors175},{Blue,{outspins175,hinnerspin17,hinnerspin170}},{point1,bpoint2},{ptrain1,htrain1,dphase17,dphase27,{Blue,vhline},ptrain27,htrain27,ptrain47,htrain47}], ImageSize-> 283, AspectRatio->Automatic] ;



(* view={{200,0.0,0.0},{-200,0,0}   ,{2.311,-1.611,1.176}, {16.147,-6.3282,3.86}}  *)
                         
pa0=Graphics3D[Join[arrow01,arrow02,arrow03,arrow04,coord]
                                                ,BoxRatios->{1.34,0.3, 0.32} 
                                                ,Axes->False 
                                                 , Boxed->False
                                                 ,  PlotRange->{{0,18.96  π},{-1.2,1.2},{-1.2,1.2}}                                               
                                                 , ViewPoint->view[[i]]  
                            ,PlotLabel-> Style[Row[{ "helicity train = ",   Dynamic[{helicity1[dp11],helicity2[dp21],helicity3[dp31],helicity4[dp41]}  ],"                     "   }]        
                                            ,"Cambria", Hue[0.68], Italic,23], ImageSize->775                                              
                                                ,DisplayFunction->$DisplayFunction];
                                
pa1=Graphics3D[Join[arrow1,coord]
                                                 ,BoxRatios->{1.34,0.3, 0.32} 
                                                ,Axes->False 
                                                 , Boxed->False
                                               ,   PlotRange->{{0,18.96  π},{-1.2,1.2},{-1.2,1.2}} 
                                                , ImageSize->775                                              
                                                ,DisplayFunction->$DisplayFunction]; 
pa11=Graphics3D[Join[arrow11,coord]
                                                 ,BoxRatios->{1.34,0.3, 0.32} 
                                                ,Axes->False 
                                                 , Boxed->False
                                               ,   PlotRange->{{0,18.96  π},{-1.2,1.2},{-1.2,1.2}} 
                                                , ImageSize->775                                              
                                                ,DisplayFunction->$DisplayFunction]; 
                                                    
pa2=Graphics3D[Join[arrow2,coord]
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0, 18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775
,DisplayFunction->$DisplayFunction];
pa22=Graphics3D[Join[arrow22,coord]
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0, 18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775
,DisplayFunction->$DisplayFunction];


pa3=Graphics3D[Join[arrow3,coord]
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0, 18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775
,DisplayFunction->$DisplayFunction];
pa33=Graphics3D[Join[arrow33,coord]
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0, 18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775
,DisplayFunction->$DisplayFunction];

pa4=Graphics3D[Join[arrow4,coord],
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0,18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775,DisplayFunction->$DisplayFunction];

in00=Graphics3D[ {Join[arrow01,arrow02,arrow03,arrow04,coord],Inset[phase00,{0, 10.91, -0.311}] }
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                  ,   PlotRange->{{0,18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                  ,ImageSize->775,DisplayFunction->$DisplayFunction];

in10=Graphics3D[{Join[arrow11,coord],Inset[phase10,{0, 10.91, -0.311}]   }
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0,18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775,DisplayFunction->$DisplayFunction];
in12=Graphics3D[{Join[arrow22,coord],Inset[phase1200,{0, 10.91, -0.311}]}
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0,18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775,DisplayFunction->$DisplayFunction];
in124=Graphics3D[{Join[arrow33,coord],Inset[phase1240,{0, 10.91, -0.311}]}
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0,18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775,DisplayFunction->$DisplayFunction];
in1246=Graphics3D[{Join[arrow4,coord ],Inset[phase1246,{0,10.91,-0.311}]}
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0,18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775,DisplayFunction->$DisplayFunction];

in13=Graphics3D[{Join[arrow22,coord],Inset[phase13,{0, 10.91, -0.311}]}
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0,18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775,DisplayFunction->$DisplayFunction];
in17=Graphics3D[{Join[arrow22,coord],Inset[phase17,{0, 10.91, -0.311}]}
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0,18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775,DisplayFunction->$DisplayFunction];
in135=Graphics3D[{Join[arrow33,coord],Inset[phase135,{0, 10.91, -0.311}]}
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0,18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775,DisplayFunction->$DisplayFunction];
in1357=Graphics3D[{Join[arrow4,coord],Inset[phase1357,{0, 10.91, -0.311}]}
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0,18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775,DisplayFunction->$DisplayFunction];
in1757=Graphics3D[{Join[arrow4,coord],Inset[phase1757,{0, 10.91, -0.311}]}
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0,18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775,DisplayFunction->$DisplayFunction];

in175=Graphics3D[{Join[arrow33,coord],Inset[phase175,{0, 10.91, -0.311}]}
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0,18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775,DisplayFunction->$DisplayFunction];

in1264=Graphics3D[{Join[arrow4,coord],Inset[phase1264,{0, 10.91, -0.311}]}
                                                   ,BoxRatios->{1.34,0.2, 0.23} 
                                                  ,Axes->False 
                                                   , Boxed->False 
                                                   ,Axes->True 
                                                   ,   PlotRange->{{0,18.96 π},{-1.2,1.2},{-1.2,1.2}} 
                                                   ,ImageSize->775,DisplayFunction->$DisplayFunction];
jtrain0={pa0,pb1};
jtrain1={pa0,pa11,pb1,seb11,se11,sb11};
jtrain2={pa0,pa1, pa22,pb1,pb2,seb22,se22,sb22};
jtrain3={pa0,pa1,pa2,pa33,pb1,pb2,pb3,seb33,se33,sb33};
jtrain4= {pa0,pa1,pa2,pa3,pa4,pb1,pb2,pb3,pb4,seb4,se4,sb4};
jtrain00={pa0,pb1,in00};
jtrain11={pa0,pa11,in10,pb1,seb11,se11,sb11};
jtrain42={pa0,pa1, pa22,in12,pb1,pb2,seb22,se22,sb22};
jtrain43={pa0,pa1,pa2,pa33,in124,pb1,pb2,pb3,seb33,se33,sb33};
jtrain44= {pa0,pa1,pa2,pa3,in1246,pb1,pb2,pb3,pb4,seb4,se4,sb4};
jtrain52= {pa0,pa1, pa22,in13,pb1,pb2,seb22,se22,sb22};
jtrain17= {pa0,pa1, pa22,in17,pb1,pb2,seb22,se22,sb22};
jtrain53={pa0,pa1,pa2,pa33,in135,pb1,pb2,pb3,seb33,se33,sb33};
jtrain54= {pa0,pa1,pa2,pa3,in1357,pb1,pb2,pb3,pb4,seb4,se4,sb4};
jtrain175= {pa0,pa1,pa2,pa3,in175,pb1,pb2,pb3,seb33,se33,sb33};
jtrain1757= {pa0,pa1,pa2,pa3,in1757,pb1,pb2,pb3,pb4,seb4,se4,sb4};
jtrain64= {pa0,pa1,pa2,pa3,in1264,pb1,pb2,pb3,pb4,seb4,se4,sb4};

fignum={Text[StyleForm["(a) ",FontSize->42, Black],{0.0061,-1.1,1.422}]};

jtrain={ jtrain1, jtrain2,jtrain3,jtrain4,jtrain11,jtrain42,jtrain43,jtrain44,jtrain52,jtrain17,jtrain54,jtrain175,jtrain1757,jtrain64, jtrain00};

Show[jtrain[[j]]],



(* Style[" ",6, Italic,  Hue[0.6]],
Style[" (a)",38, Italic,  Hue[0.6]],*)
(* Style[" ",6, Italic,  Hue[0.6]],
Style[" (a)",38, Italic,  Hue[0.6]],*)

Delimiter,
   {t1,0, 18.95Pi, 0.00000025},
Delimiter,
  {{j,15,Text[Style[" Polarizing mode trains ",17,"Cambria",Hue[0.61]]]},                     
                               {1-> Text[Style[" Train 1 ", "Hevetica",Hue[0.672],12]],
                              2->Text[ Style[" Train 2 ", "Hevetica",Hue[0.672],12]],
                              3-> Text[Style[" Train 3", "Hevetica",Hue[0.672],12]],       
                              4-> Text[Style[" Train 4", "Hevetica",Hue[0.672],12]],                
                              5-> Text[Style[" Inset 1000", "Hevetica",Hue[0.672],12]],                                  
                             6-> Text[Style[" Inset 1200", "Hevetica",Hue[0.672],12]],                
                             7-> Text[Style[" Inset 1240", "Hevetica",Hue[0.672],12]],
                            8-> Text[Style[" Inset 1246", "Hevetica",Hue[0.672],12]],                                  
                            9-> Text[Style[" Inset 1200", "Hevetica",Hue[0.672],12]],              
                           10-> Text[Style[" Inset 1700", "Hevetica",Hue[0.672],12]],              
                           11-> Text[Style[" Inset 1357", "Hevetica",Hue[0.672],12]],                
                           12-> Text[Style[" Inset 175", "Hevetica",Hue[0.672],12]],   
                           13-> Text[Style[" Inset 1757", "Hevetica",Hue[0.672],12]],              
                          14-> Text[Style[" Inset 1264", "Hevetica",Hue[0.672],12]],   
                          15-> Text[Style[" No Train", "Hevetica",Hue[0.672],12]]
                             },                                                           
                       ControlType->PopupMenu,
                        ControlPlacement->Left}, 
Delimiter,

{{JvC,6,Text[Style["Polarizer ",Italic ,14]]}, 
  {1->Text[Style["Linear polarizer ","Cambria",12]], 
2->Text[Style["Circular polarizer(V)","Cambria",Hue[0.61],12]], 
3->Text[Style["Circular polarizer(H) ","Cambria",Hue[0.65],12]],
4->Text[Style["Eighth wave polarizer(V)","Cambria",Hue[0.78],12]],
5->Text[Style["Eighth wave polarizer(H)","Cambria",Hue[0.68],12]],
6->Text[Style["None" ,"Cambria",12]] }, 
   ControlType->PopupMenu,
   ControlPlacement->Left},

{{αdeg,45.,Text[Style["Wave input angle ",Italic ,14]]}, {0,11.3,30,45,60,90,120,135,150,180.},ControlPlacement->Left,Enabled->Dynamic[init],ImageSize->Small,
ControlType->PopupMenu,
ControlPlacement->Left},

  {{JmC,1, Text[Style["Wave Plate 1",Italic ,14]]},
{1-> Text[Style["Linear wave plate","Helvetica",12]],
2->Text[Style["Quarter-wave plate(V)","Cambria",12]], 
3->Text[Style["Quarter-wave plate(H)","Helvetica",12]], 
4->Text[Style["Half Wave  plate(V)","Helvetica",Hue[0.71],12]],
5->Text[Style["Half Wave  plate(H)","Helvetica",12]],
6->Text[Style["Eighth Wave  plate(V)","Helvetica",Hue[0.78],12]],
7->Text[Style["Eighth Wave  plate(H)","Helvetica",12]]
},
ControlType->PopupMenu,
ControlPlacement->Left},

{{βdeg,0,Text[Style["Polarizer inclined angle ",Italic ,14]]}, {0,5.3,30,45,60,90,120,135,150,180.},ControlPlacement->Left,Enabled->Dynamic[polarize],ImageSize->Small},

{{JtC,1, Text[Style["Wave Plate 2 ",Italic ,14]]},
{1-> Text[Style["Linear wave plate","Helvetica",12]],
2->Text[Style["Quarter-wave plate(V)","Cambria",12]], 
3->Text[Style["Quarter-wave plate(H)","Helvetica",12]], 
4->Text[Style["Half Wave  plate(V)","Helvetica",Hue[0.71],12]],
5->Text[Style["Half Wave  plate(H)","Helvetica",12]],
6->Text[Style["Eighth Wave  plate(V)","Helvetica",Hue[0.78],12]],
7->Text[Style["Eighth Wave  plate(H)","Helvetica",12]] 
},
ControlType->PopupMenu,
ControlPlacement->Left},
Delimiter,
{{JsC,1, Text[Style["Wave Plate 3 ",Italic ,14]]},
{1-> Text[Style["Linear wave plate","Helvetica",12]],
2->Text[Style["Quarter-wave plate(V)","Cambria",12]], 
3->Text[Style["Quarter-wave plate(H)","Helvetica",12]], 
4->Text[Style["Half Wave  plate(V)","Helvetica",Hue[0.71],12]],
5->Text[Style["Half Wave  plate(H)","Helvetica",12]],
6->Text[Style["Eighth Wave  plate(V)","Helvetica",Hue[0.78],12]],
7->Text[Style["Eighth Wave  plate(H)","Helvetica",12]] 
},
ControlType->PopupMenu,
ControlPlacement->Left},
Delimiter,

  {{i,3,Text[Style["ViewPoint",17,"Cambria",Hue[0.61]]]},                     
                               {1-> Text[Style["{0,1,0}  ", "Hevetica",12]],
                             2->Text[ Style["{0,-1,0}  ", "Hevetica",12]],
                             3-> Text[Style["{x1,y1,z1}", "Hevetica",12]],         
                             4-> Text[Style["{x2,y2,z2}", "Hevetica",12]]  },                                                           
                       ControlType->PopupMenu,
                        ControlPlacement->Left}, 
Delimiter,
Row [{Text[Style[" optical elements lineup= " ,"Cambria",15, Hue[0.61]]],  Dynamic[{JvC ,JmC,JtC,JsC}]  }],
Row [{Text[Style[" phase shift train " ,"Cambria",14, Hue[0.61]]],  Dynamic[{dp11,dp21 ,dp31 ,dp41}]   }],
Row [{Text[Style[" helicity train = " ,"Cambria",15, Hue[0.61]]],  Dynamic[{helicity1[dp11],helicity2[dp21],helicity3[dp31],helicity4[dp41]} ]  }],

Style["       ","Cambria",13, Hue[0.596011]]
 ,Frame->True
  ,FrameStyle->Directive[Gray,0]
,ControlPlacement->Left , 
TrackedSymbols->Manipulate,

Initialization:> {
E0 = {E^(I(k x - ω t)),E^(I(k x - ω t))}/. k->0.75 /. ω -> 1;
E01 = {E^(I(k x - ω t)),E^(I(k x - ω t))}/. k->0.55 /. ω -> 1.3;
JvO1=JvLinear[2];
JvO2=JvLinear[45];
JvO3=JvLinear[62];
JvO4=JvLinear[71];
JvLinear [α_] := {Cos[α],Sin[α]};
JvCircularV = 1/Sqrt[2] {1,I};
JvCircularH = 1/Sqrt[2] {1,-I};
JvEWV = 1/Sqrt[3] {1,1+I};
JvEWH =  1/Sqrt[3] {1,1-I};
JvL2Circular = 1/Sqrt[2] {I,1};
JvL3Circular = 1/Sqrt[2] {-I,-1};
JmLinear[β_] := {{Cos[β]^2,Sin[β] Cos[β]},{Sin[β] Cos[β],Sin[β]^2}};
JmQWPV = E^-(I Pi/4){{1,0},{0,I}};
JmQWPH = E^(I Pi/4){{1,0},{0,-I}};
JmHWPV = E^(-I Pi/2){{1,0},{0,-1}};
JmHWPH = E^(I Pi/2){{1,0},{0,-1}};
JmEWPV = {{1,0},{0,E^(I Pi 1/4)}};
JmEWPH = {{1,0},{0,E^(-I Pi 1/4)}};
Jv = JvLinear[Pi/4];
Jm = JmLinear[0]} ]

program    jdpmp4t.nb download at the site :

  http://home.mokwon.ac.kr/~heejy/program.htm
                   need password   "             "      helicity    
                                       
                              
 If you have any quetion of program mail to  "heejy@mokwon.ac.kr "

IV. Conclusion

( 1)  New platform jdpmp4t manipulates 
                   four-train polarization modes effectively rather than 
                    two-train platform  in Mathematica ( possible number of simulations   42 -> 2058).    

   (2)  Platform jdpmp4t  simulates the polarization modes of 
                    the vectorial transverse behavior satisfying 
                    Maxwell's eqs. exactly in the orthogonal set of { (OverVector[S]),(OverVector[E]), (OverVector[B])}.  

    ( 3)   Patform jdpmp4t  presents vetor fields with vector arrays calculated 
                at every point along  to  the advancing Poynting vectors in the platform,         
               which is a dynamic version of Maxwell's equations.

\[MathematicaIcon]  yubulhak \[MathematicaIcon]

💡 有弗學 學之不能弗措也 (中庸二十章)

💡  Beside the question when you have not chance to learn,but you start to learn you should not stop learning until you become a master of your field.-The doctrin of the mean-

Thank    you!

                ♠♠♠♠♠♠♠♠♠♠♠