(* Konkretne przyklady tworzenia macierzy D^j Wignera dla j > 1/2, startując z macierzy dla j=1/2 *)

(*"corrected" Clebsch-Gordan coefficients are defined*)myClebschGordan[j1_,j2_,j3_,m1_,m2_,m3_]:=If[(Abs[m1]≤j1)&&(Abs[m2]≤j2)&&(Abs[m3]≤j3)&&(m1+m2==m3)&&(j1+j2≥j3)&&(Abs[j1-j2]≤j3),ClebschGordan[{j1,m1},{j2,m2},{j3,m3}],0];

(* 
Uwaga: indeksy macierzy D12, D1, D32 itd. sa tak skonstruowane, ze Dj(m'=j,m=j)= Dj[1,1]  i ogolnie

Dj(m',m)=Dj[j-m'+1,j-m+1]  
*)

(* macierz obrotu D-Wignera dla j= 1/2 *)
j=1/2;
D12m=Array[D12,{2*j+1,2*j+1}];

D12[1,1]=E^(-I*(j+1-1)*alfa)*Cos[beta/2]*E^(-I*(j+1-1)*gamma)

D12[1,2]=E^(-I*(j+1-1)*alfa)*(-Sin[beta/2])*E^(-I*(j+1-2)*gamma)

D12[2,1]=E^(-I*(j+1-2)*alfa)*(Sin[beta/2])*E^(-I*(j+1-1)*gamma)

D12[2,2]=E^(-I*(j+1-2)*alfa)*(Cos[beta/2])*E^(-I*(j+1-2)*gamma)

MatrixForm[D12m]

(* macierz obrotu D-Wignera dla j=1 utworzone z macierzy dla j=1/2 *)
j=.;j=1;j1=1/2;j2=1/2;
D1m=Array[D1,{2*j+1,2*j+1}];

Do[D1m[[ip,i]]=Sum[myClebschGordan[j1,j2,j,m1p,j+1-ip-m1p,j+1-ip]*myClebschGordan[j1,j2,j,m1,j+1-i-m1,j+1-i]*D12m[[j1-m1p+1,j1-m1+1]]*
D12m[[j2-(j+1-ip-m1p)+1,j1-(j+1-i-m1 )+1]],{m1,-j1,j1,1},{m1p,-j1,j1,1}],{ip,1,2*j+1,1},{i,1,2*j+1,1}] ;

Do[Do[Print["D1[",j+1-ip,",",j+1-i,"]= ",FullSimplify[D1m[[ip,i]]]],{ip,1,2*j+1,1}],{i,1,2*j+1,1}]

(* MatrixForm[D1m] *)

alfa=0;gamma=0; (* teraz dostaniemy male d dla j=1 *)

(* MatrixForm[Simplify[D1m]] *)

Do[Do[Print["d1[",j+1-ip,",",j+1-i,"]= ",FullSimplify[D1m[[ip,i]]]],{ip,1,2*j+1,1}],{i,1,2*j+1,1}]

(* macierz obrotu D-Wignera dla j=2 utworzone z macierzy dla j=1 *)
alfa=.;gamma=.;j=.;j=2;j1=1;j2=1;
D2m=Array[D2,{2*j+1,2*j+1}];

Do[D2m[[ip,i]]=Sum[myClebschGordan[j1,j2,j,m1p,j+1-ip-m1p,j+1-ip]*myClebschGordan[j1,j2,j,m1,j+1-i-m1,j+1-i]*D1m[[j1-m1p+1,j1-m1+1]]*
D1m[[j2-(j+1-ip-m1p)+1,j1-(j+1-i-m1 )+1]],{m1,-j1,j1,1},{m1p,-j1,j1,1}],{ip,1,2*j+1,1},{i,1,2*j+1,1}] ;

(* MatrixForm[Simplify[D2m]]  *)

Do[Do[Print["D2[",j+1-ip,",",j+1-i,"]= ",FullSimplify[D2m[[ip,i]]]],{ip,1,2*j+1,1}],{i,1,2*j+1,1}]

alfa=0;gamma=0; (* teraz dostaniemy male d dla j=2 *)

(* MatrixForm[Simplify[D2m]]   *)

Do[Do[Print["d2[",j+1-ip,",",j+1-i,"]= ",FullSimplify[D2m[[ip,i]]]],{ip,1,2*j+1,1}],{i,1,2*j+1,1}]