Anderson Neutrino Mass Model for Three Neutrinos.

(e^1)[t_,W_]:=RandomReal[{2*t,2*t+W},{o,o,K,K}] ;K=15;o=3;
(* K is the number of left and right fermion in a single generation and o is the number of generations of clockwork fermion. *)

t=1;W=5;

fg = (e^1)[t,W];
(* Randomly generating the values of (e^ab) for different generations and clockwork fermion. *)

hk = Table[0,{i,1,o},{j,1,o},{k,1,K},{h,1,K}];
(* Dummy tensor to store the values of (e^ab) and (t^ab) *)

i=1;While[i<o+1,For[j=1,j<o+1,j++,For[k=1,k<K+1,k++,hk[[i,j,k,k]] = fg[[i,j,k,k]]]];i++]
(* Assigning values (e^ab) to the elements of dummy tensor hk *)

a= Table[(Subscript[p, i ,j]),{i,1,o},{j,1,o}];
(* Dummy variables to store the values of (t^ab) , here a and b refers to generation of fermion. *)

i=1;While[i<o+1,{j=1;While[j<o+1,(Subscript[p, i,j]) = t;j++]};i++]
(* Assigning values to these (t^ab) *)

a;
(* Values of (t^(ab ))are stored as (Subscript[p, a,b]) *)

i=1;While[i<o+1,For[j=1,j<o+1,j++, For[k=1,k<K,k++,{hk[[i,j,k+1,k]] = a[[i,j]],hk[[i,j,k,k+1]] = a[[i,j]]}]];i++] 
(* Creating the tensor containing (e^(ab ))and (t^(ab ))as its components, in ((Subscript[L, i])^a) and ((Subscript[R, j])^b) basis. *)

hk;
(* Tensor in ((Subscript[L, i])^a) and ((Subscript[R, j])^b) basis. *)

Converting rank 4 tensor hk to rank 2 matrix “mass mat” .

b = Table[(Subscript[f, i,j]) ,{i,1,o},{j,1,o}]
(* Creating the matrix that will store the elements of tensor hk as its elements *)

i=1;While[i<o+1,For[j=1,j<o+1,j++, b[[i,j]] = Table[0,{h,1,K},{l,1,K}]];i++]
(* Assigning dummy values 0 to these created matrix (Subscript[b, i,j]) *)

i=1; While[i<o+1,{j=1; While[j<o+1,For[q=1,q<K+1,q++,For[s=1,s<K+1,s++,b[[i,j]][[q,s]] = hk[[i,j,q,s]] ]];j++]};i++]
(* Assigning elements of hk as values to elements of matrix (Subscript[b, i,j]) *)

j=1;While[j<o+1,{i=2;While[i<o+1,b[[j,i]] = Join[b[[j,i-1]],b[[j,i]],2];i++]};j++]

(* Joining these matrix to form a bigger matrix. *)

i=2;While[i<o+1,b[[i,o]] = Join[b[[i-1,o]],b[[i,o]]];i++] 
(* Joining these matrix to form the final matrix that is consistent with tensor hk. *)

massmat = b[[o,o]];
(* This is the matrix ((Subscript[H, i,j])^(a,b)) in ((Subscript[L, i])^a) and ((Subscript[R, j])^b) basis. *)

Changing basis from ((Subscript[L, i])^a) and ((Subscript[R, j])^b)  to ((Subscript[ψ, L,k])^c) and ((Subscript[ψ, R,l])^d)   .

{u,w,v} = SingularValueDecomposition[massmat]; 
(* We are taking the SVD decomposition for above defined mass matrix to convert it to a basis where ((Subscript[L, i])^a) basis can be converted to (Subscript[(((Subscript[ψ, L])^b)), i]) basis and ((Subscript[R, j])^b) basis to (Subscript[(((Subscript[ψ, R])^c)), j]) basis. *)

New = Transpose[u].Table[(Subscript[lo, n]),{n,1,K*o}];  
(* This is the conversion of ((Subscript[L, i])^a) basis to (Subscript[(((Subscript[ψ, L])^b)), i]) basis. *)

News = ConjugateTranspose[v].Table[(Subscript[co, n]),{n,1,K*o}];
(* This is the conversion of ((Subscript[R, j])^a) basis to (Subscript[(((Subscript[ψ, R])^b)), j]) basis. *)

FullSimplify[Sum[w[[i,i]]*New[[i]]*News[[i]],{i,1,K*o}] ];
(* This is checking condition just to test change in basis under SVD took place properly. *)

loke= Simplify[Inverse[Transpose[u]]];
(*This gives the conversion of (Subscript[(((Subscript[ψ, L])^a)), i]) basis to ((Subscript[L, i])^b) basis. Hence the components (Subscript[v, 1,n]) can be extracted from this matrix. *)

Roke = Simplify[Inverse[ConjugateTranspose[v]]];
(*This gives the conversion of (Subscript[(((Subscript[ψ, R])^a)), i]) basis to ((Subscript[R, i])^b) basis. Hence the components (Subscript[v, N,n]) can be extracted from this matrix. *)

v1 = Table[i,{i,1,o}];
vN = Table[i,{i,1,o}];
mN = Table[i,{i,1,o}];
(* Defining two dummy list to store the values of components (Subscript[v, 1,n]) and (Subscript[v, N,n]) .  *)

i=1;While[i<o+1,v1[[i]]= Table[n,{n,1,K*o}];i++]
i=1;While[i<o+1,vN[[i]]= Table[n,{n,1,K*o}];i++]
(* For different o each element of v1 and vN have K*o values. *)
i=1;While[i<o+1,mN[[i]]= Table[n,{n,1,K}];i++]

j=1;While[j<o+1,{i=1;While[i<K*o+1,v1[[j]][[i]] = loke[[(j-1)*K+1,i]];i++]};j++]
j=1;While[j<o+1,{i=1;While[i<K*o+1,vN[[j]][[i]] = Roke[[(j-1)*K+K,i]];i++]};j++]
(*Assigning values to v1 and vN from the loke and roke matrix respectively. *)
j=1;While[j<o+1,{i=1;While[i<K+1,mN[[j]][[i]] = w[[(j-1)*K+i,(j-1)*K+i]];i++]};j++]
(* In mN , first term refers to different values of n for same value of o . *)

i=1;While[i<o+1,v1[[i]] = ArrayReshape[v1[[i]],{o,K}];i++]
i=1;While[i<o+1,vN[[i]] = ArrayReshape[vN[[i]],{o,K}];i++]
(* In v1 first component corresponds to first value of o for the output basis. In first component the first row corresponds to different n components in same input basis, ((Subscript[v, 1,n])^(o,o)) and first column corresponds to different o for same component of n, ((Subscript[v, 1,1])^(o,o')) . Same thing for vN i.e., in vN[[i]][[j,k]] i fixes α, j fixes β and k fixes n . alpha is in ((Subscript[R, N])^α) and beta is in ((Subscript[ψ, R,n])^β) . *)

w;
(* w matrix has as its diagonal, the values of ((Subscript[m, N])^(a,b)) *)

Defining mass matrix of full Lagrangian in (ν^α) ,  ((Subscript[ψ, L,k])^c) , ((Subscript[ψ, R,l])^d) and  Ψ  basis.

M =  Table[0,{x,2*o*K+4},{y,2*o*K+4}] ;(* This is the dummy matrix to store the values of mass matrix for full lagrangian in basis (Subscript[(((Subscript[ψ, L])^b)), i])  and (Subscript[(((Subscript[ψ, R])^c)), j]). *)

tN = Table[t,{i,1,3},{j,1,o}]
(* For the coupling of RN and neutrino, (t^(α,a)) *)

tvN = Table[0,{i,1,3},{j,1,o},{k,1,K}];
(* Creating a dummy matrix to store the value of (tN^(α,a))*((Subscript[v, N,n])^(a,b)).
Here a and b comes from conversion of ((Subscript[R, N])^a) to (Subscript[(((Subscript[ψ, R])^b)), n]) *)

l=1;While[l<K+1,{k=1;While[k<o+1,{j=1;While[j<4,tvN[[j,k,l]] = Sum[tN[[j,i]]*vN[[i,k,l]],{i,1,o}];j++]};k++]};l++]

(*Computing these values for tvN and storing them as rank 3 tensor. *)

tvN ;
(* In tvN[[i]][[j,k]] i fixes α of neutrino flavour, j fixes b and k fixes n .  b and n are in ((Subscript[ψ, R,n])^b) . *)

t1 = Table[t,{i,1,o}];
(* For coupling of ((Subscript[L, 1])^a) and ψ *)

tv1 = Table[0,{i,1,o},{j,1,K}];
(* Creating dummy matrix to store the values of (t1^a)*((Subscript[v, 1,n])^(a,b)) , Here a comes from ((Subscript[L, 1])^a) and b comes from its conversion to ((Subscript[ψ, L,n])^b). *)

l=1;While[l<K+1,{k=1;While[k<o+1,tv1[[k,l]] = Sum[t1[[i]]*v1[[i,k,l]],{i,1,o}];k++]};l++] 
(* Assigning values to tv1 *)

tv1; (* Here first coordinate refers to β in output and second refers to its component n *)

tv1F = Flatten[tv1];
(* Flattening the above computed matrix to rank 1. *)

tvNF= ArrayReshape[tvN,{3,K*o}];
(* Flattening the rank 3 tvN to rank 2 matrix. *)

tvNF

j=1;While[j<4,{i=1;While[i<K*o+1,{M[[j,K*o+3+i]] = tvNF[[j,i]],M[[K*o+3+i,j]] = tvNF[[j,i]]};i++]};j++]
i=1;While[i<K*o+1,{M[[4+2*K*o,3+i]] = tv1F[[i]],M[[3+i,4+2*K*o]] = tv1F[[i]]};i++]
i=1;While[i<K*o+1,{M[[3+i,3+K*o+i]] = w[[i,i]],M[[3+K*o+i,3+i]] = w[[i,i]]};i++]
M[[2*K*o+4,2*o*K+4]] = W;
(* Assigning values to the mass matrix of lagrangian in (Subscript[(((Subscript[ψ, L])^b)), i])  and (Subscript[(((Subscript[ψ, R])^c)), j]) basis. *)

M;

Ev = Eigenvalues[M]

We can see from result for W = 10 Exavolt and t of the order of W , we get mass of three neutrinos as of the order of eV , with 4 generations and 10 clockwork fermions of both left and right kind in each generation.

Ev1 = Sort[Abs[ Ev]];

DiscretePlot[Ev1[[i]],{i,1,2*K*o+4},ExtentSize->0.4,ImageSize->680,BaseStyle->{FontFamily->"LM Roman 10",FontSize->10},Frame->True,PlotStyle-> {Opacity[0.9,RGBColor[0.1,.6,.8]],Directive[AbsoluteThickness[0]]},
Filling->Axis,FillingStyle->Opacity[0.9,RGBColor[0.1,.6,.8]],FrameTicks->{Automatic,Automatic},FrameLabel->{"N","M(Exa-eV)"},LabelStyle->Directive[Bold, Medium],Epilog->{Text["o=4",Scaled[{0.8,0.90}]],Text["W=10(EeV)",Scaled[{0.8,0.95}]],{Text["K=10",Scaled[{.8,.85}]]}}]

DiscretePlot[Abs[tvNF[[1,i]]],{i,1,K*o},ExtentSize->0.4,ImageSize->680,BaseStyle->{FontFamily->"LM Roman 10",FontSize->10},Frame->True,PlotStyle-> {Opacity[0.9,RGBColor[0.1,.6,.8]],Directive[AbsoluteThickness[0]]},
Filling->Axis,FillingStyle->Opacity[0.9,RGBColor[0.1,.6,.8]],FrameTicks->{Automatic,Automatic},FrameLabel->{"N","|t*vN|"},LabelStyle->Directive[Bold, Medium],Epilog->{}]
 (* Plot of interaction term (t^1)*((Subscript[v, N,n])^α) for neutrino 1. Here first K terms correspond to same generation then next K terms correspond to other generation. *)

DiscretePlot[Abs[tvNF[[2,i]]],{i,1,K*o},ExtentSize->0.4,ImageSize->680,BaseStyle->{FontFamily->"LM Roman 10",FontSize->10},Frame->True,PlotStyle-> {Opacity[0.9,RGBColor[0.1,.6,.8]],Directive[AbsoluteThickness[0]]},
Filling->Axis,FillingStyle->Opacity[0.9,RGBColor[0.1,.6,.8]],FrameTicks->{Automatic,Automatic},FrameLabel->{"N","|t*vN|"},LabelStyle->Directive[Bold, Medium],Epilog->{}] (* Plot of interaction term (t^2)*((Subscript[v, N,n])^α) for neutrino 2. Here first K terms correspond to same generation then next K terms correspond to other generation. *)

DiscretePlot[Abs[tvNF[[3,i]]],{i,1,K*o},ExtentSize->0.4,ImageSize->680,BaseStyle->{FontFamily->"LM Roman 10",FontSize->10},Frame->True,PlotStyle-> {Opacity[0.9,RGBColor[0.1,.6,.8]],Directive[AbsoluteThickness[0]]},
Filling->Axis,FillingStyle->Opacity[0.9,RGBColor[0.1,.6,.8]],FrameTicks->{Automatic,Automatic},FrameLabel->{"N","|t*vN|"},LabelStyle->Directive[Bold, Medium],Epilog->{}] (* Plot of interaction term (t^3)*((Subscript[v, N,n])^α) for neutrino 3. Here first K terms correspond to same generation then next K terms correspond to other generation. *)