Computations for the paper
Representations of the unitary group SU(2,1) in Fourier term modules

Roelof Bruggeman and Roberto Miatello

Some of the computations in this notebook are an essential part of the corresponding book, others are checks of hand computations.

Practical remark

The sections in this notebook are reasonably independent. There are some macros used in many sections; these are carried out at initialization. 
The other macros are defined in the section where they are used. Carry out the commands from the start of each section.

Chapter 2 with Sections 1-6

1 The group G=SU(2,1)

1a. Definitions of group and its operations

See 2.1.
Many of the routines defined here are use throughout this notebook.

Routine inG checks whether a matrix is an element of G=SU(2,1)

(I21={{1,0,0},{0,1,0},{0,0,-1}})//MatrixForm;
Clear[inG]
inG[g_]:=((Det[g]==1)&&Simplify[Conjugate[Transpose[g]].I21.g==I21])//.gensub
gensub={zz_ Conjugate[zz_]:>Abs[zz]^2,zz_^ee_ Conjugate[zz_]^ee_:>Abs[zz]^(2ee),Conjugate[pp_ qq_]:>Conjugate[pp]Conjugate[qq],Conjugate[pp_ +qq_]:>Conjugate[pp]+Conjugate[qq],Abs[pp_ qq_]:>Abs[pp]Abs[qq],Abs[pp_/qq_]:>Abs[pp]/Abs[qq],Abs[pp_+qq_]^2:>Abs[pp]^2+Abs[qq]^2+ pp Conjugate[qq]+Conjugate[pp]qq};

The special elements can be used in two ways: as matrices, with notation ending in m; and as elements for formal manipulation, with notation ending in s.

Clear[nm,ns,am,as,mm,ms,km,ks,wm,ws,hm,hs]
nm[b_,r_]:={{1+I r-Abs[b]^2/2,b,-I r+Abs[b]^2/2},{-Conjugate[b],1,Conjugate[b]},{I r-Abs[b]^2/2,b,1-I r+Abs[b]^2/2}};
nm[x_,y_,r_]:=nm[x+I (y),r]/.{Conjugate[x]->x,Conjugate[y]->y,Abs[x+I y]^2->x^2+y^2}//Simplify
mm[z_]=DiagonalMatrix[{z,z^(-2),z}];
am[y_]={{(y+1/y)/2,0,(y-1/y)/2},{0,1,0},{(y-1/y)/2,0,(y+1/y)/2}};
km[zt_,al_,bt_]:={{zt al,zt bt,0},{-zt Conjugate[bt],zt Conjugate[al],0},
{0,0,zt^(-2)}};
wm=km[1,-1,0];
hm[c_]=am[Abs[c]].mm[c/Abs[c]]//Simplify;

For the matrices we check whether they are in G.

Clear[b,r,x,y]
nm[b,r]//MatrixForm
inG[%]/.Conjugate[r]->r
nm[x,y,r]==nm[x+I y,r]//ComplexExpand

Clear[t]
am[t]//MatrixForm
inG[%]/.Conjugate[t]->t/.Abs[t]->t

Clear[zt]
mm[zt]//MatrixForm
inG[mm[zt]]/.Abs[zt]->1

Clear[zt,al,bt]
km[zt,al,bt]//MatrixForm
inG[km[zt,al,bt]]/.Conjugate[zt]->zt^(-1)/.Abs[zt]->1/.Abs[bt]^2->1-Abs[al]^2//Simplify
mm[zt]==km[zt^(-1/2),zt^(3/2),0]/.Conjugate[(zt^(3/2))]->zt^(-3/2)

The substitution rule Gsub  gives the group operations on the symbolic elements

Clear[id,iv]
Gsub={ns[b_,r_]**ns[b1_,r1_]:>ns[b+b1,r+r1+Im[Conjugate[b]b1]],ns[x_,y_,r_]**ns[x1_,y1_,r1_]:>ns[x+x1,y+y1,r+r1+x y1-y x1],ns[0,0,0]->id,ns[0,0]->id,iv[ns[b_,r_]]:>ns[-b,-r],iv[ns[x_,y_,r_]]:>ns[-x,-y,-r],
as[t_]**as[t1_]:>as[t t1],
as[1]->id,
iv[as[t_]]:>as[1/t],
ms[zt_]**ms[zt1_]:>ms[zt zt1],
ms[1]->id,iv[ms[zt_]]:>ms[1/zt],
as[t_]**ns[b_,r_]:>ns[t b,t^2 r]**as[t],ms[zt_]**ns[b_,r_]:>ns[zt^3 b,r]**ms[zt],
as[t_]**ns[x_,y_,r_]:>ns[t x,t y,t^2 r]**as[t],hs[c_]:>as[Abs[c]]**ms[c/Abs[c]],aa_**id:>aa,id**aa_:>aa,ms[zt_]**as[t]:>as[t]**ms[zt],iv[pp_**qq_]:>iv[qq]**iv[pp]};

Some checks of the group operations

Clear[b,r,b1,r1,x,y,x1,y1]
ns[b,r].ns[b1,r1]==ns[b+b1,r+r1+Im[Conjugate[b]b1]]/.ns->nm/.Im[zz_]:>(zz-Conjugate[zz])/(2I)//.gensub//Simplify
%/.Abs[zz_+zz1_]^2:>Abs[zz]^2+Abs[zz1]^2+zz Conjugate[zz1]+Conjugate[zz]zz1
ns[x,y,r].ns[x1,y1,r1]==ns[x+x1,y+y1,r+r1-y x1+x y1]/.ns->nm//Simplify

Clear[b,r]
iv[ns[b,r]]==ns[-b,-r]/.iv->Inverse/.ns->nm//.gensub
ns[b,r].iv[ns[b,r]]/.iv->Inverse/.ns->nm//.gensub//Simplify//MatrixForm

Clear[t,zt,b,r]
as[t].ms[zt].ns[b,r]==ns[zt^3 t b,t^2 r].as[t].ms[zt]/.{as->am,ns->nm,ms->mm}//.gensub/.{Conjugate[t]->t,Conjugate[zt]->1/zt,Abs[zt]->1,Abs[t]->t}//Simplify

1b. Bruhat coordinates to Iwasawa coordinates

We check the relation in Lemma 2.1 in §2.1.1

Clear[b,r,t,c,DD]
(* DD== 2 I r + t^2+Abs[b]^2}*)
ba=-c b/(Conjugate[c]^2DD)
ra=-r Abs[c]^(-2)Abs[DD]^(-2)
ta=t Abs[c]^(-1)Abs[DD]^(-1)

We want to see that 
 ((a(t'))^(-1)) ((n(b',r'))^(-1))w h(c)n(b,r) a(t)
 is equal to k1

k1a=am[ta^(-1)].nm[-ba,-ra].wm.hm[c].nm[b,r]. am[t]//.gensub//Simplify

k1 should have zeros at several positions. Let us first try to arrange that, by suitable substitutions.

sub1={-2I r + t^2+Abs[b]^2->Conjugate[DD],Abs[c]^2->c Conjugate[c]}

k1a[[2,3]]/.sub1

k1b=k1a//.sub1//Simplify

sub2={r Abs[b]^2->Abs[b]^2( -Conjugate[DD]+t^2+Abs[b]^2)/(2I),r^2->(Abs[DD]^2-(t^2+Abs[b]^2)^2)/4,Conjugate[DD]->Abs[DD]^2/DD};
sub2a={c^2 Conjugate[c]^2->Abs[c]^4,b Conjugate[b]->Abs[b]^2};

k1b[[1,3]]//.sub2//Simplify
%/.sub2a//Simplify

k1b//.sub2//Simplify
k1c=%//.sub2a//Simplify

sub3={r->(DD-Conjugate[DD])/(4I),Abs[b]^2->(DD+Conjugate[DD])/2-t^2,Abs[b]^4->((DD+Conjugate[DD])/2-t^2)^2,Abs[c]^3->c^2Conjugate[c]^2/Abs[c]};
sub3a={Abs[DD]^2->DD Conjugate[DD]};

The following element should be equal to 
c Conjugate[DD]/Abs[c]Abs[DD]

k1c[[3,3]]
%//.sub3//Simplify
%//.sub3a//Simplify

Now the third column has the desired form.

k1c//.sub3//Simplify;
k1d=%//.sub3a//Simplify

Also the third row has the right form :

k1d//.{DD Abs[DD]^(-2)->Conjugate[DD]^(-1)}//Simplify//MatrixForm

This is the element (Subscript[k, 1])in the lemma.

This element is in K⊂G. Let us check that directly.

Det[k1d]//.{zz_ Conjugate[zz_]:>Abs[zz]^2,t^2->(DD+Conjugate[DD])/2-Abs[b]^2,t^4->((DD+Conjugate[DD])/2-Abs[b]^2)^2}//Simplify
%/.Conjugate[xx_]:>Abs[xx]^2/xx//Simplify

inG[k1d]//.{Conjugate[t]->t,Abs[t]->t,t^2->(DD+Conjugate[DD])/2-Abs[b]^2,t^4->((DD+Conjugate[DD])/2-Abs[b]^2)^2}//Simplify
%//.{zz_ Conjugate[zz_]:>Abs[zz]^2,zz_^ee_ Conjugate[zz_]^ee_:>Abs[zz]^(2ee)}//Simplify

2 Symmetric space

2a. Sphere model

Not discussed in the present version of rFtm.
It consists of the pairs  ((Subscript[w, 1]),(Subscript[w, 2])) of complex numbers with
|(Subscript[w, 1])((|)^2)+ |(Subscript[w, 2])((|)^2)<1.

The action of g

Clear[actB]
actB[g_,{w1_,w2_}]:=Module[{ww},ww=g.{w1,w2,1};ww=ww/ww[[3]];Simplify[{ww[[1]],ww[[2]]}]]

Clear[w1,w2]
actB[wm,{w1,w2}]

(g={{a11,a12,b1},{a21,a22,b2},{Conjugate[c1],Conjugate[c2],d}})//MatrixForm

actB[g,{w1,w2}]
(Conjugate[c1] w1+Conjugate[c2] w2+d)%//Simplify

(g/.{b1->0,b2->0,c1->0,c2->0})//MatrixForm

2b. Upper half-plane model

See §2.1.1

Action on upper half-plane model derived from action on ball model

Clear[BtoX,XtoB,actX]
BtoX[{w1_,w2_}]:={I(1+w1)/(1-w1),I w2/(1-w1)}//Simplify
XtoB[{z_,u_}]:={(z-I)/(z+I),2u/(z+I)}//Simplify
actX[g_,{z_,u_}]:=Simplify[actB[g,XtoB[{z,u}]]]//BtoX//Simplify

Checks

Clear[z,u,w1,w2]
BtoX[XtoB[{z,u}]]
XtoB[BtoX[{w1,w2}]]

Clear[al,bt,zt,b,r,t]
actX[km[zt,al,bt],{z,u}]//FullSimplify
actX[km[zt,al,bt],{I,0}]
actX[wm,{z,u}]
actX[nm[b,r].am[t],{z,u}]

3 Lie algebra

The Lie algebra is discussed first in section 2.3, for K, and in section 2.4, for N. In section 3.1 is a discussion for the whole group SU(2,1).
Here we discuss the Lie algebra elements and routines for the Lie groep  bracket directly in the context of the group G.

3a. Real Lie algebra

Implementation of definitions in §2.2.2, §2.3, §3.1.

A basis for the real Lie algebra is given in the list XWlist.  The names in this list are at the basis of the computations; the order in the list determines the standard basis of the universal enveloping algebra. 
The routine Liesub transforms the Lie algebra elements into matrices. The subsitution Liesub0 is for formal manipulations.

Clear[HHr,HHi,XX0,XX1,XX2,WW0,WW1,WW2,CKi,Liesub]
Liesub[xx_]:=Module[{x},x=xx//.Liesub0;x//.Liesub1//Expand]
XWlist={XX0,XX1,XX2,HHr,HHi,WW0,WW1,WW2};

Liesub0a={lb[xx_,yy_]->Simplify[xx.yy-yy.xx],CKi->3WW0-2HHi};
Liesub1={nul->{{0,0,0},{0,0,0},{0,0,0}},
HHr->{{0,0,1},{0,0,0},{1,0,0}},
HHi->{{I,0,0},{0,-2I,0},{0,0,I}},XX0->{{(I/2),0,-(I/2)},{0,0,0},{(I/2),0,-(I/2)}},XX1->{{0,1,0},{-1,0,1},{0,1,0}},XX2->{{0,I,0},{I,0,-I},{0,I,0}},
WW0->{{I,0,0},{0,-I,0},{0,0,0}},
WW1->{{0,1,0},{-1,0,0},{0,0,0}},
WW2->{{0,I,0},{I,0,0},{0,0,0}}};
Liesub0b={};(* will be redefined later on *)
Liesub0:=Union[Liesub0a,Liesub0b];

Lie bracket

The routine inLie checks whether an element is in the real Lie algebra. The Lie bracket is given by lb.

Clear[inLie,lb,setlb,expc,t,nul]
inLie[X_]:=Module[{XX},XX=Liesub[X];FullSimplify[Conjugate[Transpose[XX]].I21+I21.XX==nul]//Liesub]
lb[xx_,xx_]:=nul
lb[-xx_,yy_]:=-lb[xx,yy]
lb[xx_+yy_,zz_]:=lb[xx,zz]+lb[yy,zz]
lb[ff_ xx_,yy_]:=ff lb[xx,yy]/;NumberQ[ff]
lb[xx_,-yy_]:=-lb[xx,yy]
lb[xx_,yy_+zz_]:=lb[xx,yy]+lb[xx,zz]
lb[ xx_,ff_ yy_]:=ff lb[xx,yy]/;NumberQ[ff]
lb[xx_,nul]:=nul
lb[nul,yy_]:=nul
setlb[X_,Y_,Z_]:=Module[{tr},tr=FullSimplify[X.Y-Y.X==Z]//Liesub;If[tr,lb[X,Y]=Z;lb[Y,X]=-Z;];tr]
expc[X_,gt_]:=FullSimplify[Simplify[MatrixExp[t X//Liesub]==gt]//.{Re[t]->t,Im[t]->0,Abs[t]->t,Conjugate[t]->t}]/.Conjugate[t]->t

Illustration

inLie[HHr]
inLie[I HHr]

Some checks

inLie[HHr]//Liesub
inLie[HHi]//Liesub
inLie[XX0]//Liesub
inLie[XX1]//Liesub
inLie[XX2]//Liesub
inLie[WW0]//Liesub
inLie[WW1]//Liesub
inLie[WW2]//Liesub

The routine setlb defines the values for the formal function lb, and checks  it by comparison with a matrix computation.

setlb[HHr,HHi,nul]

setlb[HHr,XX0,2XX0]
setlb[HHr,XX1,XX1]
setlb[HHr,XX2,XX2]
setlb[HHi,XX0,nul]
setlb[HHi,XX1,3XX2]
setlb[HHi,XX2,-3XX1]

setlb[XX1,XX2,4   XX0]
setlb[XX1,XX0,nul]
setlb[XX2,XX0,nul]

setlb[WW0,WW1,2WW2]
setlb[WW0,WW2,-2WW1]
setlb[WW1,WW2,2WW0]
setlb[HHi,WW0,nul]
setlb[HHi,WW1,3WW2]
setlb[HHi,WW2,-3WW1]

setlb[XX0,WW0,-(1/2)HHr]
setlb[XX0,WW1,(1/2)XX2]
setlb[XX0,WW2,-(1/2)XX1]
setlb[XX1,WW0,-XX2-WW2]
setlb[XX1,WW1,-HHr]
setlb[XX1,WW2,2XX0+HHi]
setlb[XX2,WW0,XX1+WW1]
setlb[XX2,WW1,-HHi-2XX0]
setlb[XX2,WW2,-HHr]

setlb[HHr,WW0,-2 WW0+HHi+2XX0]
setlb[HHr,WW1,XX1-WW1]
setlb[HHr,WW2,XX2-WW2]

lb[CKi,XX_]:=3lb[WW0,XX]-2lb[HHi,XX]
lb[XX_,CKi]:=3lb[XX,WW0]-2lb[XX,HHi]

CKi/.Liesub0
3 WW0-2 HHi/.Liesub0

3b. Basis for the complex Lie algebra

Definitions in  Table 3.2

Clear[Z13,Z31,Z12,Z21,Z23,Z32]
Zlist={Z13,Z23,Z12,CKi,WW0,Z21,Z32,Z31};
Liesub0b={Z12->WW1-I WW2,Z21->WW1+I WW2,
Z13->(1/2)HHr+I( XX0-(1/4)WW0-(1/4)CKi),
Z31->(1/2)HHr-I(XX0-(1/4)WW0-(1/4)CKi),
Z23->(1/2)(XX1-WW1+I(XX2-WW2)),
Z32->(1/2)(XX1-WW1-I(XX2-WW2))};

setlb[CKi,WW0,nul]
setlb[WW0,Z12,2I Z12]
setlb[WW0,Z21,-2I Z21]
setlb[CKi,Z12,nul]
setlb[CKi,Z21,nul]

setlb[CKi,Z23,3 I  Z23]
setlb[WW0,Z23,-I   Z23]
setlb[CKi,Z32,-3 I  Z32]
setlb[WW0,Z32,I   Z32]

setlb[CKi,Z13,3 I  Z13]
setlb[WW0,Z13,I   Z13]
setlb[CKi,Z31,-3 I  Z31]
setlb[WW0,Z31,-I   Z31]

setlb[Z32,Z31,nul]
setlb[Z21,Z31,nul]
setlb[Z21,Z32,2Z31]
setlb[Z13,Z31,-(I/2) CKi-(I/2)  WW0]
setlb[Z13,Z32,(1/2) Z12]
setlb[Z13,Z21,2 Z23]
setlb[Z23,Z31,-(1/2)  Z21]
setlb[Z23,Z32,-(I/2)(CKi-WW0)]
setlb[Z23,Z21,nul]
setlb[Z23,Z13,nul]
setlb[Z12,Z31,-2 Z32]
setlb[Z12,Z21,4I WW0]
setlb[Z12,Z13,nul]
setlb[Z12,Z23,2 Z13]
setlb[Z12,Z32,nul]

Transition between bases.

With the subsitution Liesub0 we express the Z-basis in the real basis. For the other direction the following routine XWtoZsub can be used.

Clear[al,co,mt,mti]
mt=Table[Coefficient[Zlist[[j]]//.Liesub0,XWlist[[k]]],{j,1,8},{k,1,8}];
mti=Inverse[mt];Table[XWlist[[j]]->Sum[mti[[j,k]]Zlist[[k]],{k,1,8}],{j,1,8}];
XWtoZsub=Delete[%,6];

Check

XWlist//.XWtoZsub//.Liesub0//Expand
%==XWlist
Zlist//.Liesub0//.XWtoZsub//Expand
%==Zlist

3c. Check of exponentiation map

Checks for (2.29), (2.39) and §3.1
expc checks the exponential by comparison with the routine MatrixExp

Check for n

expc[XX0,nm[0,t/2]]
expc[XX1,nm[t,0,0]]
expc[XX2,nm[0,t,0]]
expc[HHr,am[E^t]]

Checks for k

expc[HHi,mm[E^(I t)]]
expc[WW1,km[1,Cos[t],Sin[t]]]
expc[WW2,km[1,Cos[t],I Sin[t]]]
expc[WW2,{{Cos[t],I Sin[t],0},{I Sin[t],Cos[t],0},{0,0,1}}]
expc[WW0,km[1,E^(I t),0]]
expc[CKi,km[E^(I t),1,0]]

3d. Cartan subalgebras

See §3.1

Non-compact Cartan subalgebra

Cartan algebra spanned by HHi and HHr

lb[HHi,HHr]

Check of Table 3.3

{lb[HHr,XX1+I XX2],lb[HHi,XX1+I XX2]}=={XX1+I XX2,(-3I)(XX1+I XX2)}//Simplify
{lb[HHr,XX1-I XX2],lb[HHi,XX1-I XX2]}=={XX1-I XX2,3I(XX1-I XX2)}//Simplify
{lb[HHr,XX0],lb[HHi,XX0]}

Compact Cartan subalgebra

Check of Table 3.2

Z12//.Liesub0
Z23//.Liesub0//Expand
Z13//.Liesub0//Expand
Z21//.Liesub0//Expand
Z32//.Liesub0//Expand
Z31//.Liesub0//Expand

lb[CKi,Z12]
lb[CKi,Z23]
lb[CKi,Z13]
lb[CKi,Z21]
lb[CKi,Z32]
lb[CKi,Z31]

lb[WW0,Z12]
lb[WW0,Z23]
lb[WW0,Z13]
lb[WW0,Z21]
lb[WW0,Z32]
lb[WW0,Z31]

3e. Universal enveloping algebra, routines

See §3.1

The following routines are used for a standard ordering.
If another ordering is desired, then the lists XWlist and/or Zlist can be redefined.

Clear[posXW,posZ]
posXW[xx_]:=Module[{p},p=Position[XWlist,xx];If[p=={},0,p[[1]][[1]]]]
posZ[xx_]:=Module[{p},p=Position[Zlist,xx];If[p=={},0,p[[1]][[1]]]]

The multiplication in U(g) is implemented as NonCommutativeMultiply

Unprotect[NonCommutativeMultiply]
aa_**(bb_+cc_):=aa**bb+aa**cc
(aa_+bb_)**cc_:=aa**cc+bb**cc
aa_**nul:=nul
nul**aa_:=nul
aa_**0:=0
0**aa_:=0
(-aa_)**bb_:=-(aa**bb)
aa_**(-bb_):=-(aa**bb)
(ff_ aa_)**bb_:=ff (aa**bb)/;NumberQ[ff]
aa_**(ff_ bb_):=ff (aa**bb)/;NumberQ[ff]
xx_**yy_:=yy**xx+lb[xx,yy]/;0<posXW[yy]<posXW[xx]
xx_**yy_:=yy**xx+lb[xx,yy]/;0<posZ[yy]<posZ[xx]
Unprotect[Times]
ff_ xx_**yy_:=ff yy**xx+ff lb[xx,yy]/;0<posZ[yy]<posZ[xx]
Protect[Times]
ff_**aa_:=ff aa/;NumberQ[ff]
aa_**ff_:=ff aa/;NumberQ[ff]
Protect[NonCommutativeMultiply]

Checks

Table[XWlist[[i]]**XWlist[[j]]-XWlist[[j]]**XWlist[[i]]-lb[XWlist[[i]],XWlist[[j]]],{i,1,8},{j,1,8}]/.nul->0//MatrixForm

Table[Zlist[[i]]**Zlist[[j]]-Zlist[[j]]**Zlist[[i]]-lb[Zlist[[i]],Zlist[[j]]],{i,1,8},{j,1,8}]/.nul->0//MatrixForm

3f. Casimir element of (Subscript[K, 0])

See (2.34)

Definition

CasK=WW0**WW0+WW1**WW1+WW2**WW2
CasKZ=CasK/.XWtoZsub//Simplify

Is it central?

CasKZ**WW0-WW0**CasKZ
CasKZ**Z12-Z12**CasKZ//Expand
CasKZ**Z21-Z21**CasKZ//Expand
CasKZ**CKi-CKi**CasKZ/.nul->0//Expand

In the next checks we use the routines defined later on (carried out in initialization)

Clear[h,p,r,q]
eR[CasK,Phi[h,p,r,q],subtriv]
eR[CasKZ,Phi[h,p,r,q],subtriv]

eR[CKi,Phi[h,p,r,q],subtriv]

eR[WW0,Phi[h,p,r,q],subtriv]

3g. Center of the enveloping algebra

See §3.1

Casimir element

CasXW=HHr**HHr-4HHr-(1/3)HHi**HHi+4XX0**HHi-8XX0**WW0+4XX0**XX0-2XX1**WW1+XX1**XX1-2XX2**WW2+XX2**XX2
CasZ=CasXW//.XWtoZsub//Expand

Checks of centrality

Table[(XWlist[[j]]**CasXW-CasXW**XWlist[[j]]//Expand)/.nul->0,{j,1,8}]

Table[(Zlist[[j]]**CasZ-CasZ**Zlist[[j]]//Expand)/.nul->0,{j,1,8}]

Generator (Subscript[Δ, 3])

Only defined in the complex basis

Dt3Z=-(I/9)CKi**CKi**CKi+I CKi**WW0**WW0+
I Z12**CKi**Z21+2I Z13**CKi**Z31-6I Z13**WW0**Z31-6 Z13**Z21**Z32+2I Z23**CKi**Z32+6I Z23**WW0**Z32+6 Z23**Z12**Z31-2CKi**CKi+2 CKi**WW0+24Z13**Z31+24 Z23**Z32+8I CKi

Check of centrality

Table[(Zlist[[j]]**Dt3Z-Dt3Z**Zlist[[j]]//Expand)/.nul->0,{j,1,8}]

3h. Iwasawa decomposition

Check of Table 3.5

Z13==I XX0+(1/2)HHr+(I/2)(HHi-2WW0)//Liesub
Z31==-I XX0+(1/2)HHr-(I/2)(HHi-2WW0)//Liesub
Z23==(1/2)(XX1+I XX2)-(1/2)(WW1+I WW2)//Liesub
Z32==(1/2)(XX1-I XX2)-(1/2)(WW1-I WW2)//Liesub

4 Functions on K

Section 2.2

4a. Character

§2.3

km[eta,al,bt]//Simplify//MatrixForm
%[[3,3]]^(-j/2)/.(gg_^ee_)^ff_:>gg^(ee ff)//FullSimplify
mm[eta]//Simplify//MatrixForm
%[[3,3]]^j

4b. Lie algebra action on basis polynomials

See §2.2.1 and §2.2.2

We need the action of WW1 and WW2 with exponentials km[1,Cos[t],Sin[t]] and km[1,Cos[t],I Sin[t]]
These elements are in SU(2) and we can work with the generating function in (2.24).

The generating function

Clear[a,b,c,d,x,p,q,r]
g={{a,b,0},{c,d,0},{0,0,1}};
Ph[a_,b_,c_,d_,p_,q_]:=(a x+c)^((p-q)/2)(b x+d)^((p+q)/2)

Right differentiate with respect to WW1 and WW2

Compute right translation

u={{a,b,0},{c,d,0},{0,0,1}}
v=u.km[1,Cos[t],Sin[t]]/.Conjugate[xx_]:>xx

Insert result

dPh1=D[Ph[a Cos[t]-b Sin[t],b Cos[t]+a Sin[t],c Cos[t]-d Sin[t],d Cos[t]+c Sin[t],p,q],t]/.t->0//Simplify

Similarly for the other Lie algebra element

u={{a, b,0},{ c,d,0},{0,0,1}}
v=u.km[1,Cos[t],I Sin[t]]/.Conjugate[x_]:>x

Clear[dPh2]
dPh2=D[Ph[a Cos[t]+I b Sin[t],b Cos[t]+I a Sin[t],c Cos[t]+I d Sin[t],d Cos[t]+I c Sin[t],p,q],t]/.t->0//Simplify

Combination in (Subscript[Z, 12]) and (Subscript[Z, 21]).

Clear[eps]
dPheps=dPh1+I eps dPh2//Simplify

dPheps/.eps->1//Simplify
%==(q-p) Ph[a,b,c,d,p,q+2]//Simplify

dPheps/.eps->-1//Simplify
%==(q+p) Ph[a,b,c,d,p,q-2]//Simplify

So the generating function satisfies the desired relations, and hence its coefficients satisfy the relation as well.

Left differentiate with respect to WW1 and WW2

Left and right differentiation commute. It suffices to consider q=p

Clear[Phi]
Phi[r_]=(*This is (Subscript[((Φ^(p/2))), r/2,p/q ])*)Binomial[p,(p-r)/2]b^((p-r)/2)d^((p+r)/2)

u={{a,b,0},{c,d,0},{0,0,1}}
v=km[1,Cos[t],Sin[t]].u/.Conjugate[xx_]:>xx

Phi[r]/.b->b Cos[t]+d Sin[t]/.d->d Cos[t]-b Sin[t]
dPh1=D[%,t]/.t->0//Simplify

u={{a, b,0},{ c,d,0},{0,0,1}}
v=km[1,Cos[t],I Sin[t]].u/.Conjugate[xx_]:>xx

Phi[r]/.b->b Cos[t]+I d Sin[t]/.d->d Cos[t]+I b Sin[t]
dPh2=D[%,t]/.t->0//Simplify

dPh[eps_]=dPh1+I eps dPh2//Simplify

dPh[1]
%/.r->-p

dPh[1]/Phi[r-2]//FullSimplify

dPh[-1]/Phi[r+2]//FullSimplify
dPh[-1]/.r->p

4c. Explicit expressions for the basis functions

See (2.24)

Clear[al,bt,zt]
k=km[zt,al,bt]//MatrixForm

Clear[Phi,Xpol,genf]
genf[p_,q_,{zt_,al_,bt_}]=(al Xpol-Conjugate[bt])^((p-q)/2)(bt Xpol+Conjugate[al])^((p+q)/2);
Phi[h_,p_,r_,q_,{zt_,al_,bt_}]:=zt^(-h)If[p==r,genf[p,q,{zt,al,bt}]/.Xpol->0,Coefficient[genf[p,q,{zt,al,bt}],Xpol^((p-r)/2)]]

Phi[h,0,0,0,{zt,al,bt}]

Phi[h,1,1,1,{zt,al,bt}]
Phi[h,1,1,-1,{zt,al,bt}]
Phi[h,1,-1,1,{zt,al,bt}]
Phi[h,1,-1,-1,{zt,al,bt}]

km[zt,al,bt]//MatrixForm

4d. Multiplication relations

This concerns  Table 2.1

Clear[Phiprod,APhiprod,BPhiprod]
APhiprod[eps_,zt_,p_,r_]:=(p+eps r+2)/(2(p+1))
BPhiprod[eps_,zt_,p_,r_,q_]:=If[eps r==p,0,eps(zt p-q)/(2(p+1)),eps(zt p-q)/(2(p+1))](* in case of doubt keep expression *)
Phiprod[eta_,eps_,zt_,h_,p_,r_,q_,lst_]:=APhiprod[eps,zt,p,r]Phi[h+eta,p+1,r+eps,q+zt,lst]+BPhiprod[eps,zt,p,r,q]Phi[h+eta,p-1,r+eps,q+zt,lst]
Phiprod[eta_,eps_,zt_,h_,p_,r_,q_]:=(* for symbolic computation *)APhiprod[eps,zt,p,r]Phi[h+eta,p+1,r+eps,q+zt]+BPhiprod[eps,zt,p,r,q]Phi[h+eta,p-1,r+eps,q+zt]

Check

Clear[eta,eps,zt,h,p,r,q,al,bt,ztt,eq]
repeat=5;(* we checked it with repeat equal to 20; that takes long *)
ksub={Conjugate[zz_]:>Abs[zz]^2/zz,Abs[bt]^2->1-Abs[al]^2};
Do[eq=(Phi[eta,1,eps,zt,{ztt,al,bt}]Phi[h,p,r,q,{ztt,al,bt}]==Phiprod[eta,eps,zt,h,p,r,q,{ztt,al,bt}]//.ksub//Simplify);
If[eq,,Print[{p,r,q},"  ",eq]],{p,0,repeat},{r,-p,p,2},{q,-p,p,2},{eps,-1,1,2},{zt,-1,1,2}]

No output means OK

5 Functions on N

§2.3, §3.3.2

5a. Automorphisms

See § 2.3

Automorphism given by element of (Subscript[GL, 2])

Clear[aa,bb,cc,dd,A]
A[ns[x_,y_,r_]]:=ns[aa x+bb y,cc x+dd y,(aa dd-bb cc)r]

Clear[x,x1,y,y1,r,r1]
ns[x,y,r]**ns[x1,y1,r1]//.Gsub
A[%]==A[ns[x,y,r]]**A[ns[x1,y1,r1]]//.Gsub//Simplify

Interior automorphism

n1=ns[x1,y1,r1]
n1**ns[x,y,r]**iv[n1]//.Gsub//Simplify

Special cases

Clear[t,th]
A[ns[x,y,r]]/.{aa->t,dd->t,bb->0,cc->0}
as[t]**ns[x,y,r]**iv[as[t]]//.Gsub

nn1=A[ns[x,y,r]]//.{aa->Cos[3th],bb->-Sin[3th],cc->Sin[3th],dd->Cos[3th]}/.ns[xx_,yy_,rr_]:>ns[xx+I yy,rr]//Simplify
nn2=ms[E^(I th)]**ns[x+I y,r]**iv[ms[E^(I th)]]//.Gsub
nn1==nn2//FullSimplify

Comparison with action of Thangavelu

Clear[T,Ti,Ns,x,y,r]
T[Ns[xx_,yy_,rr_]]:=ns[xx,yy/2,-rr]
Ti[ns[xx_,yy_,rr_]]:=Ns[xx,2 yy,-rr]
Ti[T[Ns[x,y,r]]]

Clear[u,v,s]
Ns[x,y,r]**Ns[u,v,s]
T[%]/.T[aa_**bb_]:>T[aa]**T[bb]//.Gsub
Ti[%]//Simplify

5b. Schrödinger representation

See §2.3.1.

Clear[pi,xi]
pi[ld_,ns[x_,y_,r_],ph_]:=E^(I ld(r-2xi x-y x))(ph/.xi->xi+y)

Clear[x,y,r,x1,y1,r1,ph]
n=ns[x,y,r];n1=ns[x1,y1,r1];
n2=n**n1//.Gsub;
pi[ld,n1,ph[xi]]
pi[ld,n,%]
%==pi[ld,n2,ph[xi]]//Simplify

Check of (2.47)

D[pi[ld,ns[0,0,t/2],ph[xi]],t]/.t->0
D[pi[ld,ns[t,0,0],ph[xi]],t]/.t->0
D[pi[ld,ns[0,t,0],ph[xi]],t]/.t->0

5c. Theta functions

Section 2.3.2

Clear[Th,sum,k,xi]
Th[ell_,c_,ph_,ns[x_,y_,r_],k_]:=sum[k]E^(2Pi I ell(r-x(c/ell+2k+y)))(ph/.xi->c/(2ell)+k+y)//Simplify
Th[ell_,c_,ph_,n_]:=Th[ell,c,ph,n,k]

Relations

Relations for left translation in (2.49)

Clear[ell,c,ph,x,y,r]
Th[ell,c,ph[xi],ns[1/(2ell),0,0]**ns[x,y,r]]//.Gsub//Simplify
%/(E^(-Pi I c/ell)Th[ell,c,ph[xi],ns[x,y,r]])//Simplify

Th[ell,c,ph[xi],ns[0,1/(2ell),0]**ns[x,y,r]]//.Gsub
%==Th[ell,c+1,ph[xi],ns[x,y,r]]//Simplify

Differentiation relations in (2.54) and (2.55)

Clear[t]

Th[ell,c,ph[xi],ns[x,y,r]**ns[t,0,0]]//.Gsub
D[%,t]/.t->0//Simplify
%==-4Pi I ell Th[ell,c,xi ph[xi],ns[x,y,r]]//Simplify

Th[ell,c,ph[xi],ns[x,y,r]**ns[0,t,0]]//.Gsub
D[%,t]/.t->0//Simplify
%==Th[ell,c,ph'[xi],ns[x,y,r]]//Simplify

Th[ell,c,ph[xi],ns[x,y,r]**ns[0,0,t/2]]//.Gsub
D[%,t]/.t->0//Simplify
%==Pi I ell  Th[ell,c,ph[xi],ns[x,y,r]]//Simplify

5d. Integration of theta functions

Orthogonality in (2.56)

Clear[int,diff,x,y,r,sg,ph,ps,xi,ell,c,ella,ca,k,ka]
i1=int[x,0,1]int[y,0,1]int[r,0,2/sg]Th[ell,c,ph[xi],ns[x,y,r],k]Conjugate[Th[ella,ca,ps[xi],ns[x,y,r],ka]]diff[x]diff[y]diff[r]//.gensub/.{Conjugate[ella]->ella,Conjugate[ca]->ca,Conjugate[x]->x,Conjugate[y]->y,Conjugate[r]->r,Conjugate[ka]->ka,Conjugate[sum[ka]]->sum[ka]}//Simplify

Integration over r concerns only the following factor

i1fr=E^(2Pi I (ell r-ella r))

Since ℓ-ℓ’ is 0 modulo σ/2 integration over r in [0,2/σ] yields zero unless ℓ=ℓ’.

i2=i1/.ella->ell/. int[r,0,(2/sg)]->2/sg/.diff[r]->1//Simplify

Integration over x in [0,1] involves the factor

i2fx=(E^(-2 I (c-ca+2 ell (k-ka)) π x))

Since c-ca+2ell(k-ka) is integral the integral over x yields zero unless this quantity vanishes.  So c-ca should be zero modulo 2ell. We can assume that c and ca are taken in [0,2|ell|-1]. So we get zero unless c=ca and k=ka

i3=i2/.ca->c/.ka->k/.sum[k]^2->sum[k]/.int[x,0,1]->1/.diff[x]->1//Simplify

Take  k + y as new variable, integrating over R. This gives the orthogonality formula.

5e. Hermite functions

See §2.3.2

Definitions and some checks

The Hermite polynomials

Clear[Hermpol,xi]
Hermpol[0]=1;
Hermpol[m_]:=Hermpol[m]=Module[{h},h=Hermpol[m-1];2xi h-D[h,xi]//Expand]
Hermpol[m_]:=0/;m<0

Do[Print[m,"  ",Hermpol[m]],{m,0,5}]

Relation

Table[Hermpol[m+1]==2 xi Hermpol[m]-2 m Hermpol[m-1]//Simplify,{m,0,15}]

Normalized Hermite functions as explicit functions, in (2.59)

Clear[Hermn]
Hermn[ell_,m_,x_]:=2^((1-m)/2)Abs[ell]^(1/4)Factorial[m]^(-1/2)(Hermpol[m]/.xi->Sqrt[4Pi Abs[ell]]x)E^(-2Pi Abs[ell]x^2)//Simplify

Clear[ell]
Do[Print[m,"  ",Hermn[ell,m,xi]//Simplify],{m,0,5}]

See Table 2.3

Check of orthogonality

See (2.60)

bd=5;Table[Integrate[Hermn[ell,m,xi]Hermn[ell,ma,xi],{xi,-Infinity,Infinity}],{m,0,bd},{ma,0,bd}]//MatrixForm

5f. Relations for normalized Hermite functions

See Table 2.4

Normalized Hermite functions for symbolic computation
(Hermn defined in 5e denotes the explicit function, here hermn is defined for symbolic manipulation)

Clear[hermn,xi,hermsub,dif]
dif[aa_+bb_]:=dif[aa]+dif[bb]
dif[ ff_ aa_]:=ff dif[aa]/;FreeQ[ff,hermn]
hermsub[x_]:=Module[{xx},xx=Expand[x/.hermrel];xx//.hermrel//Simplify]
hermrel={dif[hermn[ell_,k_]]:>Sqrt[4Pi Abs[ell]]( Sqrt[k/2]hermn[ell,k-1]-Sqrt[(k+1)/2]hermn[ell,k+1]),
xi hermn[ell_,k_]:>(4Pi Abs[ell])^(-1/2)( Sqrt[k/2]hermn[ell,k-1]+Sqrt[(k+1)/2]hermn[ell,k+1]),xi^n_ hermn[ell_,k_]:>xi^(n-1) (4Pi Abs[ell])^(-1/2)( Sqrt[k/2]hermn[ell,k-1]+Sqrt[(k+1)/2]hermn[ell,k+1])};

Check of relations for some values

Clear[rel]
rel[k_]=dif[hermn[ell,k]]//hermsub
Do[Print[k,"  ",D[Hermn[ell,k,xi],xi]==rel[k]/.hermn[el_,m_]:>Hermn[el,m,xi]//Simplify],{k,0,5}]

Clear[rel]
rel[k_]=xi hermn[ell,k]//hermsub
Do[Print[k,"  ",xi Hermn[ell,k,xi]==rel[k]/.hermn[el_,m_]:>Hermn[el,m,xi]//Simplify],{k,0,5}]

Clear[rel]
rel[k_]=xi^2 hermn[ell,k]//hermsub
Do[Print[k,"  ",xi^2 Hermn[ell,k,xi]==rel[k]/.hermn[el_,m_]:>Hermn[el,m,xi]//Simplify],{k,0,5}]

This gives confidence that we use the right relations.

5g. Operator B

See the discussion of the metaplectic action in §3.3.2.

Action on Hermite functions

Check that B acts on (Subscript[h, ℓ,m]) as multiplication by (i/2)(2m+1) Sign(ell)

First term (((8πiℓ))^(-1))D[h,{xi,2}]

Clear[xi,ell,m]

hermn[ell,m]
dif[%]/.hermrel
term1=(8Pi I ell)^(-1)dif[%]/.hermrel//Simplify

hermn[ell,m]
xi %/.hermrel
term2=((2Pi I ell) xi %//Expand)/.hermrel//Simplify

term1+term2//Simplify
%/.Abs[ell]^2->ell^2/.Abs[ell]->eps ell

Commutation relations

Clear[ph,ell,xi,XX0,XX1,XX2,dpi,B]
dpi[XX0,phh_]:=Pi I ell phh
dpi[XX1,phh_]:=-4Pi I ell xi phh
dpi[XX2,phh_]:=D[phh,xi]
B[phh_]:=(8Pi I ell)^(-1)D[phh,{xi,2}]+2Pi I ell xi^2 phh;

B[dpi[XX1,ph[xi]]]-dpi[XX1,B[ph[xi]]]== - dpi[XX2,ph[xi]]//Simplify

B[dpi[XX2,ph[xi]]]-dpi[XX2,B[ph[xi]]]==  dpi[XX1,ph[xi]]//Simplify

B[dpi[XX0,ph[xi]]]-dpi[XX0,B[ph[xi]]]//Simplify

Further computations

Clear[v,z,r,x,y]
mm[E^(I v)].nm[z,r].mm[E^(-I v)]==nm[E^(3 I v) z,r]//Simplify
%/.Im[v]->0/.Conjugate[v]->v

E^(3 I v)(x+I y)==(Cos[3v]x-Sin[3v]y)+I(Sin[3v]x+Cos[3v]y)//Simplify

{Cos[3v]x-Sin[3v]y,(Sin[3v]x+Cos[3v]y)}
vxy=D[%,v]/.v->0

vxy/.x->1/.y->0
vxy/.x->0/.y->1

6 Discrete subgroup and lattice

See (2.70) in §2.4

UFL={{-I/Sqrt[2],0,1/Sqrt[2]},{0,1,0},{-I/Sqrt[2],0,-1/Sqrt[2]}};
Conjugate[Transpose[UFL]].I21.UFL//MatrixForm

Inverse[UFL].hm[ups].UFL//Simplify//MatrixForm

Inverse[UFL].nm[b,r].UFL//Simplify//MatrixForm

am[Sqrt[2]].nm[1,0].am[1/Sqrt[2]]==nm[Sqrt [2],0]//Simplify
am[Sqrt[2]].nm[I,0].am[1/Sqrt[2]]==nm[I Sqrt [2],0]//Simplify
am[Sqrt[2]].nm[0,1/4].am[1/Sqrt[2]]==nm[0,1/2]//Simplify

hm[E^(Pi I/4)].nm[1,0].hm[E^(-Pi I/4)]==nm[-(1-I)/Sqrt[2],0]//Simplify
hm[E^(Pi I/4)].nm[I,0].hm[E^(-Pi I/4)]==nm[- (1+I)/Sqrt[2],0]//Simplify
hm[E^(Pi I/4)].nm[0,2/4].hm[E^(-Pi I/4)]==nm[0,1/2]//Simplify

hm[1+I].nm[0,r].hm[1/(1+I)]==nm[0,2r]//Simplify

nm[0,1/2]//MatrixForm

nm[(1+I)^(-1),0]//MatrixForm

Inverse[UFL].nm[b,r].mm[zt].UFL//Simplify//MatrixForm

Chapter 3 with Sections 7-16

7 Shift operators, construction

§3.1

7a. Shift operators in general (g,K)-modules

Here we carry out computations supporting the proof of Proposition 3.1 and check Table 3.4.

Clear[h,p,v,w]

First upward shift operator

v satisfies the following relations
CKi**v = -I h v
WW0**v = - i p v
CasKZ**v=-p(p+2)v
Z21**v=0

The action and the composition of operators are presented by ** (NonCommutativeMultiply)

We use the relations to establish the desired relation for w=Z31 v

CKi**w+I(h+3)w/.w->Z31**v/.CKi**Z31**v->Z31**(-I h v)+lb[CKi,Z31]**v/.XX_**(h YY_)->h(XX**YY)//Expand

WW0**w+I(p+1)w/.w->Z31**v/.WW0**Z31**v->Z31**(-I p v)+ lb[WW0,Z31]**v/.XX_**(p YY_)->p(XX**YY)//Expand

CasKZ**w+(p+1)(p+3)w//.{WW0**w->-I(p+1)w,XX_**((p+1) YY_)->(p+1)(XX**YY)}/.w->Z31**v//.{Z21**Z31**v:>0+lb[Z21,Z31]**v}/.nul->0//Expand

Second upward shift operator

Again we have:

CKi**v == -I h v
WW0**v == - I p v
CasKZ**v==-p(p+2)v
Z21**v==0

Now w=(Subscript[Z, 23])v

w=X23**v

CKi**w+I(h-3)w/.w->Z23**v/.CKi**v->-I h v/.XX_**(h YY_):>h(XX**YY)//Expand

WW0**w+I(p+1)w/.w->Z23**v/.WW0**v->- I p v/.XX_**(p YY_):>p(XX**YY)//Expand

CasKZ**w+(p+1)(p+3)w/.w->Z23**v//Expand
%//.{WW0**v->-I p v,XX_**(p YY_):>p(XX**YY),Z21**v->0}/.nul->0

Commutator

lb[Z31,Z23]

This vanishes on highest weight vectors.

First downward shift operator

Given is v with the properties

Clear[u,v]

CKi**v == -I h v
WW0**v == - I p v
CasKZ**v==-p(p+2)v
Z21**v==0

We take u=(Subscript[Z, 32])v

CKi**u+I(h+3)u/.u->Z32 **v//.{CKi**Z32**v->Z32**(-I h v)+lb[CKi,Z32]**v,XX_**(h YY_)->h(XX**YY)}//Expand

WW0**u+I(p-1)u/.u->Z32 **v//.{WW0**Z32**v->Z32**(-I p v)+lb[WW0,Z32]**v,XX_**(p YY_)->p(XX**YY)}//Expand

CasKu=CasKZ**u/.u->Z32**v//.{WW0**Z32**v->-I p Z32**v+lb[WW0,Z32]**v,XX_**(p YY_)->p(XX**YY),Z21**Z32**v->0+lb[Z21,Z32]**v}/.Z32**v->u//Expand

Clear[up,um,CKu]
eq={up+um==u,-(p-1)(p+1)um-(p+1)(p+3)up==CKu}
sol=Solve[eq,{up,um}][[1]]/.Z32**v->u//FullSimplify

sol/.CKu->CasKu//Simplify

We take (Subscript[((S^3)), -1])v = (Subscript[u, p-1]),
and check the descriptions in (3.5)

{um,up}={um,up}/.sol/.CKu->CasKu

{um==Z32**v+(2(p+1))^(-1)Z12**Z31** v,um==p(p+1)^(-1)Z32**v+(2(p+1))^(-1)Z31**Z12**v}/.u->Z32**v//Expand//Simplify

Second downward shift operator

Given is v with the properties

CKi**v == -I h v
WW0**v == - I p v
CasKZ**v==-p(p+2)v
Z21**v==0

We take  u as given by  (Subscript[((S^(-3))), -1 ])v with the shift operator indicated in Table 3.4 (first description)

Clear[u]
usub={u->Z13 **v-(2(p+1))^(-1)Z12**Z23**v}

Check of eigenvalue of (Subscript[C, i]) and (Subscript[W, 0])

CKi**u+I(h-3)u/.usub//.{CKi**v->-I h v,nul->0,aa_**(h bb_):>h aa**bb,aa_**(bb_/(p+1)):>(p+1)^(-1)(aa**bb),Z23**Z12**v->Z12**Z23**v+lb[Z23,Z12]**v}//Simplify

WW0**u+I(p-1)u/.usub//.{YY_**((p+1)^(-1)XX_):>(p+1)^(-1)(YY**XX),WW0**v->-I p v,YY_**(p XX_):>p(YY**XX)}//Simplify

Check of K-type

CasKZ**u+(p-1)(p+1)u/.usub//.{Z21**v->0,WW0**v->-I p v,nul->0,aa_**(p bb_):>p aa**bb,aa_**(bb_/(p+1)):>(p+1)^(-1)(aa**bb)}//Simplify

Highest weight?

Z21**u/.usub//.{WW0**v->-I p v,Z21**v->0,nul->0,aa_**(bb_/(p+1)):>(p+1)^(-1)(aa**bb),aa_**(p bb_):>p aa**bb}//Simplify

So indeed u ∈ (Subscript[V, h-3,p-1,p-1])
Alternative description

u==p(p+1)^(-1)Z13**v-(2(p+1))^(-1)Z23**Z12**v/.usub//Expand//Simplify

Commutator of downward shift operators

Take v as above

CKi**v == -I h v
WW0**v == - I p v
CasKZ**v==-p(p+2)v
Z21**v==0

Both downward shift operators decrease p by one.

p1={(Z13-(2p)^(-1)Z12**Z23)**(Z32+(2(p+1))^(-1)Z12**Z31)**v,(Z32+(2p)^(-1)Z12**Z31)**(Z13-(2(p+1))^(-1)Z12**Z23)**v}//Expand

Factors to the front, and then use relations for v.

p1[[1]]-p1[[2]]//.{XX_**(ff_^(-1)YY_):>ff^(-1) XX**YY,(ff_^(-1)XX_)**YY_:>ff^(-1)XX**YY,CKi**v->-I h v,YY_**(h XX_):>h(YY**XX),WW0**v->-I p v,YY_**(p XX_):>p(YY**XX),Z21**v->0}/.nul->0//Expand//Simplify

7b. Minimal vectors

See §3.1

Part ii) of lemma 3.4

Clear[v,h,p]
x1=sh[-3,-1]**sh[3,1]**v-(p+1)sh[3,-1]**sh[-3,1]**v/.{sh[-3,-1]**sh[3,1]**v->(Z13-(2(p+2))^(-1)Z12**Z23)**Z31**v,sh[3,-1]**sh[-3,1]**v->(Z32+(2(p+2))^(-1)Z12**Z31)**Z23**v}//.{CKi**v->-I h v,WW0**v->-I p v,(ff_^(-1)XX_)**YY_:>ff^(-1)XX**YY,Z21**v->0}//Expand//Simplify

x1/.Z12**Z31**v->-(2(p+1))Z32**v//.{XX_**((p+1)YY_):>(p+1)XX**YY}//Simplify

Casimir element, part iii) of the lemma

x1=CasZ**v-4(p+2)(p+1)^(-1)sh[-3,-1]**sh[3,1]**v

x2=x1/.{sh[-3,-1]**sh[3,1]**v->(Z13-(2(p+2))^(-1)Z12**Z23)**Z31**v}//.{ CKi**v->-I h v,WW0**v->-I p v,XX_**(ff_  v):>ff XX**v,Z21**v->0,(ff_^(-1)XX_)**YY_:>ff^(-1)XX**YY}//Simplify

Use of minimality

x2/.Z12**Z31**v->-(2(p+1))Z32**v//.{XX_**((1+p)YY_):>(1+p) XX**YY}//Expand//Factor

Central element of degree 3, part iv) of the lemma

In a similar way

x1=Dt3Z**v-2(p+2)(h-3p+6)(p+1)^(-1) sh[-3,-1]**sh[3,1]**v/.{sh[-3,-1]**sh[3,1]**v->(Z13-(2(p+2))^(-1)Z12**Z23)**Z31**v}

x2=x1//.{ CKi**v->-I h v,WW0**v->-I p v,XX_**(ff_  v):>ff XX**v,Z21**v->0,(ff_^(-1)XX_)**YY_:>ff^(-1)XX**YY}/.Z12**Z31**v->-(2(p+1))Z32**v//Simplify

x3=x2//.{WW0**XX_**v:>-I p XX**v+lb[WW0,XX]**v,CKi**XX_**v:>-I h XX**v+lb[CKi,XX]**v,XX_**(p YY_):>p XX**YY,XX_**(h YY_):>h XX**YY,Z21**XX_**v:>0 + lb[Z21,XX]**v}//Simplify

x3//.{XX_**(p YY_):>p XX**YY}//Simplify//Factor

8 Explicit right differentiation of functions on G

In Section 3.2 of the paper we describe explicitly  the action of the Lie algebra by right differentiation on functions that have the form 
  g = nak ↦ F(na) Φ(k)
  with respect to the Iwasawa decomposition. The functions Φ are the basis functions Phi in Section 3 of this notebook; we treat them symbolically. The action on F(na) is described in terms of the right differentiation of n⊕a on NA.

8a. Conjugation by elements of K

See (3.16), (3.17)

Embedding  SU(2,1) in SL(3,C), a check of the relations in (7.3) can be carried out in the complex Lie algebra of SL(3,C).

z13=Z13//Liesub;
z23=Z23//Liesub;
z31=Z31//Liesub;
z32=Z32//Liesub;
k=km[zt,al,bt];
ki=km[Conjugate[zt],Conjugate[al],-bt];
sub={Conjugate[zt]->zt^(-1),bt Conjugate[bt]->1-al Conjugate[al]};
k.ki//.sub//MatrixForm

k.z13.ki==al zt^3 z13-Conjugate[bt]zt^3 z23//.sub

k.z31.ki==Conjugate[al] zt^(-3) z31-bt zt^(-3) z32//.sub

k.z23.ki==bt zt^3 z13+Conjugate[al]zt^3 z23//.sub

k.z32.ki==Conjugate[bt] zt^(-3) z31+al  zt^(-3) z32//.sub

Comparison with basis functions

k.z13.ki==Phi[-3,1,-1,-1,{zt,al,bt}] z13+Phi[-3,1,1,-1,{zt,al,bt}] z23//.sub
k.z31.ki==Phi[3,1,1,1,{zt,al,bt}] z31-Phi[3,1,-1,1,{zt,al,bt}] z32//.sub
k.z23.ki==Phi[-3,1,-1,1,{zt,al,bt}]z13+Phi[-3,1,1,1,{zt,al,bt}] z23//.sub
k.z32.ki==-Phi[3,1,1,-1,{zt,al,bt}]z31+Phi[3,1,-1,-1,{zt,al,bt}]z32//.sub

8b. Preliminary routines

We have two bases of the Lie algebra. We use the complex basis Zlist to the general routine R of right differentiation, and the basis XWlist for the routine M of interior differentiation based on the Iwasawa decomposition

Zlist
XWlist

Clear[inlist,FreeLie,nofunction]
Lielist=Union[Zlist,XWlist];
inlist[a_,lst_]:=Module[{in},in=False;Do[If[lst[[j]]==a,in=True;Break[]],{j,1,Length[lst]}];in]
FreeLie[a_]:=Module[{fr},fr=True;Do[If[!FreeQ[a,Lielist[[j]]],fr=False;Break[]],{j,1,Length[Lielist]}];fr]
fctlist={Phi,f,g,bt};
nofunction[f_]:=Module[{fr},fr=True;Do[If[!FreeQ[f,fctlist[[j]]],fr=False;Break[]],{j,1,Length[fctlist]}];fr]

The routine inlist[a,lst] checks whether the symbol a occurs in the list lst.
The routine FeeLie[a] gives true if the expression a does not contain an element in the bases of the Lie algebra.
In the differentiations only the symbols in fctlist are considered as functions with non-zero derivatives. If more functions are used, add them to fctlist.
The routine nofunction[f] gives true if f is not recognized as a function.

Multiplication relations

The routine mult carries out the multiplication of basis functions of k by the factors that occur in the transition from right differentiation to interior differentiation.
The routine uses definitions in section 4c of this notebook.
The substitution rule recognizes products only if all brackets in expressions are expanded. To enlarge the probability of catching all products the routine Expand is used twice.

Clear[mult]
multsub={Phi[eta_,1,eps_,zt_]Phi[h_,p_,r_,q_]:>Phiprod[eta,eps,zt,h,p,r,q]};
mult[xx_]:=Module[{x},x=Expand[xx]/.multsub;Expand[x]/.multsub]
(* See 4d *)

8c. Interior differentiation

The routine M[x, f] carries out the interior differentiation for an expression x applied to an expression f. See (3.19)
x should be a linear combination of basis elements of the Lie algebra. In the first step we express this expression in the basis in XWlist, except for the subalgebra k, for which we use (Subscript[Z, 12]) and (Subscript[Z, 21]).
To the resulting expression x we apply the variant Mm of M. It is defined to be linear in both arguments. In the first argument anything that is not in the Lie algebra is considered to be a scalar. The first argument is applied to the second argument.
In the second argument we handle products with the Leibniz rule, and we define Mm[x,f] to be zero if f is not recognized as a function.

Clear[M,Mm]
M[x_,f_]:=Mm[x//.Liesub0/.{WW1->(1/2)(Z21+Z12),WW2->(1/(2I))(Z21-Z12)}//Expand,f//Expand]
Mm[x_+y_,f_]:=Mm[x,f]+Mm[y,f]
Mm[x_,f_+g_]:=Mm[x,f]+Mm[x,g]
Mm[a_ x_,f_]:=a Mm[x,f]/;FreeLie[a]
Mm[x_, f_ g_]:=Mm[x,f]g+f Mm[x,g]/;inlist[x,Lielist]
Mm[x_,f_]:=0/;nofunction[f]

At this point we have a possibly complicated linear combination of expressions Mm[x,f] where x is a Lie algebra element and f a function.

If x is in the Lie algebra of K and f is a polynomial basis function Phi  on K we can apply the formulas for left differentiation on K, otherwise Mm[x,f] vanishes.

Mm[HHi,f_]:=0/;FreeQ[f,Phi]
Mm[HHi,Phi[h_,p_,r_,q_]]:=(I/2)(h-3r)Phi[h,p,r,q]
Mm[WW0,f_]:=0/;FreeQ[f,Phi]
Mm[WW0,Phi[h_,p_,r_,q_]]:=-I r Phi[h,p,r,q]
Mm[Z21,f_]:=0/;FreeQ[f,Phi]
Mm[Z21,Phi[h_,p_,r_,q_]]:=0/;r+p==0
Mm[Z21,Phi[h_,p_,r_,q_]]:=(r-p-2)Phi[h,p,r-2,q]
Mm[Z12,f_]:=0/;FreeQ[f,Phi]
Mm[Z12,Phi[h_,p_,r_,q_]]:=0/;p==r
Mm[Z12,Phi[h_,p_,r_,q_]]:=(r+p+2)Phi[h,p,r+2,q]

We may also have Mm[x, f] where x is one of the chosen basis elements of n⊕a.
If f is a function on K the result should be zero. Otherwise, we formulate the expression by right differentiation on NA, for which we use the symbol Rna.

Clear[Rna]
Mm[XX_,Phi[h_,p_,r_,q_]]:=0/;XX==XX0||XX==XX1||XX==XX2||XX==HHr
Mm[XX_,f_]:=Rna[XX,f]/;FreeQ[f,Phi]&&(XX==XX0||XX==XX1||XX==XX2||XX==HHr)
(* relations for Rna *)
Rna[x_+y_,f_]:=Rna[x,f]+Rna[y,f]
Rna[n_ x_,f_]:=n Rna[x,f]/;FreeLie[n]
Rna[x_, f_ g_]:= Rna[x,f]g+f Rna[x,g]

8d. Right differentiation

The symbol R denotes right differentiation of functions on G. This is the differentiation that we want to carry out. See (3.18).
Basically, R is defined on the basis elements in Zlist.

Zlist
XWlist

In R[x,f] we first write x in terms of the basis Zlist, and then apply the auxiliary routine Rg.
We define Rg[x,f] to be linear in both arguments. In the first variable we consider everything that is not recognized as belonging to the Lie algebra as a scalar. In the second argument Rg obeys the Leibniz rule.

Clear[R,Rg]
R[x_,f_]:=Rg[Expand[x//.XWtoZsub/.HHi->-(1/2)CKi+(3/2)WW0],Expand[f]]//mult//Simplify
Rg[x_+y_,f_]:=Rg[x,f]+Rg[y,f]
Rg[x_,f_+g_]:=Rg[x,f]+Rg[x,g]
Rg[a_ x_,f_]:=a Rg[x,f]/;FreeLie[a]
Rg[x_,f_ g_]:=Rg[x,f]g+f R[x,g]/;inlist[x,Zlist]
Rg[x_,f_]:=0/;nofunction[f]

This brings the computatation to the stage that we are left with Rg[x, f] with x ∈XWlist and f  a function.
The function f may be a polynomial basis function on K. We have already defined the basis function Phi acting on an explicit element of K. For symbolic manipulations we use the following definition.

Phi[h_,p_,r_,q_]:=0/;(r==p+2)||(q==p+2)||(r==-p-2)||(q==-p-2)

If x is in the Lie algebra of K, we use the known formulas for right differentiation of basis functions.

Rg[CKi,f_]:=0/;FreeQ[f,Phi]
Rg[CKi,Phi[h_,p_,r_,q_]]:=-I h Phi[h,p,r,q]
Rg[WW0,f_]:=0/;FreeQ[f,Phi]
Rg[WW0,Phi[h_,p_,r_,q_]]:=-I q Phi[h,p,r,q]
Rg[Z21,f_]:=0/;FreeQ[f,Phi]
Rg[Z21,Phi[h_,p_,r_,q_]]:=(q-p)Phi[h,p,r,q+2]
Rg[Z12,f_]:=0/;FreeQ[f,Phi]
Rg[Z12,Phi[h_,p_,r_,q_]]:=(q+p)Phi[h,p,r,q-2]

If x is one of the remaining basis elements we express right differentiation in interior differentiation.
In this expression occur polynomial functions on K with p=1 as factors. We have to work out the multiplication relations after the interior differentiation has been carried out.

Rg[Z13,ff_]:=(Phi[-3,1,-1,-1]M[Z13,ff]//mult)+(Phi[-3,1,1,-1]M[Z23,ff]//mult)


Rg[Z31,ff_]:=(Phi[3,1,1,1]M[Z31,ff]//mult)- (Phi[3,1,-1,1]M[Z32,ff]//mult)

Rg[Z23,ff_]:=(Phi[-3,1,-1,1]M[Z13,ff]//mult)+ (Phi[-3,1,1,1]M[Z23,ff]//mult)

Rg[Z32,ff_]:=-(Phi[3,1,1,-1]M[Z31,ff]//mult)+(Phi[3,1,-1,-1]M[Z32,ff]//mult)

8e. Some checks of the differentiation formulas

Differentiation on K

Clear[f,h,p,r,q]
F= f Phi[h,p,r,q]

R[WW0,F]/F
R[WW1,F]
R[WW2,F]
R[CKi,F]/F
Rg[Z12,F]
Rg[Z21,F]

This is in agreement with Table 2.2. Of course, in the definitions those formulas have been used.

Comparison with results of older computations  gives us confidence in the routines.

Examples

Clear[f,h,p,r,q]
F= f Phi[h,p,r,q]

u=R[Z31,F](8(p+1))//Simplify;
u1=Coefficient[u,Phi[h+3,p+1,r+1,q+1]]//Simplify
u2=Coefficient[u,Phi[h+3,p+1,r-1,q+1]]//Simplify
u3=Coefficient[u,Phi[h+3,p-1,r+1,q+1]]//Simplify
u4=Coefficient[u,Phi[h+3,p-1,r-1,q+1]]//Simplify
u==u1 Phi[h+3,p+1,r+1,q+1]+u2 Phi[h+3,p+1,r-1,q+1]+u3 Phi[h+3,p-1,r+1,q+1]+u4 Phi[h+3,p-1,r-1,q+1]//Simplify

u=R[Z13,F](8(p+1))//Simplify;
u1=Coefficient[u,Phi[h-3,p-1,r-1,q-1]]//Simplify
u2=Coefficient[u,Phi[h-3,p+1,r-1,q-1]]//Simplify
u3=Coefficient[u,Phi[h-3,p+1,r+1,q-1]]//Simplify
u4=Coefficient[u,Phi[h-3,p-1,r+1,q-1]]//Simplify
u==u1 Phi[h-3,p-1,r-1,q-1]+u2 Phi[h-3,p+1,r-1,q-1]+u3 Phi[h-3,p+1,r+1,q-1]+u4 Phi[h-3,p-1,r+1,q-1]//Simplify

u=R[Z32,F](8(p+1))//Simplify
u1=Coefficient[u,Phi[h+3,p+1,r+1,q-1]]//Simplify
u2=Coefficient[u,Phi[h+3,p+1,r-1,q-1]]//Simplify
u3=Coefficient[u,Phi[h+3,p-1,r+1,q-1]]//Simplify
u4=Coefficient[u,Phi[h+3,p-1,r-1,q-1]]//Simplify
u==u1 Phi[h+3,p+1,r+1,q-1]+u2 Phi[h+3,p+1,r-1,q-1]+u3 Phi[h+3,p-1,r+1,q-1]+u4 Phi[h+3,p-1,r-1,q-1]//Simplify

u=R[Z23,F](8(p+1))//Simplify;
u1=Coefficient[u,Phi[h-3,p+1,r+1,q+1]]//Simplify
u2=Coefficient[u,Phi[h-3,p+1,r-1,q+1]]//Simplify
u3=Coefficient[u,Phi[h-3,p-1,r+1,q+1]]//Simplify
u4=Coefficient[u,Phi[h-3,p-1,r-1,q+1]]//Simplify
u==u1 Phi[h-3,p+1,r+1,q+1]+u2 Phi[h-3,p+1,r-1,q+1]+u3 Phi[h-3,p-1,r+1,q+1]+u4 Phi[h-3,p-1,r-1,q+1]//Simplify

Enveloping algebra

It is not very practical to repeat the application of right differentiation in this general context. (The computation takes long.)

R[Z23,R[Z31,F]]//Simplify
(* Not carried out for pdf version *)

In Section 11 we will give a routine based on knowledge of the action on n on functions on NA. That routine will be more practical for the action of U(g).

8f. Shift operators

Check of Table 3.6

The routine sh[h,p,ff] gives the shift operators (Subscript[((S^h)), p]) with h∈{3,-3} and p∈{1,-1}, acting on ff ∈(Subscript[(C^∞)(G), K]).

Clear[sh,ident]
ident[x_]:=x;
sh[h_,p_,ff_]:=sh[h,p,ff,ident]
undetsh={Phi [hh_,pp_,rr_,qq_] :>If[Simplify[pp-qq]==0,Phi[hh,pp,rr,qq],0,"(undetermined: "<>ToString[pp==qq]<>")"]};
sh[3,1,ff_,sub_]:=R[Z31,ff]/.undetsh//sub//Simplify
sh[-3,1,ff_,sub_]:=R[Z23,ff]/.undetsh//sub//Simplify
sh[3,-1,ff_,sub_]:=R[Z32,ff]/.undetsh//sub//Simplify
sh[-3,-1,ff_,sub_]:=R[Z13,ff]/.undetsh//sub//Simplify

The routine is based on the action of the Lie algebra, restricted to highest weight spaces. We just eliminate terms in the result that are not in a highest weight space, with the subsitutiton undetsh.
Applied to vectors that are not in a highest weight space an error message is given.
In the general version we can add an argument sub, which handles more information on the Lie algebra action Rna.

Shift operators

Now we can describe the general action of the shift operators in Table 3.6.

Clear[b,h,p,r]
F= b Phi[h,p,r,p]
fctlist=Union[fctlist,{b}]

8(p+1)sh[3,1,F]

8(p+1)sh[-3,1,F]

4(p+1)sh[3,-1,F]//Simplify

4(p+1)sh[-3,-1,F]//Simplify

9 Large abelian Fourier term modules

In the large Fourier term modules, defined in 3.1, we have a description of the functions of the form
g = na(t)k  ↦ ψ(n) g(t) Φ(k)
The function ψ on N is either a character, or a theta function. The function g is an arbitrary (C^(∞ ))function on (0,∞).
For ψ we have additional information, that we can use to work out further the action (Subscript[R, NA])on NA .
Here we consider the abelian case, in which  ψ=(Subscript[χ, β]) is a character of N.

9a. Substitution rule

See (3.27)

The routine btsub applies the subsitution rules for the abelian case. The character has to have the name chbt.

Clear[chbt,beta,betac,btr,bti,subab]
fctlist=Union[fctlist,{chbt}];
chbt[ns[x_,y_,r_]]=E^(2Pi I (btr x+bti y));
subab[xx_]:=Module[{x},x=xx//.subab0//.btsub//Expand;x=x//.subab0//.btsub//Simplify]
subab0:={Rna[XX0,ff_]->0,Rna[XX1,chbt]->t  2Pi I btr chbt,Rna[XX2,chbt]->t 2 Pi I bti chbt,Rna[XX1,ff_/;FreeQ[ff,chbt]]->0,Rna[XX2,ff_/;FreeQ[ff,chbt]]->0,Rna[HHr,ff_]:>t D[ff,t]};
btsub={btr->(beta+betac)/2,bti->(beta-betac)/(2I),beta betac ->Abs[beta]^2};

A check of differentiation formula

Clear[x,y,r]
ch=chbt[ns[x,y,r]]
D[ch,x]/ch
D[ch,y]/ch

Differentiation
For leater use it is convenient to give the function f a parameter additional argument r, indicating one of the parameters of the polynomial function on K with which it occurs.

Clear[f,h,p,r,q,t]
F=chbt f[r,t]Phi[h,p,r,q]

R[Z31,F]//subab//FullSimplify

R[Z13,F]//subab//FullSimplify

R[Z32,F]//subab//FullSimplify

R[Z23,F]//subab//FullSimplify

9b. Shift operators

Now we can give the description in Table 3.7 of the action of the shift operators in large abelian Fourier term modules.

The routine subab used as fourth argument in the routine sh for the shift operators gives the right action on NA in the abelian case.

For each of the four shift operators a check is carried out, by comparison with the formula in the table.

Clear[f,h,p,r,t]
F=chbt f[t]Phi[h,p,r,p]

sh[3,1,F,subab]
8(p+1)%==chbt( (2+p+r)(2 t f'[t]+(h+2p-r)f[t])Phi[h+3,p+1,r+1,p+1]- 4 Pi  I(2+p-r)betac t f[t]Phi[h+3,p+1,r-1,p+1])//Simplify

sh[-3,1,F,subab]
8(p+1)%==chbt( 4Pi I beta (2+p+r) t f[t] Phi[h-3,p+1,r+1,p+1]+(2+p-r)(2 t f'[t]+(2p+r-h)f[t]) Phi[h-3,p+1,r-1,p+1])//Simplify

sh[3,-1,F,subab]
4(p+1)% chbt^(-1) ==  p(2t f'[t]+(-4+h-2p-r)f[t])Phi[h+3,p-1,r+1,p-1]+ 4Pi I p betac t f[t] Phi[h+3,p-1,r-1,p-1]//Simplify

sh[-3,-1,F,subab]
4(p+1)% chbt^(-1)==-4Pi I p beta t f[t]Phi[h-3,p-1,r+1,p-1]+ p(2 t f'[t]-(4+h+2p-r)f[t])Phi[h-3,p-1,r-1,p-1]//Simplify

9c. Kernel relations

Table 3.8

Check of the kernel relations

Clear[F,f,h,p,r,sum]
F=chbt (f[r,t]Phi[h,p,r,p]+f[r+2,t]Phi[h,p,r+2,p]);

The term with  Phi[3+h,1+p,1+r,1+p] has to be combined with the term
the term with Phi[3+h,1+p,-1+r,1+p] in which r is replaced by r+2.
Furthermore, the extremal values  r give additional terms that should be zero.

u=8(p+1)sh[3,1,F,subab]//Simplify
up=Coefficient[u, Phi[3+h,1+p,1+r,1+p]];
um=Coefficient[u, Phi[3+h,1+p,-1+r,1+p]];
up/.r->p//Simplify(* in the maximal weight one term *)
umid=(um/.r->r+2)+up//Simplify
um/.r->-p//Simplify (* in the minimal weight one term *)

Coefficient[umid,f[r,t]]
Coefficient[umid,Derivative[0,1][f][r,t]]
Coefficient[umid,f[r+2,t]]

u=8(p+1)sh[-3,1,F,subab]//Simplify
up=Coefficient[u, Phi[-3+h,1+p,1+r,1+p]];
um=Coefficient[u, Phi[-3+h,1+p,-1+r,1+p]];
up/.r->p//Simplify
umid=(um/.r->r+2)+up//Simplify
um/.r->-p//Simplify

Coefficient[umid,f[r,t]]/2
Coefficient[umid,Derivative[0,1][f][r+2,t]]/2
Coefficient[umid,f[r+2,t]]/2//Factor

For the downward shift operators the extremal values of r do not give an additional condition.

u=8(p+1)sh[3,-1,F,subab]//Simplify
up=Coefficient[u, Phi[3+h,-1+p,1+r,-1+p]];
um=Coefficient[u, Phi[3+h,-1+p,-1+r,-1+p]];
umid=(um/.r->r+2)+up//Simplify

Coefficient[umid,f[r,t]]/2
Coefficient[umid,Derivative[0,1][f][r,t]]/2
Coefficient[umid,f[r+2,t]]/2

u=8(p+1)sh[-3,-1,F,subab]//Simplify
up=Coefficient[u, Phi[-3+h,-1+p,1+r,-1+p]];
um=Coefficient[u, Phi[-3+h,-1+p,-1+r,-1+p]];
umid=(um/.r->r+2)+up//Simplify

Coefficient[umid,f[r,t]]/4
Coefficient[umid,Derivative[0,1][f][r+2,t]]/4
Coefficient[umid,f[r+2,t]]/4

10 Large non-abelian Fourier term modules

Now we consider functions of the form
g = na(t)k  ↦ ψ(n) g(t) Φ(k)
where ψ is a theta function based on a  normalized Hermite function

10a. Substitution rules

See §3.3.2

The substitution rules work with tht[m] as function on N. It is (Subscript[ϑ, m])= (Subscript[Θ, ℓ,c])((Subscript[h, ℓ,m]))  in the text. 
The sign off ell is denoted by eps.
dtt[eps] ((Subscript[δ, ±ε ]) in the text) is equal to 1 if eps=1 and equal to 0 if eps=-1

Clear[subnab,tht,t,eps,dtt]
(*eps denotes the sign of ell *)fctlist=Union[fctlist,{t,tht}];
dtt[e_]:=(1+e)/2
subnab[xx_]:=Module[{x},x=xx/.subnab0//Expand;(x/.subnab1//Simplify)/.subnab2//Simplify]
subnab0={Rna[HHr,ff_]:> t D[ff,t],
Rna[XX0,tht[m_]]->t^2 Pi I ell tht[m],
Rna[XX1,tht[m_]]:>-I eps t Sqrt[2 Pi Abs[ell]](Sqrt[m]tht[m-1]+Sqrt[m+1]tht[m+1]),
Rna[XX2,tht[m_]]:> t Sqrt[2 Pi Abs[ell]](Sqrt[m]tht[m-1]-Sqrt[m+1]tht[m+1]),Rna[XX0,ff_/;FreeQ[ff,tht]]:>0,Rna[XX1,ff_/;FreeQ[ff,tht]]:>0,Rna[XX2,ff_/;FreeQ[ff,tht]]:>0,Rna[HHr,ff_/;FreeQ[ff,t]]:>0};
subnab1={tht[-1]->0,eps^2->1};
subnab2={};(* to be chosen later *)

The relations for the basis elements on n are taken from Table 2.4. We check the relations mentioned in §3.3.2:

Rna[eps XX1+I XX2,tht[m]]//subnab
Rna[eps XX1-I XX2,tht[m]]//subnab

Clear[F,h,p,r,q]
F=tht[m]f[t]Phi[h,p,r,q]

r31=R[Z31,F]//subnab

r23=R[Z23,F]//subnab

r13=R[Z13,F]//subnab

r32=R[Z32,F]//subnab

The dependence on eps can be written in a shorter way.

subnab2:={(1+eps) (Sqrt[m]) tht[-1+m]+(-1+eps) (Sqrt[1+m]) tht[1+m]->2eps Sqrt[m+dtt[-eps]]tht[m-eps],
(-1+eps) (Sqrt[m]) tht[-1+m]+(1+eps) (Sqrt[1+m]) tht[1+m]->2 eps Sqrt[m+dtt[eps]]tht[m+eps]};

This changes the  behavior of subnab

For the checks in of the differentiation, and of the shift operators in Table 3.9 we want to work with dtt as a formal quantity. Hence here and in the next subsection dtt has to be cleared. After reinitialization the original meaning is restored.

Clear[dtt]

(R[Z31,F]//subnab)==r31//Simplify
%//.subnab2//FullSimplify

(R[Z23,F]//subnab)==r23//Simplify
%//.subnab2

(R[Z13,F]//subnab)==r13//Simplify
%//.subnab2
(R[Z32,F]//subnab)==r32//Simplify
%//.subnab2

In this way we can handle both cases of the sign of ell in the same formula.

10b. Shift operators in the non-abelian case

Table 3.9
We temporarily clear the function dtt.
Should be restored afterwards by evaluating the initialization cells.

Clear[dtt]

Clear[F,h,p,r]
F=tht[m]f[r,t]Phi[h,p,r,p]

s31=8(p+1)sh[3,1,F,subnab];
Coefficient[s31,Phi[h+3,p+1,r+1,p+1]]//Simplify
Coefficient[s31,Phi[h+3,p+1,r-1,p+1]]//Simplify

sm31=8(p+1)sh[-3,1,F,subnab];
Coefficient[sm31,Phi[h-3,p+1,r+1,p+1]]//Simplify
Coefficient[sm31,Phi[h-3,p+1,r-1,p+1]]//Simplify

s3m1=4p^(-1)(p+1)sh[3,-1,F,subnab];
Coefficient[s3m1,Phi[h+3,p-1,r+1,p-1]]//Simplify
Coefficient[s3m1,Phi[h+3,p-1,r-1,p-1]]//Simplify

sm3m1=4p^(-1)(p+1)sh[-3,-1,F,subnab];
Coefficient[sm3m1,Phi[h-3,p-1,r+1,p-1]]//Simplify
Coefficient[sm3m1,Phi[h-3,p-1,r-1,p-1]]//Simplify

10c. Preservation of the metaplectic quantity d

§3.3.2

The routine muval determines the value of d as it occurs in the various terms of an expression, in accordance with (3.31).  (We changed the parameter μ to d in the present version of the book, but kept here the old name.)

Clear[muval,mu]
muval[f_+g_]:={muval[f],muval[g]}
muval[f_ g_]:=muval[f]+muval[g]//Expand
muval[f_]:=0/;FreeQ[f,Phi]&&FreeQ[f,tht]
muval[Phi[h_,p_,r_,q_]]:=h-3r
muval[tht[m_]]:=(6m+3)eps

With use of the computations of 10b:

(s31//muval)/.h->mu-(6 m+3)eps+3r//.{eps^2->1}//Expand

(sm31//muval)/.h->mu-(6 m+3)eps+3r//.{eps^2->1}//Simplify

(s3m1//muval)/.h->mu-(6 m+3)eps+3r//.{eps^2->1}//Simplify

(sm3m1//muval)/.h->mu-(6 m+3)eps+3r//.{eps^2->1}//Simplify

11 Eigenfunctions of the center of the enveloping algebra

In Fourier terms modules, defined in §3.3, the center of the enveloping algebra of g acts by a character of ZU(g).
This character can be parametrized by a character of NA,  which leads to a parametrization by elements of Z × C.
The Weyl group of (Subscript[sl, 3]) acts on C × C. The parametrization is invariant under the Weyl group.

11a. Routine for products in the enveloping algebra

The routine R can evaluate differentiation by higher degree elements of U(g), but this runs slowly. Moreover if Rna(HHr) is substituted as differentiation unexpected results follow. It is better to make a modified routine eR that at each step uses simplifying substitution rules instead only applying the substitution at the end.

Clear[eR,eR0]
eR[aa_,ff_,sub_]:=eR0[Expand[aa//.XWtoZsub/.HHi->-(1/2)CKi+(3/2)WW0],Expand[ff],sub]//Simplify
eR0[aa_+bb_,ff_,sub_]:=eR0[aa,ff,sub]+eR0[bb,ff,sub]
eR0[pp_ aa_,ff_,sub_]:=pp eR0[aa,ff,sub]/;FreeLie[pp]
eR0[nul,ff_,sub_]:=0
eR0[nul aa_,ff_,sub_]:=0
eR0[xx_,ff_,sub_]:=(R[xx,ff]//sub//mult)/;inlist[xx,Zlist]
eR0[aa_**bb_,ff_,sub_]:=Module[{x},x=R[bb,ff]//sub//mult;eR0[aa,x,sub]//mult]/;FreeQ[bb,NonCommutativeMultiply]

The following routine is useful for a sum over r in which various terms with Φ[h,p,r’,q] occur.
The routine compr carries out the substitution r->2r-r’ in each term with Φ[h,p,r’,q].

Clear[compr,cpro,cpr,h,p,r]
cpro[a_+b_]:=cpro[a]+cpro[b]
cpr[y_ Phi[hh_,pp_,rr_,qq_]]:=(y/.r->2r-rr)Phi[hh,pp,r,qq];
compr[xx_]:=Module[{x},x=cpro[Expand[xx]];
x=x/.cpro[y_]:>cpr[y];x//Simplify]

Checks

Check by comparison with R

Clear[chbt,f,h,p,r]
F=chbt f[t]Phi[h,p,r,p]
Do[Print[Zlist[[j]],"  ",eR[Zlist[[j]],F,subab]==R[Zlist[[j]],F]//subab//Simplify],{j,1,8}]

Clear[tht,f,h,p,r,m,eqn]
F=tht[m] f[t]Phi[h,p,r,p]
Do[eqn=eR[Zlist[[j]],F,subnab]==R[Zlist[[j]],F]//subnab//Simplify;Print[Zlist[[j]],"  eps=",epps,"  ",eqn/.eps->epps//Simplify],{j,1,8},{epps,1,-1,-2}]

Comparison with description of downward shift operators

Clear[chbt,f,h,p,r]
F=chbt f[t]Phi[h,p,r,p]
sh[3,-1,F,subab]
%==eR[Z32+(2(p+1))^(-1)Z12**Z31,F,subab]//Simplify

sh[-3,-1,F,subab]
%==eR[Z13-(2(p+1))^(-1)Z12**Z23,F,subab]//Simplify

Clear[tht,f,h,p,r,m]
F=tht[m] f[t]Phi[h,p,r,p]
sh[3,-1,F,subnab]
%==eR[Z32+(2(p+1))^(-1)Z12**Z31,F,subnab]//Simplify

sh[-3,-1,F,subnab]
%==eR[Z13-(2(p+1))^(-1)Z12**Z23,F,subnab]//Simplify

Casimir operator of K

Clear[h,p,r,q]
F=Phi[h,p,r,q]
eR[WW0**WW0-2I WW0+Z12**Z21,F,ident]/F//Simplify

11b. Substitution rule for the N-trivial case

Preparation for Lemma 3.19.

The following substitution routine subtriv is more efficient than the use of subab followed by putting β equal to zero,

Clear[subtriv]
subtriv[xx_]:=Module[{x},x=xx//.subtriv0//Expand;x=x//.subtriv0//.btsub//Simplify]
subtriv0:={Rna[XX0,ff_]->0,Rna[XX1,ff_]->0,Rna[XX2,ff_]->0,Rna[HHr,ff_]:>t D[ff,t]};

Clear[h,p,r,q]
F=f[t]Phi[h,p,r,p]
R[Z31,F]//subtriv
R[Z32,F]//subtriv

sh[3,1,F,subtriv]
%==sh[3,1,F,subab]
sh[-3,1,F,subtriv]
%==sh[-3,1,F,subab]
sh[3,-1,F,subtriv]
%==sh[3,-1,F,subab]
sh[-3,-1,F,subtriv]
%==sh[-3,-1,F,subab]

Definition of eigenvalues functions on the  center of the enveloping algebra

Clear[ld2,ld3]
ld2[{j_,nu_}]=ld2[j_,nu_]=(nu^2-4+j^2/3)
ld3[{j_,nu_}]=ld3[j_,nu_]=(j+3)(nu^2-(j-6)^2/9)

11c. Example

See (3.53)

Clear[j,nu]
ph=t^(2+nu)Phi[2j,0,0,0]

ph1=sh[3,1,ph,subab]

sh[-3,-1,ph1,subab]

th=(1/8)  ((nu^2)-(((2+j))^2))

eR[CasZ,ph,subtriv]/ph//Simplify

eR[Dt3Z,ph,subtriv]/ph//Simplify

Here we used the routine eR  defined in 11b.
We may also use that φ is a minimal vector, and apply Lemma 3.4.

sh[3,1,ph,subab]
sh[-3,-1,%,subab]
f1=%/ph

Now use iii) and iv) in Lemma 3.4.

m2=(h^2/3+p^2+2h+2p)+4(p+2)/(p+1)f1/.{h->2j,p->0}//Simplify
m2==ld2[j,nu]

m3=(1/9)h(h+3p+12)(h-3p+6)+2(p+2)(h-3p+6)(p+1)^(-1)f1/.{h->2j,p->0}//Simplify
m3==ld3[j,nu]//Simplify

11d. Parametrization

See §3.4, Proposition 3.17

Clear[S1,S2]
S1[{j_,nu_}]:=(1/2){3nu-j,j+nu}//Simplify
S2[{j_,nu_}]:=(1/2){-3nu-j,nu-j}//Simplify

Invariance

Clear[j,nu]
ld2[S1[{j,nu}]]==ld2[j,nu]//Simplify
ld2[S2[{j,nu}]]==ld2[j,nu]//Simplify
ld3[S1[{j,nu}]]==ld3[j,nu]//Simplify
ld3[S2[{j,nu}]]==ld3[j,nu]//Simplify

Eigenvalue computation

Clear[j,nu,h,p,th]
th=(1/8)  ((nu^2)-(((2+j))^2))
eqn={ld2[j,nu]==(h^2/3+p^2+2h+2p)+4(p+2)(p+1)^(-1)th,ld3[j,nu]==(h-3p+6)((h/9)(h+3p+12)+2(p+2)(p+1)^(-1)th)}
Solve[eqn,{j,nu}]//Simplify
Dimensions[%]

Mathematica does not find more than 6 solutions.

Freedom in the parametrization

Clear[nu,nu1,j,j1]
{ld2[j,nu]==ld2[j1,nu1],ld3[j,nu]==ld3[j1,nu1]}
Solve[%,{j1,nu1}]

The Weyl group permutes these solutions

11e. Eigenfunction equations, N-trivial eigenfunction module

Lemma 3.19 in §3.4

Clear[sum,p,r,h,f,j,nu]
F=sum[r]f[r,t]Phi[h,p,r,p]

It turns out that in the N-trivial case the components stay uncoupled.
The computation of the Casimir element takes some time.

eR[CasZ,F,subtriv]-ld2[j,nu]F//FullSimplify
ft2=%/(Phi[h,p,r,p]sum[r])//Simplify
Coefficient[ft2, f[r,t]]//Factor
Coefficient[ ft2,Derivative[0,1][f][r,t]]//Factor
Coefficient[ ft2,Derivative[0,2][f][r,t]]//Factor

This is the first equation in (3.59)
Weyl-invariance:

(ft2/.{j,nu}->S1[{j,nu}]) ==ft2//Simplify
(ft2/.{j,nu}->S2[{j,nu}]) ==ft2//Simplify

The generator in degree 3

eR[Dt3Z,F,subtriv]-ld3[j,nu]F//FullSimplify
ft3=%/(Phi[h,p,r,p]sum[r])//Simplify

It turns out that a simplification can be reached by taking a linear combination with the eigenfunction equation for the Casimir element.

v=ft3-(1/2)(h-3r+6) ft2//Simplify

Factor[v]

prod=(h-3 r-2 j) (h-3 nu-3 r+j) (h+3 nu-3 r+j) 
prod/.{w,nu}->S1[{w,nu}] 
prod/.{w,nu}->S2[{w,nu}]

Comparison with the routine in Section 11h.

Clear[h,p,r,f]
efeqt[h,p,r,f]=={ft2,-18v}//Simplify

11f. Eigenfunction equations,  abelian eigenfunction module

In Lemma 3.20 we use a non-trivial character of N

Clear[p,r,h,g,j,nu]
F=chbt g[r,t]Phi[h,p,r,p]
(* the sum over r is not explicitly given *)

The following computation takes  time

eieq={eR[CasZ,F,subab]-ld2[j,nu]F,eR[Dt3Z,F,subab]-ld3[j,nu]F}//Simplify

In the various terms we carry out a substitution of the implicit summation variable r to get the same eigenfunction Phi[h,p,r,p] in all terms.
Then we consider the term for one value of r, and divide out the common factors.

eieq[[1]]//compr
ei2=%(chbt Phi[h,p,r,p])^(-1)//Simplify

eieq[[2]]//compr
ei3=%(chbt Phi[h,p,r,p])^(-1)//Simplify

Coefficient[{ei2,ei3},Derivative[0,2][g][r,t]]

(216 (t^2)+36 h (t^2)-108 r (t^2))/72//Expand

A simplification is possible replacing the contribution of (Subscript[Δ, 3]) by a linear combination of both contributions.

2ei3-(6+h-3r)ei2//FullSimplify
ei3a=%/.beta Conjugate[beta]->Abs[beta]^2//Simplify

Coefficient[-9ei3a,g[r,t]]
Coefficient[-9ei3a,g[r+2,t]]//Simplify
Coefficient[-9ei3a,Derivative[0,1][g][r+2,t]]//Simplify
Coefficient[-9ei3a,g[r-2,t]]//Simplify
Coefficient[-9ei3a,Derivative[0,1][g][r-2,t]]//Simplify

The factor - 9 gives agreement with efeqt (N-trivial case) for beta=0.

{ei2,-9 ei3a}/.beta->0/.betac->0
%== efeqt[h,p,r,g]//Simplify

Check of routine in 11h.

efeqa[h,p,r,g,beta]=={ei2,-9 ei3a}/.betac->Conjugate[beta]//Simplify

11g. Eigenfunction equations,  non-abelian eigenfunction module

Clear[f,tht, ell,eps,dtt,m,j,nu]
F=tht[m[r]]f[r,t]Phi[h,p,r,p]

The sign off ell is denoted by eps. We use ddt like in 10a.

Computation of eigenfunction equations. This takes very long; that is why we put the result in a routine, in 11h.

efeq={eR[CasZ,F,subnab]-ld2[j,nu]F,eR[Dt3Z,F,subnab]-ld3[j,nu]F}//Simplify

Separate treatment for different values of Sign[ell]

efeqp=efeq/.eps->1//Simplify;
efeqm=efeq/.eps->-1//Simplify;

Bringing all terms with the same value of r together

efqp=({efeqp[[1]]//compr,efeqp[[2]]//compr})/(tht[m[r]]Phi[h,p,r,p])/.{m[r+2]->m[r]+1,m[r-2]->m[r]-1}//Simplify
efqm=({efeqm[[1]]//compr,efeqm[[2]]//compr})/(tht[m[r]]Phi[h,p,r,p])/.{m[r+2]->m[r]-1,m[r-2]->m[r]+1}//Simplify

Simplification of the second component.

Coefficient[efqp,Derivative[0,2][f][r,t]]//Simplify
Coefficient[efqm,Derivative[0,2][f][r,t]]//Simplify

eiap=2 efqp[[2]]-(6+h-3 r) efqp[[1]]//Simplify;
eiam=2 efqm[[2]]-(6+h-3 r) efqm[[1]]//Simplify;

eqp={efqp[[1]],eiap}
eqm={efqm[[1]],eiam}

Comparison with routine efeqn  in 12f. (That routine was taken from a previous version; so this is a check of the result.)

Clear[h,p,r,f,ell]
efeqn[h,p,r,f,ell,m[r],1]== eqp//Simplify
efeqn[h,p,r,f,ell,m[r],-1]==  eqm//Simplify

11h. Routines for eigenfunction equations

The computation of the action of the generators of the enveloping algebra takes long. 
The results of these computations will be used later on; it is worthwhile to define routines with these results.

The routines do not provide equalities, but a pair of quantities that both  have to be zero for all relevant values of the variable r.
The routines depend implicitly on the choice of spectral parameters (j,ν).

N - trivial case

Clear[efeqt,h,nu ,j]
efeqt[h_,p_,r_,f_]={(1/12) ((((h-3 r))^2)-4 (-12+3 (nu^2)+(j^2))) f[r,t]+t (-3 Derivative[0,1][f][r,t]+t Derivative[0,2][f][r,t]),(h-3 r-2 j) (h-3 nu-3 r+j) (h+3 nu-3 r+j)f[r,t]};

Abelian case

Clear[efeqa,h,nu ,j]
efeqa[h_,p_,r_,g_,bt_]={-2 I beta π (p+r) t g[-2+r,t]+(1/12) (48+(h^2)-12 (nu^2)-6 h r+9 (r^2)-4 (j^2)-48 (π^2) (t^2) ((Abs[beta])^2)) g[r,t]+t (2 I Conjugate[beta] π (p-r) g[2+r,t]-3 Derivative[0,1][g][r,t]+t Derivative[0,2][g][r,t]),-9 (3 I beta π (-2+h-3 r) (p+r) t g[-2+r,t]-(1/9) ((h-3 r-2 j) (h+3 nu-3 r+j) (h-3 (nu+r)+j)+216 (π^2) r (t^2) ((Abs[beta])^2)) g[r,t]+3 I π t (Conjugate[beta] (2+h-3 r) (-p+r) g[2+r,t]+2 t (beta (p+r) Derivative[0,1][g][-2+r,t]+Conjugate[beta] (p-r) Derivative[0,1][g][2+r,t])))};

Non-abelian case

We use the routine
efeqn[h_,p_,r_,f_,ell_,mr_,eps_] 
explanation of the parameters:
h and p determine the K-type;
 r  order of the component under consideration;
 ell determines the character of the center of N;
 mr order of theta-function;
 eps=Sign[ell]

Clear[efeqn,nu ,j]
efeqn[h_,p_,r_,f_,ell_,mr_,1]={(1/12) ((48+(h^2)-12 (nu^2)+9 (r^2)-48 ell π (t^2)-24 ell π r (t^2)-48 (ell^2) (π^2) (t^4)-6 h (r+4 ell π (t^2))-4 (j^2)-96 mr π (t^2) Abs[ell]) f[r,t]+12 t (2 I (Sqrt[2 π]) (Sqrt[Abs[ell]]) ((Sqrt[mr]) (p+r) f[-2+r,t]+(Sqrt[1+mr]) (-p+r) f[2+r,t])-3 Derivative[0,1][f][r,t]+t Derivative[0,2][f][r,t])),-(1/9) ((h^3)-9 (h^2) r+27 (nu^2) r-27 (r^3)-216 ell p π (t^2)-108 ell (p^2) π (t^2)+216 ell π r (t^2)+108 ell π (r^2) (t^2)+18 (nu^2) j+9 r (j^2)-2 (j^3)-3 h (3 (nu^2)-9 (r^2)+(j^2))+432 mr π r (t^2) Abs[ell]) f[r,t]-3 I (Sqrt[2 π]) t (Sqrt[Abs[ell]]) ((Sqrt[mr]) (p+r) (-2+h-3 r+4 ell π (t^2)) f[-2+r,t]-(Sqrt[1+mr]) (p-r) (2+h-3 r+4 ell π (t^2)) f[2+r,t]+2 t ((Sqrt[mr]) (p+r) Derivative[0,1][f][-2+r,t]+(Sqrt[1+mr]) (p-r) Derivative[0,1][f][2+r,t]))};
efeqn[h_,p_,r_,f_,ell_,mr_,-1]={(1/12) ((48+(h^2)-12 (nu^2)+9 (r^2)-48 ell π (t^2)-24 ell π r (t^2)-48 (ell^2) (π^2) (t^4)-6 h (r+4 ell π (t^2))-4 (j^2)-96 (1+mr) π (t^2) Abs[ell]) f[r,t]+12 t (2 I (Sqrt[2 π]) (Sqrt[Abs[ell]]) (-(Sqrt[1+mr]) (p+r) f[-2+r,t]+(Sqrt[mr]) (p-r) f[2+r,t])-3 Derivative[0,1][f][r,t]+t Derivative[0,2][f][r,t])),-(1/9) ((h^3)-9 (h^2) r+27 (nu^2) r-27 (r^3)-216 ell p π (t^2)-108 ell (p^2) π (t^2)+216 ell π r (t^2)+108 ell π (r^2) (t^2)+18 (nu^2) j+9 r (j^2)-2 (j^3)-3 h (3 (nu^2)-9 (r^2)+(j^2))+432 (1+mr) π r (t^2) Abs[ell]) f[r,t]-3 I (Sqrt[2 π]) t (Sqrt[Abs[ell]]) ((Sqrt[1+mr]) (p+r) (2-h+3 r-4 ell π (t^2)) f[-2+r,t]+(Sqrt[mr]) (p-r) (2+h-3 r+4 ell π (t^2)) f[2+r,t]-2 t ((Sqrt[1+mr]) (p+r) Derivative[0,1][f][-2+r,t]+(Sqrt[mr]) (p-r) Derivative[0,1][f][2+r,t]))};

12 One-dimensional K-types

In §3.4.2 we consider the eigenfunction equations  in the one-dimensional K-types. In this case the equations concern only one component. Solutions can be expressed in known special functions

12a. N-trivial eigenfunction modules

See §3.4.2.1

Use of routine for eigenfunction equations

Clear[f,nu,j]
{deq,rel}=efeqt[h,0,0,f]

Both coordinates should be zero. The second coordinate  shows that we can choose h=2j

deq1=deq/.h->2j//Simplify

Check solutions

Clear[c1,c2]
ff=c1 t^(2+nu)+ c2 t^(2-nu)
deq1/.{f[0,t]->ff,Derivative[0,ee_][f][0,t]:>D[ff,{t,ee}]}//Simplify

ff=t^2 (c1+c2 Log[t])
deq1/.nu->0/.{f[0,t]->ff,Derivative[0,ee_][f][0,t]:>D[ff,{t,ee}]}//Simplify

12b. Generic abelian eigenfunction modules

See §3.4.2.2

Eigenfunction equation

Clear[f,nu,j,bt]
{deq,rel}=efeqa[h,0,0,f,bt]/.p->0//Simplify

We can choose h = 2 j to satisfy the second component.

Expected form of solutions in ff.

Clear[bf,tau]
ff=t^2 bf[2Pi Abs[beta] t]
deq/.h->2j/.f[0,t]->ff/.Derivative[0,ee_][f][0,t]:>D[ff,{t,ee}]//Simplify
%/.t->tau/(2Pi Abs[beta])//Simplify

This is the modified Bessel differential equation.

12c. Non-abelian eigenfunction modules

See §3.4.2.3

Eigenfunction equation, separately for ε=1 and -1

Clear[f,nu,j,ell,m,h]
{deqp,relp}=efeqn[h,0,0,f,ell,m,1]/.p->0//Simplify
{deqm,relm}=efeqn[h,0,0,f,ell,m,-1]/.p->0//Simplify

relp//Factor
relm//Factor

In both cases we can choose h=2j

{dqp,dqm}={deqp,deqm}/.h->2j/.ell^2->Abs[ell]^2//Simplify

Parameters

Clear[kap]
dqp1=dqp/.m->-kap- (  j+1)/2/.{8 ell->8 Abs[ell],16 ell->16 Abs[ell]}//Simplify
dqm1=dqm/.m->-kap- ( - j+1)/2/.{8 ell->-8 Abs[ell],16ell->-16 Abs[ell]}//Simplify

Expected form of solutions

Clear[wh,tau]
ff=t wh[2Pi Abs[ell]t^2];
{dqp2,dqm2}={dqp1,dqm1}/.{f[0,t]->ff,Derivative[0,ee_][f][0,t]:>D[ff,{t,ee}]}/.t->Sqrt[tau]/Sqrt[2Pi Abs[ell]]//Simplify

Solve[dqp2==0,wh''[tau]][[1]]
ftp=wh''[tau]/wh[tau]/.%/.Abs[ell]->ell//Simplify
Solve[dqm2==0,wh''[tau]][[1]]
ftm=wh''[tau]/wh[tau]/.%/.Abs[ell]->-ell//Simplify

Clear[X]
ft={ftp,ftm}/.tau->1/X//Simplify;
c0=ft/.X->0
c1=Coefficient[ft,X]//Simplify
c2=Coefficient[ft,X^2]//Simplify

This confirms that we have the Whittaker differential equation with the parameters indicated in the text.

13 Kernel of downward shift operators

Proposition 3.21 gives a necessary condition for (Subscript[((S^3)), -1]), respectively (Subscript[((S^(-3))), -1]), to have a non-trivial kernel. For each of the three cases we carry out  computations supporting the proof.

13a. N-trivial Fourier term modules

Clear[f,r,p]
F=f[r,t]Phi[h,p,r,p]

Eigenfunction equation

efeq=efeqt[h,p,r,f]//Simplify

First downward shift operator

We solve the relation for a non-trivial kernel

sh[3,-1,F,subtriv]//Simplify
fra=Derivative[0,1][f][r,t]/.Solve[%==0,Derivative[0,1][f][r,t]][[1]]//Simplify

Substitute in eigenfunction equation

efeq/.Derivative[0,2][f][r,t]->D[fra,t]/.Derivative[0,1][f][r,t]->fra//Simplify
%/.r->(h-2j)/3//Simplify
%//Factor

Second downward shift operator

sh[-3,-1,F,subtriv]//Simplify
fra=Derivative[0,1][f][r,t]/.Solve[%==0,Derivative[0,1][f][r,t]][[1]]//Simplify

efeq/.Derivative[0,2][f][r,t]->D[fra,t]/.Derivative[0,1][f][r,t]->fra//Simplify
%/.r->(h-2j)/3//Simplify//Factor

13b. Generic abelian Fourier term modules

First downward shift operator

Clear[f,r,t,h,p,r,ff,rr,sol3m1,solm3m1]
F= chbt f[r,t]Phi[h,p,r,p]

sh[3,-1,F,subab]//compr
sol3m1[rr_]=Solve[%==0,f[r+1,t]][[1]]/.r->rr-1//Simplify
ff[rr_]=f[rr,t]/.%

eimp=efeqa[h,p,-p,f,beta]/.{f[2-p,t]->ff[2-p],Derivative[0,ee_][f][2-p,t]:>D[ff[2-p],{t,ee}]}/.betac->Conjugate[beta]//Simplify

Try to simplify

Coefficient[eimp,Derivative[0,2][f][-p,t]]

eimpb=eimp[[2]]-54p eimp[[1]]//Factor

Three possible relations

Second downward shift operator

In the same way

Clear[f,r,t,h,p,r,ff,rr]
F= chbt f[r,t]Phi[h,p,r,p]

sh[-3,-1,F,subab]//compr
solm3m1[rr_]=Solve[%==0,f[r-1,t]][[1]]/.r->rr+1//Simplify
ff[rr_]=f[rr,t]/.%

eip=efeqa[h,p,p,f,beta]/.{f[p-2,t]->ff[p-2],Derivative[0,ee_][f][p-2,t]:>D[ff[p-2],{t,ee}]}/.betac->Conjugate[beta]//Simplify

Coefficient[eip,Derivative[0,2][f][p,t]]

eip[[2]]+54 p eip[[1]]//Factor

13c. Non-abelian case

First downward shift operator

Get the kernel relations

Clear[sum,f,r,m,p,h]
F=tht[m[h,r]]f[r,t]Phi[h,p,r,p]
s3m1=sh[3,-1,F,subnab]

Separate values 1 and -1 of  eps=Sign[ell]
Shift the summation variable r such that Phi[hh,pp,r,pp] occurs

Clear[relp]
s3m1/.eps->1//compr
relp[r_]=Solve[%==0,f[r+1,t]][[1]]/.r->r-1/.m[h,r-2]->m[h,r]-1//Simplify

Clear[relm]
s3m1/.eps->-1//compr
relm[r_]=Solve[%==0,f[r+1,t]][[1]]/.r->r-1/.m[r-2]->m[r]+1//Simplify

Insert in eigenfunction equations for lowest value of r.
First for eps=1,  r0<-p, and r=-p.

f2p=f[2-p,t]/.relp[2-p]
eip1=efeqn[h,p,-p,f,ell,m[h,-p],1]/. Derivative[0,1][f][2-p,t]->D[f2p,t]/.f[2-p,t]->f2p/.m[h,2-p]->m[h,-p]+1//Simplify
Coefficient[%,Derivative[0,2][f][-p,t]]//Simplify

6p eip1[[1]]+eip1[[2]]//Factor

Next for eps = 1,  p≤r0<p, and r = r0.

Clear[r0]
fr0p=f[2+r0,t]/.relp[2+r0]
eip2=efeqn[h,p,r0,f,ell,0,1]/.Derivative[0,1][f][2+r0,t]->D[fr0p,t]/.f[2+r0,t]->fr0p/.m[h,r0+2]->1//Simplify
Coefficient[%,Derivative[0,2][f][r0,t]]//Simplify

3(r0-p)eip2[[1]]-eip2[[2]]//Factor

For eps=1, r0 = p, no substitution is necessary.

efeqn[h,p,p,f,ell,0,1]//Simplify
%[[2]]//Factor

For eps = -1,  r=-p, r0>-p

f2p=f[2-p,t]/.relm[2-p]
eip3=efeqn[h,p,-p,f,ell,m[h,-p],-1]/.Derivative[0,1][f][2-p,t]->D[f2p,t]/.f[2-p,t]->f2p/.m[h,2-p]->m[h,-p]-1//Simplify
Coefficient[%,Derivative[0,2][f][-p,t]]//Simplify

6p eip3[[1]]+eip3[[2]]//Factor

Last case eps = -1, r0=-p

efeqn[h,p,-p,f,ell,0,-1][[2]]/.Abs[ell]->-ell//Factor

Second downward shift operator

Get the kernel relations

F=tht[m[h,r]]f[r,t]Phi[h,p,r,p]
sm3m1=sh[-3,-1,F,subnab]

Separate values 1 and -1 of  eps=Sign[ell]
Shift the summation variable r such that Phi[hh,pp,r,pp] occurs

Clear[relp]
sm3m1/.eps->1//compr
relp[r_]=Solve[%==0,f[r-1,t]][[1]]/.r->r+1/.m[h,r+2]->m[h,r]+1//Simplify

Clear[relm]
sm3m1/.eps->-1//compr
relm[r_]=Solve[%==0,f[r-1,t]][[1]]/.r->r+1/.m[h,r+2]->m[h,r]-1//Simplify

Now the relation between the components runs downward

Case eps=1, r0<p; r=p

f2m=f[p-2,t]/.relp[p-2]//Simplify
eia=efeqn[h,p,p,f,ell,m[h,p],1]/.Derivative[0,1][f][-2+p,t]->D[f2m,t]/.f[-2+p,t]->f2m/.m[h,p-2]->m[h,p]-1/.Abs[ell]->ell//Simplify
Coefficient[%, Derivative[0,2][f][p,t]]

6p eia[[1]]-eia[[2]]//Factor

This has indeed the right solutions h = -3 p + 2w’

Case eps = 1, r0 =p; r = p
No substitution needed

efeqn[h,p,p,f,ell,0,1]//Factor

The second coordinate gives the right factor

Case eps = -1, r0 >p, r=p

f2m=f[p-2,t]/.relm[p-2]
eib=efeqn[h,p,p,f,ell,m[h,p],-1]/.Derivative[0,1][f][-2+p,t]->D[f2m,t]/.f[-2+p,t]->f2m/.m[h,p-2]->m[h,p]+1//Simplify
Coefficient[% ,Derivative[0,2][f][p,t]]

6p eib[[1]]-eib[[2]]//Factor

Case eps = -1,-p< r0 <=p, r=r0

f2m=f[r0-2,t]/.relm[r0-2]/.m[h,r0-2]->1
eic=efeqn[h,p,r0,f,ell,0,-1]/.Derivative[0,1][f][r0-2,t]->D[f2m,t]/.f[r0-2,t]->f2m//Simplify
Coefficient[%, Derivative[0,2][f][r0,t]]//Simplify

3(p+r0)eic[[1]]-eic[[2]]/.Abs[ell]->-ell//Factor

Case eps = -1,r0=-p, r=-p

efeqn[h,p,-p,f,ell,0,-1]/.Abs[ell]->-ell//
Simplify
%[[2]]//Factor

14 Kernel of upward shift operators

Proposition 3.24  concerns the possibility of a non-trivial kernel of upward shift operators. Proposition 3.14 tells us that that does not happen in the generic abelian case. 
We give computations for the other cases.

14a. N-trivial case

In this case we can consider a single term, with h-3r=2j

Clear[f,r,p,h,j,nu]
F=f[t]Phi[h,p,r,p]/.r->(h-2j)/3

First upward  shift operator

sh[3,1,F,subtriv]
ff=f[t]/.DSolve[%==0,f[t],t][[1]]

efeqt[h,p,r,f]/.{f[r,t]->ff,Derivative[0,ee_][f][r,t]:>D[ff,{t,ee}]}/.r->(h-2j)/3//Factor

Second upward  shift operator

sh[-3,1,F,subtriv]
ff=f[t]/.DSolve[%==0,f[t],t][[1]]

efeqt[h,p,r,f]/.{f[r,t]->ff,Derivative[0,ee_][f][r,t]:>D[ff,{t,ee}]}/.r->(h-2j)/3//Factor

14b. Non-abelian case

First upward shift operator

We first establish the kernel relations, separately for eps = 1 and eps = -1

Clear[relp,relm]
F=tht[m[h,r]]f[r,t]Phi[h,p,r,p]
s31=(sh[3,1,F,subnab]//compr)/.r->r-1/.m[h,r-2]->m[h,r]-eps//Simplify
relp[r_]=Solve[(s31/.eps->1)==0,f[r,t]][[1]]//Simplify
relm[r_]=Solve[(s31/.eps->-1)==0,f[r,t]][[1]]//Simplify

Lowest component

tht[m[h,-p]]f[-p,t]Phi[h,p,-p,p]
sh[3,1,%,subnab]
Coefficient[%,Phi[h+3,p+1,-p-1,p+1]]//Simplify
%/.eps->{1,-1}//Simplify

This may be zero for non-zero (Subscript[f, -p ])only if eps=1 and m[h,-p]=0.
So to consider further the case ε=1 and -p ≤ (Subscript[r, 0])<p.

f2p=f[r0+2,t]/.relp[r0+2]/.m[h,r0+2]->1//Simplify
eia=efeqn[h,p,r0,f,ell,0,1]/.Derivative[0,1][f][2+r0,t]->D[f2p,t]/.f[2+r0,t]->f2p/.m[h,r0]->0//Simplify
Coefficient[%,Derivative[0,2][f][r0,t]]//Simplify

3 (2+p+r0) eia[[1]]-eia[[2]]//Factor

Case eps = 1 and (Subscript[r, 0]) = p.

tht[0]f[p,t]Phi[h,p,p,p]
sh[3,1,%,subnab]/.eps->1//Simplify
fp=f[p,t]/.DSolve[%==0,f[p,t],t][[1]]

efeqn[h,p,p,f,ell,0,1]/.Derivative[0,ee_][f][p,t]:>D[fp,{t,ee}]/.f[p,t]->fp//Simplify
%/.{j->(h-3p)/2,nu->2+(h+p)/2}//Simplify

The K-type is on the boundary of the sector Sect[j].

{j1,nu1}=S1[{(h-3p)/2,2+(h+p)/2}]
{j2,nu2}=S2[{(h-3p)/2,2+(h+p)/2}]

(h+6+3p-2j1)
(h+6+3p-2j2)//Simplify

So j’=j1

Second upward shift operator

Kernel relations

Clear[relp,relm]
F=tht[m[h,r]]f[r,t]Phi[h,p,r,p]
sm31=(sh[-3,1,F,subnab]//compr)/.r->r+1/.m[h,r+2]->m[h,r]+eps//Simplify
relp[r_]=Solve[(sm31/.eps->1)==0,f[r,t]][[1]]//Simplify
relm[r_]=Solve[(sm31/.eps->-1)==0,f[r,t]][[1]]//Simplify

To consider eps=-1 and -p ≤ (Subscript[r, 0])≤p

One component (Subscript[f, -p]) and (Subscript[r, 0])=-p

tht[0]f[-p,t]Phi[h,p,-p,p]
sh[-3,1,%,subnab]/.eps->-1
fmp=f[-p,t]/.DSolve[%==0,f[-p,t],t][[1]]

eia=efeqn[h,p,-p,f,ell,0,-1]/.Derivative[0,ee_][f][-p,t]:>D[fmp,{t,ee}]/.f[-p,t]->fmp/.ell->-Abs[ell]//Simplify

jj=(h+3p)/2
nuu=2+(p-h)/2
eia/.{j->jj,nu->nuu}//Simplify

{j1,nu1}=S1[{jj,nuu}]
{j2,nu2}=S2[{jj,nuu}]

h-6-3p-2j1//Simplify
 h-6-3p-2j2//Simplify

So we can take j'=j2

Cases - p < r0≤p

Consider the eigenfunction equations for r=r0

fr0m2=f[r0-2,t]/.relm[r0-2]/.m[h,-2+r0]->1

eia=efeqn[h,p,r0,f,ell,0,-1]/.Derivative[0,1][f][r0-2,t]->D[fr0m2,t]/.f[-2+r0,t]->fr0m2/.ell->-Abs[ell]//Simplify

Coefficient[eia, Derivative[0,2][f][r0,t]]//Simplify

eia[[2]]+(6+3p-3r0)eia[[1]]//Factor

15 Principal series

See §3.5.1

Clear[phi,t,nu]
phi[h_,p_,r_,q_,nu_]:=t^(2+nu)Phi[h,p,r,q]

15a. Shift operators

Check of (3.78)

Clear[h,p,r]
sh[3,1,phi[h,p,r,p,nu],subtriv]/phi[h+3,p+1,r+1,p+1,nu]//Simplify
sh[-3,1,phi[h,p,r,p,nu],subtriv]/phi[h-3,p+1,r-1,p+1,nu]//Simplify

sh[3,-1,phi[h,p,r,p,nu],subtriv]/phi[h+3,p-1,r+1,p-1,nu]//Simplify
sh[-3,-1,phi[h,p,r,p,nu],subtriv]/phi[h-3,p-1,r-1,p-1,nu]//Simplify

15b. Intertwining operator ν↦-ν

Check of (3.80)

Clear[c]
c[h_,p_,r_,nu_]:=Gamma[1+(p-nu)/2+(h-r)/4]Gamma[1+(p-nu)/2+(r-h)/4]Gamma[1+(p+nu)/2+(h-r)/4]^(-1)Gamma[1+(p+nu)/2+(r-h)/4]^(-1);

Clear[ii0]
ii0[t^(2+nu_)Phi[h_,p_,r_,q_]]:=c[h,p,r,nu]phi[h,p,r,q,-nu]
ii0[ff_  gg_]:=ff ii0[gg]/;FreeQ[ff,t]&&FreeQ[ff,Phi]

Inverse

phi[h,p,r,q,nu]
ii0[%]
ii0[%]

Check of intertwining property for shift operators

Clear[h,p,r,nu]
ii0[sh[3,1,phi[h,p,r,p,nu],subtriv]]/sh[3,1,ii0[phi[h,p,r,p,nu]],subtriv]//FullSimplify

ii0[sh[3,-1,phi[h,p,r,p,nu],subtriv]]/sh[3,-1,ii0[phi[h,p,r,p,nu]],subtriv]//FullSimplify

ii0[sh[-3,1,phi[h,p,r,p,nu],subtriv]]/sh[-3,1,ii0[phi[h,p,r,p,nu]],subtriv]//FullSimplify

ii0[sh[-3,-1,phi[h,p,r,p,nu],subtriv]]/sh[-3,-1,ii0[phi[h,p,r,p,nu]],subtriv]//FullSimplify

15c. Check Table 4.1 in Section 4.2.1

Downward shift operators

Clear[j1,j2]
sh[3,-1,phi[h,p,r,p,nu],subtriv]/phi[h+3,p-1,r+1,p-1,nu]/.r->(h-2j)/3//Simplify
Solve[%==0,p]
(h/3)-p==(2/3)j2/.%[[2]]//Simplify
%/.j2->-(3nu+j)/2

sh[-3,-1,phi[h,p,r,p,nu],subtriv]/phi[h-3,p-1,r-1,p-1,nu]/.r->(h-2j)/3//Simplify
Solve[%==0,p]
(h/3)+p==(2/3)j1/.%[[2]]//Simplify
%/.j1->(3nu-j)/2//Simplify

Upward shift operators

q=sh[3,1,phi[h,p,r,p,nu],subtriv]/Phi[3+h,1+p,1+r,1+p]//Simplify
Solve[%==0,p]
(* r=-2-p is impossible *)
h/3+p==(2/3)j2-2/.%[[2]]/.r->(h-2j)/3//Simplify
%/.j2->-(3nu+j)/2

q=sh[-3,1,phi[h,p,r,p,nu],subtriv]/Phi[-3+h,1+p,-1+r,1+p]//Simplify
Solve[%==0,p]
h/3-p==(2/3)j1+2/.%[[1]]/.r->(h-2j)/3//Simplify
%/.j1->(3nu-j)/2

16 Evaluation at zero

See §3.5.3: (3.98) and Proposition 3.38

We assume that  the component (Subscript[f, r])(t) is already written as (t^(2+ν))(Subscript[h, r])(t).
The operator ev0 is evaluation at 0. The routine ev does the actual work: preserves addition and multiplication, equals one on the functions on N, and preserves (t^(2+ν))

Clear[ev,ev0,h]
ev0[ff_]:=ev[Expand[ff]]
ev[ff_+gg_]:=ev[ff]+ev[gg]
ev[ff_ gg_]:=ev[ff]ev[gg]
ev[h[r_,t_]]:=h[r,0]
ev[t^(nu+cc_)]:=0/;cc≥3
ev[t^(2+nu)]:=t^(2+nu)
ev[chbt]:=1
ev[tht[mm_]]:=1
ev[ff_]:=ff/;FreeQ[ff,t]&&FreeQ[ff,chbt]&&FreeQ[ff,tht]

Check of shift operators in the abelian case

Clear[h,p,r]
F=chbt t^(2+nu)h[r,t]Phi[h,p,r,p]

ev0[sh[3,1,F,subab]]==
sh[3,1,ev0[F],subtriv]//Simplify
ev0[sh[3,-1,F,subab]]==
sh[3,-1,ev0[F],subtriv]//Simplify
ev0[sh[-3,1,F,subab]]==
sh[-3,1,ev0[F],subtriv]//Simplify
ev0[sh[-3,-1,F,subab]]==
sh[-3,-1,ev0[F],subtriv]//Simplify

Check on shift operators in the non-abelian case

Clear[h,p,r,m]
F=tht[m[h,r]] t^(2+nu)h[r,t]Phi[h,p,r,p]

ev0[sh[3,1,F,subnab]]==
sh[3,1,ev0[F],subtriv]//Simplify
ev0[sh[3,-1,F,subnab]]==
sh[3,-1,ev0[F],subtriv]//Simplify
ev0[sh[-3,1,F,subnab]]==
sh[-3,1,ev0[F],subtriv]//Simplify
ev0[sh[-3,-1,F,subnab]]==
sh[-3,-1,ev0[F],subtriv]//Simplify

Chapter 4 with Sections 17-25

17 Intersection of kernels of downward shift operators (principal series)

17a. Weyl group action

Subsitution rules for ((SubPlus[j]),(SubPlus[ν])) ,  ((Subscript[j, r]),(Subscript[ν, r])), and ((Subscript[j, l]),(Subscript[ν, l])) that are related by (4.2).

Clear[jl,jp,jr,nul,nup,nur]
sub2p={jl->(1/2) (-jp-3 nup),nul->(1/2) (-jp+nup),jr->(1/2) (-jp+3 nup),nur->((jp+nup)/2)};
sub2r={jp->(1/2)(-jr+3nur),nup->(1/2)(jr+nur)};
sub2l={jp->(1/2)(-jl-3nul),nup->(1/2)(-jl+nul)};

In computations in the later sections of this chapter these subtitution rules are often useful .
 Warning : direct transition between ((Subscript[j, l]),(Subscript[ν, l])) and ((Subscript[j, r]),(Subscript[ν, r]))   does not work.

S2[{jp, nup}]=={jl,nul}//.sub2p//Simplify
S2[{jr, nur}]=={jl,-nul}//.sub2p//Simplify
S2[{jp,- nup}]=={jr,-nur}//.sub2p//Simplify

S1[{jp, nup}]=={jr,nur}//.sub2p//Simplify
S1[{jl, nul}]=={jr, -nur}//.sub2p//Simplify
S1[{jp,- nup}]=={jl,-nul}//.sub2p//Simplify

17b. Computations for Lemma 4.5

Part ii)

{jl+jp,(jp-jl)/3}/.sub2p//Simplify
%/.sub2r//Simplify

{jl+jr,(jr-jl)/3}/.sub2p//Simplify

{jp+jr,(jr-jp)/3}/.sub2p//Simplify
%/.sub2l//Simplify

nul+nur/.sub2p//Simplify

Part iii)

Relations

cc={{(h+p)/2,nu1},{(h-p)/2,nu2}}
cc//.{h->-jr,p->nur,nu1->nul,nu2->nup}/.sub2p//Simplify;
{%[[1]]/.sub2l,%[[2]]/.sub2p}//Simplify
cc//.{h->-jp,p->nup,nu1->nul,nu2->nur}/.sub2p//Simplify;
{%[[1]]/.sub2l,%[[2]]/.sub2r}//Simplify
cc//.{h->-jl,p->nul,nu1->nup,nu2->nur}/.sub2p//Simplify;
{%[[1]]/.sub2p,%[[2]]/.sub2r}//Simplify

Part iv)

Clear[zt]
cc={nu1+j1,nu1-j1,nu2+j2,nu2-j2}/.{j1->zt1 nu1-2p,j2->zt2 nu2+2p}

cc1=cc/.{zt1->-1,zt2->-1,nu1->nul,nu2->nup}//Simplify

cc2=cc/.{zt1->1,zt2->-1,nu1->nul,nu2->nur}//Simplify

cc3=cc/.{zt1->1,zt2->1,nu1->nup,nu2->nur}//Simplify

nup-p <=p/.p->nur/.sub2p//Simplify
%/.sub2r

nur-p≤p/.p->nup/.sub2p//Simplify

nul-p≤p/.p->nup/.sub2p//Simplify
%/.sub2l//Simplify

{-p,nul-p}/.p->(h-2jl)/2//Simplify
{%[[1]]/.h->jl+jp,%[[2]]/.h->jl+jr}//Simplify
%//.sub2p//Simplify
%/.sub2l//Simplify

17c. Logarithmic elements

In the proof of Proposition 4.4 we have to check that logarithmic elements do not contribute to the intersection of the kernels of the downward shift operators.

Clear[c,h,p,r,j]
ph=(Log [t]+c) Phi[h,p,r,p]
{sh[3,-1,ph,subtriv],sh[-3,-1,ph,subtriv]}//Simplify
eqs={%/.Log[t]->0,Coefficient[%,Log[t]]}4(p+1)p^(-1)/.Phi[hh_,pp_,rr_,qq_]:>1//Flatten

This can be zero only if  c≠0

eqs[[1]]-eqs[[2]]//Simplify

This implies r= h

eqs/.r->h

Since  p≥1 this is impossible.

18 Intersection of kernels of downward shift operators in the  generic abelian case

18abc support the direct proof of Proposition 4.8
18d supports the proof of Lemma 4.9

18a Differential equation for the components

Copy the kernel relations from 13b

Clear[h,p,t,f,r3m1,rm3m1]
r3m1[rr_]={f[rr,t]->(1/(4 betac π t))I ((-2+h-2 p-rr) f[-2+rr,t]+2 t Derivative[0,1][f][-2+rr,t])}
rm3m1[rr_]={f[rr,t]->(1/(4 beta π t))I ((2+h+2 p-rr) f[2+rr,t]-2 t Derivative[0,1][f][2+rr,t])}

Take r such that -p ≤r≤p-2. Combine both relations for (Subscript[f, r])and (Subscript[f, r+2]) to a second order differential equation for (Subscript[f, r]).

frp=f[r+2,t]/.r3m1[r+2]

Clear[r]
frp=f[r+2,t]/.r3m1[r+2](* f[r+2,t] expressed in f[r,t] and derivative by the first downward kernel relation *)
f[r,t]/.rm3m1[r](* f[r,t] expressed in f[r+2,t] and derivative by the second downward kernel relation *)
%-f[r,t](* resulting relation *)/. f[2+r,t]->frp/.Derivative[0,1][f][2+r,t]->D[frp,t]//Simplify
eq=%/. betac ->Abs[beta]^2/beta//Simplify

Write (Subscript[f, r])(t) = (t^(p+2))(Subscript[j, r])(t)

Clear[j,tau]
eq/.f[r,t]->t^(2+p) j[r,2Pi Abs[beta]t]/.Derivative[0,ee_][f][r,t]:>D[t^(2+p) j[r,2Pi Abs[beta]t],{t,ee}]/.t->tau/(2Pi Abs[beta])//Simplify
Solve[%==0,Derivative[0,2][j][r,tau]][[1]]//Simplify

This is the modified Bessel differential equation with parameter 
ν=(h-r)/2.

18b. Coefficient relations

Clear[coI,coK,fr,f]
fr[r_,t_]=t^(p+2)(coI[r] BesselI[(h-r)/2,2Pi Abs[beta] t]+coK[r]  BesselK[(h-r)/2,2Pi Abs[beta] t])

Kernel relation for the downward shift operators

eq1=(f[r+2,t]/.r3m1[r+2])-f[r+2,t]//Simplify
eq2=(f[r,t]/.rm3m1[r])-f[r,t]//Simplify

Both these quantities have to be zero.
Substitution of the solutions;
we write β=ρ (e^(i ϑ)) and try to get a simple expression.

Clear[rho,th]
{eq1a,eq2a}={eq1,eq2}/.f[rr_,t]:>fr[rr,t]/.Derivative[0,1][f][rr_,t]:>D[fr[rr,t],t]//.{beta->rho E^(I th),betac->rho E^(-I th),Abs[rho]->rho,Im[th]->0,(1/pp_)^ee_:>pp^(-ee),(pp_ rho)^ee_:>pp^ee rho^ee}//Simplify

Try to get a simplification with the contiguous relations.

eq1b=eq1a/.Besseldn[(1/2) (2+h-r)]//Simplify

eq2b=eq2a//.Besselup[(1/2) (-4+h-r)]//Simplify

That is indeed simpler.

Solve[{eq1b==0,eq2b==0},{coI[r+2],coK[r+2]}]

18c. Eigenfunction?

Does this solution satisfy the eigenfunction equations?

Try first  the K-Bessel function

Clear[ff]
ff[r_,t]=t^(2+p)(  -I beta/Abs[beta])^((r+p)/2)BesselK[(h-r)/2,2Pi Abs[beta]t]

efeqa[h,p,r,f,beta]/.f[rr_,t]:>ff[rr,t]/. Derivative[0,ee_][f][rr_,t]:>D[ff[rr,t],{t,ee}]//Simplify
eqs=(%/.Besseldn[(1/2) (4+h-r)]/.Besselup[(1/2) (-4+h-r)]//Simplify)/.Besseldn[(1/2) (2+h-r)]/. Conjugate[beta]->Abs[beta]^2/beta//Simplify

eqs/.j->-h/.nu->p//Simplify

Indeed, we have an eigenfunction with spectral parameters (-h,p).

Next the I-Bessel function.

Clear[ff]
ff[r_,t]=t^(2+p)(  I beta/Abs[beta])^((r+p)/2)BesselI[(h-r)/2,2Pi Abs[beta]t]

efeqa[h,p,r,f,beta]/.f[rr_,t]:>ff[rr,t]/. Derivative[0,ee_][f][rr_,t]:>D[ff[rr,t],{t,ee}]//Simplify
eqs=(%/.Besseldn[(1/2) (4+h-r)]/.Besselup[(1/2) (-4+h-r)]//Simplify)/.Besseldn[(1/2) (2+h-r)]/. Conjugate[beta]->Abs[beta]^2/beta//Simplify

eqs/.j->-h/.nu->p//Simplify

Both elements behave under ZU(g) according to the character ψ=ψ[-h,p].

18d. Dimension considerations

Lemma 4.9, (SubMinus[F])

Let F be as in the proof of Proposition 4.8  have components (Subscript[f, r]). Let (SubPlus[F]) and (SubMinus[F]) be the images of F under the shift operators, and suppose that (SubMinus[F]) is a linear combinations of basis functions.

Write (SubMinus[F])= (Subscript[c, 1]) (ω^(0,p-1))((Subscript[j, 2]),(Subscript[ν, 2])) + (Subscript[c, 2]) (μ^(0,p-1))((Subscript[j, 2]),(Subscript[ν, 2]))

Clear[b,bc]
F=chbt(f[p-2,t]Phi[h,p,p-2,p]+f[p,t]Phi[h,p,p,p])
sh[3,-1,F,subab]//Simplify
bc=Coefficient[%,chbt Phi[h+3,p-1,p-1,p-1]]//Simplify

bc is the highest component of (Subscript[((S^3)), -1])F

sol=Solve[b==bc,Derivative[0,1][f][-2+p,t]][[1]]//Simplify

Substitute this in the second eigenfunction equation

Clear[sgn]
efeqa[h,p,p,f,beta][[2]]/.j->(h+3p)/2/.nu->sgn(h-p)/2/.sol//Simplify
%/.beta betac->Abs[beta]^2/.sgn^2->1

Lemma 4.9, (SubPlus[F])

Clear[bc,b]
F=chbt(f[-p+2,t]Phi[h,p,-p+2,p]+f[-p,t]Phi[h,p,-p,p])
Fp=sh[-3,-1,F,subab]
bc=Coefficient[Fp,chbt Phi[h-3,p-1,1-p,p-1]]//Simplify

bc is the lowest component of (SubPlus[F])

sol=Solve[b==bc, Derivative[0,1][f][2-p,t]][[1]]//Simplify

This substitution expresses the derivative of (Subscript[f, 2-p])in terms of (Subscript[f, -p]) and b. We substitute it in the second eigenfunction equation.

efeqa[h,p,-p,f,beta][[2]]/.j->(h-3p)/2/.nu->(h+p)/2/.sol/.Abs[beta]^2->beta Conjugate[beta]//Simplify

The lowest component b of (SubPlus[F]) vanishes, hence (SubPlus[F])=0.

19 Kernel relations in the nonabelian case

Computations for Table 4.6 in §4.4.2

19a. First downward shift operator

F=tht[m[r]]f[r,t]Phi[h,p,r,p]

sh[3,-1,F,subnab]//compr//Simplify;
kr3m1=%/.r->r+1/.m[r+2]->m[r]+eps//Simplify

kr3m1/.eps->1/.Abs[ell]->ell//Simplify;
kr3m1psub=Solve[%==0,f[r+2,t]][[1]]
(f[r+2,t]/.%)==(2 t Derivative[0,1][f][r,t]+(h-2p-r-4+4Pi ell t^2)f[r,t])/(4I t Sqrt[2Pi ell(1+m[r])])/.(pp_ qq_)^ee_:>pp^ee qq^ee//Simplify

This is valid for m[r] ≥ 0 and r+2≤p

kr3m1/.eps->-1//Simplify;

kr3m1msub=Solve[%==0,f[r+2,t]][[1]]//Simplify
(f[r+2,t]/.%)==-(2 t Derivative[0,1][f][r,t]+(h-2p-r-4+4Pi ell t^2)f[r,t])/(4I t Sqrt[2Pi Abs[ell]m[r]])//Simplify

Valid for m(r)≥1

kr3m1/.eps->-1/.r->r0/.m[r0]->0//Simplify

Valid for r=r0 between -p and p

19b. Second downward shift operator

F=tht[m[r]]f[r,t]Phi[h,p,r,p]

sh[-3,-1,F,subnab]//compr//Simplify;
krm3m1=%/.r->r-1/.m[r-2]->m[r]-eps//Simplify

krm3m1/.eps->1/.Abs[ell]->ell//Simplify;
krm3m1psub=f[r-2,t]/.Solve[%==0,f[r-2,t]][[1]]//Simplify
%==( (h+2p-r+4+4Pi ell t^2)f[r,t]-2 t Derivative[0,1][f][r,t])/(4I t Sqrt[2Pi ell m[r]])/.(pp_ qq_)^ee_:>pp^ee qq^ee//Simplify

Valid for m[r]≥0

krm3m1/.eps->-1//Simplify
krm3m1msub=Solve[%==0,f[r-2,t]][[1]]//Simplify

(f[r-2,t]/.krm3m1msub)==-((h+2p-r+4+4Pi ell t^2)f[r,t]-2 t Derivative[0,1][f][r,t])/(4 I t Sqrt[2Pi Abs[ell](1+m[r])])//Simplify

Valid for m[r]≥0

krm3m1/.eps->1/.r->r0/.m[r0]->0//Simplify

Valid for |(Subscript[r, 0 ])|≤p

20 Extremal families in the non-abelian case

Computations  related to the proof of Proposition 4.14 and Lemma 4.15

In 20a and 20b  we check the relations in Tables 4.7 and 4.8;
20c and 20d concern Table 4.9.

20a. Check of the relations in (4.11)

In these cases we need only one component. 
We use that (Subscript[r, 0 ])=± p -2ε (Subscript[m, 0]). 
  For (x^(p,0)) and ε = 1  we have  (Subscript[r, 0])=p -2(Subscript[m, 0]) and hence (Subscript[r, 0])<-p,
  and for (x^(0,p))and ε=-1 we have (Subscript[r, 0])=-p+2(Subscript[m, 0])>p.

Clear[m,m0,factor]
msub={m[h_,r_]:>m0+(eps/6)(3r+2j-h)}

Case (x^(p,0)), ε=1, p<(Subscript[m, 0])

Determining components of order - p (for (x^(p,0))) and -p-1 (for (x^(p+1,0))).

F=tht[m[h,-p]]f[-p,t]Phi[h,p,-p,p]

sh[3,1,F,subnab]/.eps->1//Simplify
Coefficient[%,Phi[h+3,p+1,-p-1,p+1]]//Simplify
%==factor tht[m[h+3,-p-1]] t f[-p,t]/.msub/.h->2j+3p/.eps->1//Simplify
Solve[%,factor]

Case (x^(p,0)), ε=-1

Determining components of order - p and -p-1

F=tht[m[h,-p]]f[-p,t]Phi[h,p,-p,p]

sh[3,1,F,subnab]/.eps->-1//Simplify
Coefficient[%,Phi[h+3,p+1,-p-1,p+1]]//Simplify
%==factor tht[m[h+3,-p-1]]t f[-p,t]/.msub/.h->2j+3p/.eps->-1//Simplify
Solve[%,factor]

Case (x^(0,p)), ε=1

Determining components of order p and p+1

F=tht[m[h,p]]f[p,t]Phi[h,p,p,p]

sh[-3,1,F,subnab]/.eps->1//Simplify
Coefficient[%,Phi[h-3,p+1,p+1,p+1]]//Simplify
%==factor tht[m[h-3,p+1]]t  f[p,t]/.msub/.h->2j-3p/.eps->1//Simplify
Solve[%,factor]

Case (x^(p,0)), ε=-1, p<(Subscript[m, 0])

Determining components of order p and p+1

F=tht[m[h,p]]f[p,t]Phi[h,p,p,p]

sh[-3,1,F,subnab]/.eps->-1//Simplify
Coefficient[%,Phi[h-3,p+1,p+1,p+1]]//Simplify
%==factor tht[m[h-3,p+1]] t f[p,t]/.msub/.h->2j-3p/.eps->-1//Simplify
Solve[%,factor]

20b. More complicated cases

In these cases more components are needed.

Clear[m0,r0,wh,factor]
whsub={ Derivative[0,0,2][wh][kp_,s_,tau_]:>(1/4-kp/tau+(s^2-1/4)tau^(-2))wh[kp,s,tau]};

First upward shift operator, ε=1,  p≥(Subscript[m, 0]), -p ≤ (Subscript[r, 0])<p

F=tht[0]f[r0,t]Phi[h,p,r0,p]+tht[1]f[r0+2,t]Phi[h,p,r0+2,p]

Determine component of order (Subscript[r, 0])+2  of F with use of the fact that (Subscript[((S^3)), -1])F=0.

Coefficient[sh[3,-1,F,subnab],Phi[h+3,p-1,r0+1,p-1]]/.eps->1//Simplify
sol=Solve[%==0,f[r0+2,t]][[1]]//Simplify

Now we need two Whittaker functions

fr0=t^(m0+1)wh[kap,nu/2,2Pi Abs[ell]t^2]
fr1=t^(m0+1)wh[kap-1,nu/2,2Pi Abs[ell]t^2]

F/.sol//Simplify (* the expression for (Subscript[f, 2+(Subscript[r, 0])]) inserted *)
sh[3,1,%,subnab]/.eps->1/.Abs[ell]->ell(* carry out upward shift operator and determine its lowest component FP1*)
FP1=Coefficient[%,Phi[3+h,1+p,1+r0,1+p]]/.f[r0,t]->fr0/.Derivative[0,ee_][f][r0,t]:>D[fr0,{t,ee}]/.whsub//Simplify

We want to determine the ratio with the highest component of F

eqn=FP1-factor tht[0]fr1//.{Abs[ell]->ell,h->2j+3p,r0->p-2m0,p->-kap-(j+1)/2}//Simplify

The Whittaker function may be any of the three standard Whittaker functions. We use substitutions defined in A2d (appendix).

eqn/.wh->WhittakerW/.Whdn[kap+1](* relations for Whittaker functions, to simplify the expression *)/.kap->-p-(j+1)/2(* value of κ in Table 4.5 *)//Simplify
Solve[%==0,factor][[1]]//Factor

eqn/.wh->WhittakerV/.Whrel/.Whdn[kap+1]/.kap->-p-(j+1)/2//Simplify
Solve[%==0,factor][[1]]//Factor

eqn/.wh->WhittakerM/.Whdn[kap+1]/.kap->-p-(j+1)/2//Simplify
Solve[%==0,factor][[1]]//Factor

These three factors are to be used in Table 4.8 (third box on the right).

First upward shift operator, ε=1,  p≥(Subscript[m, 0]), (Subscript[r, 0])=p

Now there is only one component

F=tht[0]f[p,t]Phi[h,p,p,p]

We need two Whittaker functions

fr0=t^(m0+1)wh[kap,nu/2,2Pi Abs[ell]t^2]
fr1=t^(m0+1)wh[kap-1,nu/2,2Pi Abs[ell]t^2]

sh[3,1,F,subnab]/.eps->1
FP1=Coefficient[%,Phi[3+h,1+p,1+p,1+p]]/.f[p,t]->fr0/.Derivative[0,ee_][f][p,t]:>D[fr0,{t,ee}]/.whsub//Simplify

eqn=FP1-factor tht[0]fr1//.{Abs[ell]->ell,h->2j+3p,p->-kap-(j+1)/2,m0->0}//Simplify

The three cases :

eqn/.wh->WhittakerW/.Whdn[kap+1]/.kap->-p-(j+1)/2//Simplify
Solve[%==0,factor][[1]]//Factor

eqn/.wh->WhittakerV/.Whrel/.Whdn[kap+1]/.kap->-p-(j+1)/2//Simplify
Solve[%==0,factor][[1]]//Factor

eqn/.wh->WhittakerM/.Whdn[kap+1]/.kap->-p-(j+1)/2//Simplify
Solve[%==0,factor][[1]]//Factor

Also in third box on the right in Table 4.8.

Second upward shift operator, ε=-1,  p≥(Subscript[m, 0]), (Subscript[r, 0])<p

F=tht[0]f[r0,t]Phi[h,p,r0,p]+tht[1]f[r0-2,t]Phi[h,p,r0-2,p]

Determine component of order (Subscript[r, 0])-2

Coefficient[sh[-3,-1,F,subnab],Phi[h-3,p-1,r0-1,p-1]]/.eps->-1//Simplify
sol=Solve[%==0,f[r0-2,t]][[1]]//Simplify

Now we need two Whittaker functions

fr0=t^(m0+1)wh[kap,nu/2,2Pi Abs[ell]t^2]
fr1=t^(m0+1)wh[kap-1,nu/2,2Pi Abs[ell]t^2]

F/.sol//Simplify
sh[-3,1,%,subnab]/.eps->-1
FP1=Coefficient[%,Phi[-3+h,1+p,-1+r0,1+p]]/.f[r0,t]->fr0/.Derivative[0,ee_][f][r0,t]:>D[fr0,{t,ee}]/.whsub//Simplify

eqn=FP1-factor tht[0]fr1//.{Abs[ell]->-ell,h->2j-3p,r0->-p+2m0,p->-kap+(j-1)/2}//Simplify

The three cases :

eqn/.wh->WhittakerW/.Whdn[kap+1]/.kap->-p+(j-1)/2//Simplify
Solve[%==0,factor][[1]]//Factor

eqn/.wh->WhittakerV/.Whrel/.Whdn[kap+1]/.kap->-p+(j-1)/2//Simplify
Solve[%==0,factor][[1]]//Factor

eqn/.wh->WhittakerM/.Whdn[kap+1]/.kap->-p+(j-1)/2//Simplify
Solve[%==0,factor][[1]]//Factor

This goes into the 8-th box on the right in Table 4.8

Second upward shift operator, ε=-1,  p≥(Subscript[m, 0]), (Subscript[r, 0])=-p

F=tht[0]f[-p,t]Phi[h,p,-p,p]

fr0=t^(m0+1)wh[kap,nu/2,2Pi Abs[ell]t^2]
fr1=t^(m0+1)wh[kap-1,nu/2,2Pi Abs[ell]t^2]

sh[-3,1,F,subnab]/.eps->-1
FP1=Coefficient[%,Phi[-3+h,1+p,-1-p,1+p]]/.f[-p,t]->fr0/.Derivative[0,ee_][f][-p,t]:>D[fr0,{t,ee}]/.whsub//Simplify

eqn=FP1-factor tht[0]fr1//.{Abs[ell]->-ell,h->2j-3p,p->-kap+(j-1)/2,m0->0}//Simplify

The three cases :

eqn/.wh->WhittakerW/.Whdn[kap+1]/.kap->-p+(j-1)/2//Simplify
Solve[%==0,factor][[1]]//Factor

eqn/.wh->WhittakerV//.Whrel/.Whdn[kap+1]/.kap->-p+(j-1)/2//Simplify
Solve[%==0,factor][[1]]//Factor

eqn/.wh->WhittakerM/.Whdn[kap+1]/.kap->-p+(j-1)/2//Simplify
Solve[%==0,factor][[1]]//Factor

Box 8 on the right in Table 4.8

20c. Downward shift operator Sh(3,-1)

Note that this shift operator is considered on (x^(0,p)), on which we know that the other shift operator vanishes.

Clear[m,m0,h,r0,wh]
m[h_,r_]:=m0+(eps/6)(3r+2j-h)//Simplify
whsub={ Derivative[0,0,2][wh][kp_,s_,tau_]:>(1/4-kp/tau+(s^2-1/4)tau^(-2))wh[kp,s,tau]};

Case ε=1

F=tht[m[h,p]]f[p,t]Phi[h,p,p,p]+tht[m[h,p-2]]f[p-2,t]Phi[h,p,p-2,p]/.eps->1/.h->2j-3p//Simplify

Determine relation between components

sh[-3,-1,F,subnab]/.eps->1//Simplify
fp2m=f[p-2,t]/.Solve[Coefficient[%,Phi[-3-3 p+2 j,-1+p,-1+p,-1+p]]==0,f[p-2,t]][[1]]//Simplify

Apply downward shift operator and substitute for (Subscript[f, p-2])

sh[3,-1,F,subnab]/.eps->1/.f[-2+p,t]->fp2m/.Derivative[0,1][f][-2+p,t]->D[fp2m,t]//Simplify
co=Coefficient[%,tht[m0+p-1]Phi[3-3 p+2 j,-1+p,-1+p,-1+p] ]//Simplify

Clear[kap0]
wh0=t^(p+1) wh[kap0,nu/2,2Pi Abs[ell]t^2]
quot=co/(t^p wh[kap0,nu/2,2Pi Abs[ell]t^2])/.f[p,t]->wh0/.Derivative[0,ee_][f][p,t]:>D[wh0,{t,ee}]//.whsub/.Abs[ell]->ell/.kap0->-m0-(j+1)/2//Factor

This goes in the sixth box in Table 4.9.

Case ε=-1, 1≤p ≤(Subscript[m, 0])

With the same approach as in the previous case

F=tht[m[h,p]]f[p,t]Phi[h,p,p,p]+tht[m[h,p-2]]f[p-2,t]Phi[h,p,p-2,p]/.eps->-1/.h->2j-3p

sh[-3,-1,F,subnab]/.eps->-1//Simplify
fp2m=f[p-2,t]/.Solve[Coefficient[%,Phi[-3-3 p+2 j,-1+p,-1+p,-1+p] ]==0,f[p-2,t]][[1]]//Simplify

sh[3,-1,F,subnab]/.eps->-1/.{f[p-2,t]->fp2m,Derivative[0,1][f][-2+p,t]->D[fp2m,t]}//Simplify
co=Coefficient[%,tht[1+m0-p]Phi[3-3p+2j,p-1,p-1,p-1]]//Simplify

Clear[wh,kap0]
wh0=t^(p+1) wh[kap0,nu/2,2Pi Abs[ell]t^2]
quot=co/(t^p wh[kap0,nu/2,2Pi Abs[ell]t^2])/.f[p,t]->wh0/. Derivative[0,ee_][f][p,t]:>D[wh0,{t,ee}]/.whsub/.ell->-Abs[ell]/.kap0->-m0-(-j+1)/2//Factor

Box 7 on the right in Table 4.9

Case ε=-1,  p≥ (Subscript[m, 0]), (Subscript[r, 0])>-p

F = tht[0]f[r0,t]Phi[h,p,r0,p]+tht[1]f[r0-2,t]Phi[h,p,r0-2,p]

sh[-3,-1,F,subnab]/.eps->-1//Simplify
fr0m=f[r0-2,t]/.Solve[Coefficient[%,Phi[-3+h,-1+p,-1+r0,-1+p]]==0,f[r0-2,t]][[1]]//Simplify

sh[3,-1,F,subnab]/.eps->-1/.{f[-2+r0,t]->fr0m,Derivative[0,1][f][-2+r0,t]->D[fr0m,t]}//Simplify
co=Coefficient[%,tht[0]Phi[3+h,-1+p,1+r0,-1+p] ]/.h->2j-3p/.ell->-Abs[ell]//Simplify

Work with the three separate Whittaker functions

Clear[wh,kap0]
wh0=t^(m0+1) wh[kap,nu/2,2Pi Abs[ell]t^2]
quot=co/(t^(m0+1)wh[kap+1,nu/2,2Pi Abs[ell]t^2])/.{ f[r0,t]->wh0,Derivative[0,1][f][r0,t]->D[wh0,t]}/.m0->(r0+p)/2//Simplify

quot/.wh->WhittakerW/.kap->-p+(j-1)/2//Simplify

quot/.wh->WhittakerV//.Whrel/.kap->-p+(j-1)/2//Factor

quot/.wh->WhittakerM/.kap->-p+(j-1)/2//Simplify

Last box of Table 4.9.

Case ε = -1,  p> (Subscript[m, 0]), (Subscript[r, 0 ])=-p

In this case there is only one component

F=tht[0]f[-p,t]Phi[h,p,-p,p]

sh[3,-1,F,subnab]
co=Coefficient[%,tht[0] Phi[3+h,-1+p,1-p,-1+p]]//Simplify

Clear[wh,kap0]
wh0=t^(m0+1) wh[kap,nu/2,2Pi Abs[ell]t^2]
quot=co/(t^(m0+1)wh[kap+1,nu/2,2Pi Abs[ell]t^2])/.{f[-p,t]->wh0,Derivative[0,1][f][-p,t]->D[wh0,t]}//.{ell->-Abs[ell],h->2j-3p,j->2kap+2p+1,m0->0}//Simplify

quot/.wh->WhittakerW//Simplify

quot/.wh->WhittakerV//.Whrel/.kap->-p+(j-1)/2//Factor

quot/.wh->WhittakerM/.kap->-p+(j-1)/2//Simplify

Last box in Table 4.9

20d. Downward shift operator Sh(-3,-1)

This concerns the upper part of Table 4.9.

whsub={ Derivative[0,0,2][wh][kp_,s_,tau_]:>(1/4-kp/tau+(s^2-1/4)tau^(-2))wh[kp,s,tau]};

Case ε = 1, 1≤p≤(Subscript[m, 0])

The same methods as in 20c. 
We consider families (x^(p,0)).

Clear[r,f]

F=tht[m[h,-p]]f[-p,t]Phi[h,p,-p,p]+tht[m[h,-p+2]]f[-p+2,t]Phi[h,p,-p+2,p]/.h->2j+3p/.eps->1//Simplify

sh[3,-1,F,subnab]/.eps->1//Simplify
Coefficient[%,Phi[3+3p+2j,p-1,1-p,p-1]]//Simplify
fm2p=f[2-p,t]/.Solve[%==0,f[2-p,t]][[1]]//Simplify

sh[-3,-1,F,subnab]/.eps->1/.f[2-p,t]->fm2p/.Derivative[0,1][f][2-p,t]->D[fm2p,t]//Simplify
co=Coefficient[%,tht[1+m0-p]Phi[3p+2j-3,p-1,1-p,p-1]]//Simplify

Clear[wh,kap0]
wh0=t^(p+1) wh[kap0,nu/2,2Pi Abs[ell]t^2]
co/.f[-p,t]->wh0/. Derivative[0,ee_][f][-p,t]:>D[wh0,{t,ee}]/.whsub//Simplify
quot=%/(t^p wh[kap0,nu/2,2Pi Abs[ell]t^2])/.Abs[ell]->ell/.kap0->-m0-(j+1)/2//Factor

Box 2 on the right in Table 4.9

Case ε = 1,  p> (Subscript[m, 0]), (Subscript[r, 0 ])<p

F=tht[m[h,r0]]f[r0,t]Phi[h,p,r0,p]+tht[m[h,r0+2]]f[r0+2,t]Phi[h,p,r0+2,p]/.h->2j+3p/.eps->1/.m0->(p-r0)/2//Simplify

sh[3,-1,F,subnab]/.eps->1//Simplify;
Coefficient[%,Phi[+3+3p+2j,p-1,r0+1,p-1]]
fr0p=f[r0+2,t]/.Solve[%==0,f[r0+2,t]][[1]]//Simplify

sh[-3,-1,F,subnab]/.eps->1/.f[r0+2,t]->fr0p/.Derivative[0,ee_][f][2+r0,t]:>D[fr0p,{t,ee}]//Simplify
co=Coefficient[%,tht[0]Phi[-3+3 p+2 j,-1+p,-1+r0,-1+p]]//Simplify

Clear[wh,kap0]
wh0=t^(m0+1) wh[kap,nu/2,2Pi Abs[ell]t^2]
quot=co/(t^(m0+1)wh[kap+1,nu/2,2Pi Abs[ell]t^2])/.f[r0,t]->wh0/.Derivative[0,1][f][r0,t]->D[wh0,t]/.j->-2kap-2p-1/.Abs[ell]->ell/.r0->p-2m0//Simplify

quot/.wh->WhittakerW//Simplify

quot/.wh->WhittakerV/.Whrel/.kap->-p-(j+1)/2//Factor

quot/.wh->WhittakerM/.kap->-p-(j+1)/2//Simplify

Box 3 on the right in Table 4.9

Case ε = 1,  p> (Subscript[m, 0]), (Subscript[r, 0 ])=p

Only one component

F=tht[0]f[p,t]Phi[h,p,p,p]/.h->2j+3p/.eps->1//Simplify

sh[-3,-1,F,subnab]
co=Coefficient[%,tht[0]Phi[-3+3 p+2 j,-1+p,-1+p,-1+p] ]//Simplify

Clear[wh,kap0]
wh0=t^(m0+1) wh[kap,nu/2,2Pi Abs[ell]t^2]
quot=co/(t^(m0+1)wh[kap+1,nu/2,2Pi Abs[ell]t^2])/.f[p,t]->wh0/.Derivative[0,1][f][p,t]->D[wh0,t]/.m0->0/.Abs[ell]->ell/.j->-2kap-2p-1//Simplify

quot/.wh->WhittakerW//Simplify

quot/.wh->WhittakerV//.Whrel/.kap->-p-(j+1)/2//Factor

quot/.wh->WhittakerM/.kap->-p-(j+1)/2//Simplify

Box 3 on the right in Table 4.9

Case ε = -1

F=tht[m[h,-p]]f[-p,t]Phi[h,p,-p,p]+tht[m[h,-p+2]]f[-p+2,t]Phi[h,p,-p+2,p]/.h->2j+3p/.eps->-1//Simplify

sh[3,-1,F,subnab]
Coefficient[%,Phi[3+3 p+2 j,-1+p,1-p,-1+p] ]/.eps->-1//Simplify
fm2p=f[2-p,t]/.Solve[%==0,f[2-p,t]]//Simplify

sh[-3,-1,F,subnab]/.f[2-p,t]->fm2p/.Derivative[0,1][f][2-p,t]->D[fm2p,t]/.eps->-1//Simplify
co=Coefficient[%,tht[-1+m0+p]Phi[-3+3p+2j,p-1,1-p,p-1]]//Simplify

Clear[wh,kap0]
wh0=t^(p+1) wh[kap0,nu/2,2Pi Abs[ell]t^2]
quot=co/(t^p wh[kap0,nu/2,2Pi Abs[ell]t^2])/.f[-p,t]->wh0/.Derivative[0,ee_][f][-p,t]:>D[wh0,{t,ee}]/.whsub/.{ell->-Abs[ell],kap0->-m0-(-j+1)/2}//Factor

Box 4 on the right in Table 4.9

20e. Computations for Lemma 4.15

Clear[kp,s,eps]
muups=(1/2+kp+s≤0)
muom=(1/2-kp+s≤0)

Part i)

ε = 1

muups/.s->nu/2/.kp->-Max[p,m0[j]]-(j+1)/2//Simplify

ε = -1

muups/.s->nu/2/.kp->-m0[j]-(-j+1)/2//Simplify

Part ii)

ε = 1

muups/.s->nu/2/.kp->-m0[j]-(j+1)/2//Simplify

ε = -1

muups/.s->nu/2/.kp->-Max[m0[j],p]-(-j+1)/2//Simplify

Part iii)

ε = 1

muom/.s->nu/2/.kp->-Max[m0[j],p]-(j+1)/2//Simplify

ε =- 1

muom/.s->nu/2/.kp->-m0[j]-(-j+1)/2//Simplify

Part iv)

ε = 1

muom/.s->nu/2/.kp->-m0[j]-(j+1)/2//Simplify

ε =- 1

muom/.s->nu/2/.kp->-Max[m0[j],p]-(-j+1)/2//Simplify

21 Intersection of kernels of downward shift operators, non-abelian case

Computations in connection with Propositions 4.16 and 4.27

An auxiliary substitution

Clear[h,j,m0,eps,m,p,r,kap,m]
parmsub={kap[h,r_]:>-m[h,r]-eps s[h,r]-1/2,
m[hh_,rr_+2]:>m[hh,rr]+eps,m[hh_,rr_-2]:>m[hh,rr]-eps,s[h_,r_]:>(h-r)/4};

21a Differential equations for components

One component

If m[h, eps p] = 0 there is only one component, f[eps p,t]

Case eps=1

F=tht[0]f[p,t]Phi[h,p,p,p]
sh[3,-1,F,subnab]/.eps->1 (* is of course 0 *)
sh[-3,-1,F,subnab]/.eps->1

fp=f[p,t]/.DSolve[%==0,f[p,t],t][[1]]/.C[1]->1//Simplify

fp^(-1)t^(p+1)WhittakerV[kap[h,p],-s[h,p],2Pi ell t^2]//.parmsub/.eps->1/.m[h,p]->0/.Whrel//Simplify
(* use that (Subscript[V, κ,s]) is even in s *)
%/.(ell t^2)^ee_:>ell^ee t^(2ee)//Simplify

This is a non-zero quantity not depending on t.

Case eps = -1

F=tht[0]f[-p,t]Phi[h,p,-p,p]
sh[-3,-1,F,subnab]/.eps->-1 (* is of course 0 *)
sh[3,-1,F,subnab]/.eps->-1/.ell->-Abs[ell]

fmp=f[-p,t]/.DSolve[%==0,f[-p,t],t][[1]]/.C[1]->1//Simplify

fmp^(-1)t^(p+1)WhittakerV[kap[h,-p],s[h,-p],2Pi Abs[ell]t^2]//.parmsub/.m[h,-p]->0/.eps->-1//.Whrel/.( t^2)^ee_:> t^(2ee)//Simplify

Copies of kernel relations from 19

Clear[krnab3m1,krnabm3m1,f]
krnab3m1[1]=f[2+r,t]==-((I ((-4+h-2 p-r+4 ell π (t^2)) f[r,t]+2 t Derivative[0,1][f][r,t]))/(4 (Sqrt[2 π]) t (Sqrt[Abs[ell]]) (Sqrt[1+m[h,r]])));

krnab3m1[-1]=f[2+r,t]==(I ((-4+h-2 p-r+4 ell π (t^2)) f[r,t]+2 t Derivative[0,1][f][r,t]))/(4 (Sqrt[2 π]) t (Sqrt[Abs[ell]]) (Sqrt[m[h,r]]));

krnabm3m1[1]=f[-2+r,t]==-((I ((4+h+2 p-r+4 ell π (t^2)) f[r,t]-2 t Derivative[0,1][f][r,t]))/(4 (Sqrt[2 π]) t (Sqrt[ell]) (Sqrt[m[h,r]])));

krnabm3m1[-1]=f[-2+r,t]==(I ((4+h+2 p-r+4 ell π (t^2)) f[r,t]-2 t Derivative[0,1][f][r,t]))/(4 (Sqrt[2 π]) t (Sqrt[Abs[ell]]) (Sqrt[1+m[h,r]]));

More than one component, case eps=1

We consider two successive components (Subscript[f, r])and (Subscript[f, r+2]) and combine the results of the kernel relations.
First we solve (Subscript[f, r+2]) from one of the kernel relations, obtaining an expression in terms of (Subscript[f, r]) and its derivative.

frp=f[r+2,t]/.Solve[krnab3m1[1],f[r+2,t]][[1]]//Simplify

We insert this expression in the other kernel relation. This results in a second order differential equation.

deq=krnabm3m1[1]/.r->r+2/.Derivative[0,1][f][2+r,t]->D[frp,t]/.f[r+2,t]->frp//.parmsub/.eps->1//Simplify

Go over to expected form

Clear[wh,tau]
deq/.Derivative[0,ee_][f][r,t]:>D[t^(p+1)wh[2Pi ell t^2],{t,ee}]/.f[r,t]->t^(p+1)wh[2Pi ell t^2]/.t->Sqrt[tau]/Sqrt[2Pi ell]//Simplify
Solve[%,wh''[tau]][[1]]/.Abs[ell]->ell//Simplify
(wh''[tau]/.%)/wh[tau]//Simplify
%==1/4-kap[h,r]/tau+(s[h,r]^2-1/4)/tau^2//.parmsub/.eps->1//Simplify

Indeed the Whittaker differential equation .

More than one component, case eps=-1

frp=f[r+2,t]/.Solve[krnab3m1[-1],f[r+2,t]][[1]]//Simplify

deq=krnabm3m1[-1]/.r->r+2/.Derivative[0,1][f][2+r,t]->D[frp,t]/.f[r+2,t]->frp//.parmsub/.eps->-1/.ell->-Abs[ell]//Simplify

Clear[wh,tau]
deq/.Derivative[0,ee_][f][r,t]:>D[t^(p+1)wh[2Pi Abs[ell] t^2],{t,ee}]/.f[r,t]->t^(p+1)wh[2Pi Abs[ell] t^2]/.t->Sqrt[tau]/Sqrt[2Pi Abs[ell]]//Simplify
Solve[%,wh''[tau]][[1]]//Simplify
(wh''[tau]/.%)/wh[tau]//Simplify
%==1/4-kap[h,r]/tau+(s[h,r]^2-1/4)/tau^2//.parmsub/.eps->-1//Simplify

21b Check kernel relations and determination of coefficients

We suppose that one component  has the form  (Subscript[f, r])=(t^(p+1)) (Subscript[wh, κ(r),s(r)])(2π|ℓ|t^2)
and try to determine the components (Subscript[f, r-2])and (Subscript[f, r+2]) under the assumption m(h,r±2)≠0

Clear[kap,s,eps]
subkaps={kap[r_+2]:>kap[r]-eps/2,kap[r_-2]:>kap[r]+eps/2,s[r_+2]:>s[r]-1/2,s[r_-2]:>s[r]+1/2};

We use the kernel relations given in 21a.

General starting formula

Clear[p,m,wh,fr,frp2,frm2,qoW,qoV]
fr[r_,t_]:=t^(p+1){WhittakerW[kap[r],s[r],2Pi Abs[ell]t^2],WhittakerV[kap[r],s[r],2Pi Abs[ell]t^2]}
frp2=fr[r+2,t]{qoW,qoV}/.subkaps;
frm2=fr[r-2,t]{qoW,qoV}/.subkaps;

Clear[coV,voW]
coV[r_]=(-1)^(m[h,r])Factorial[m[h,r]]^(-1/2)
coW[r_]=I^(m[h,r])Factorial[m[h,r]]^(1/2)

Case ε=1, up

krnab3m1[1]/.f[2+r,t]->frp2/.f->fr/.subkaps/.eps->1/.Abs[ell]->ell/.Whrel/.Whups[kap[r]-1/2,s[r]-1/2]/.Whups[kap[r]+1/2,s[r]-1/2]/.Whup[kap[r]-1]/.h-r->4 s[r]//.{(ell pp_)^ee_:>ell ^ee pp^ee,(t^ff_)^ee_:>t^(ff ee)}//Simplify;
rel=%/.{2 kap[r]-> -2 m[h,r]-2 eps s[r]-1}/.eps->1//Simplify

rel/.{qoW->I Sqrt[1+m[h,r]],qoV->-1/Sqrt[1+m[h,r]]}//Simplify

{coW[r+2]/coW[r]==I Sqrt[1+m[h,r]],coV[r+2]/coV[r]==-1/Sqrt[1+m[h,r]]}//.parmsub/.eps->1/.Factorial[1+nn_]:>(nn+1)Factorial[nn]//.{(pp_ qq_)^ee_:>pp^ee qq^ee}//Simplify

Case ε=1, down

krnabm3m1[1]/.f[-2+r,t]->frm2/.f->fr/.subkaps/.eps->1/.Abs[ell]->ell//.Whrel/.Whdns[kap[r]+1/2,s[r]+1/2]/.Whdn[kap[r]+1]//.{(ell pp_)^ee_:>ell ^ee pp^ee,(t^ff_)^ee_:>t^(ff ee)}//Simplify;
%/.{qoW->(I Sqrt[1+m[h,r-2]])^(-1),qoV->(-(1+m[h,r-2])^(-1/2))^(-1)}/.m[h,r-2]->m[h,r]-1/.s[r-2]->s[r]+1/2//Simplify;
%//.{s[r]->(h-r)/4,kap[r]->-m[h,r]-s[r]-1/2}//Simplify

Case ε=1, relation for r=(Subscript[r, 0])

In the case that -p≤(Subscript[r, 0])<p there is still   a relation to check.

Clear[r0]
krnabm3m1[1]

I ((4+h+2 p-r+4 ell π (t^2)) f[r,t]-2 t Derivative[0,1][f][r,t])/.r->r0/.f->fr//Simplify;
%{coW,coV}/.Whrel//.{kap[r0]->-m[h,r0]-s[r0]-1/2,m[h,r0]->0,s[r0]->(h-r0)/4}/.Abs[ell]->ell//Simplify
%/.h-r0->r0-h//.Whrel//Simplify

So the W-Whittaker function does not yield a solution.

Case ε=-1, down

krnabm3m1[-1]/.f[-2+r,t]->frm2/.f->fr/.subkaps/.eps->-1/.ell->-Abs[ell]//.Whrel/.Whdns[kap[r]-1/2,s[r]+1/2]/.Whdn[kap[r]+1]/.{(ell pp_)^ee_:>ell ^ee pp^ee,(t^ff_)^ee_:>t^(ff ee)}//Simplify;
rel=(%//.{h-r->4 s[r],-I h+I r->-4I s[r],2I kap[r]->-2I m[h,r]+2 I s[r]-I,4I kap[r]->-4I m[h,r]+4 I s[r]-2I}//Simplify)/.{2I kap[r]->-2I m[h,r]+2 I s[r]-I}//Simplify

rel/.{qoW->I Sqrt[1+m[h,r]],qoV->-1/Sqrt[1+m[h,r]]}//Simplify

{coW[r-2]/coW[r]==I Sqrt[1+m[h,r]],coV[r-2]/coV[r]==-1/Sqrt[1+m[h,r]]}//.parmsub/.eps->-1/.Factorial[1+nn_]:>Factorial[nn](1+nn)//.{(pp_ qq_)^ee_:>pp^ee qq^ee,(1/pp_)^ee_:>pp^(-ee)}//Simplify

Case ε=-1, up

krnab3m1[-1]/.f[2+r,t]->frp2/.f->fr/.subkaps/.{qoW->(I Sqrt[1+m[h,r+2]])^(-1),qoV->(-1/Sqrt[1+m[h,r+2]])^(-1),qoM->(-((I (Sqrt[1+m[h,r+2]]))/(1+2 s[r+2])))^(-1)}/.m[h,r+2]->m[h,r]-1/.eps->-1/.ell->-Abs[ell]//.Whrel/.Whups[kap[r]+1/2,s[r]-1/2]//.{(ell pp_)^ee_:>ell ^ee pp^ee,(t^ff_)^ee_:>t^(ff ee)}//Simplify;
%//.{h-r->4s[r],kap[r]->-m[h,r]+s[r]-1/2}//Simplify;
%/.s[rr_]->(h-rr)/4//Simplify

Case ε=-1, relation for r=(Subscript[r, 0])

krnab3m1[-1]

Clear[r0]
((-4+h-2 p-r+4 ell π (t^2)) f[r,t]+2 t Derivative[0,1][f][r,t])/.r->r0/.f->fr//Simplify;
%{coW,coV}//.Whrel/.eps->-1/.ell->-Abs[ell]/.kap[r0]->s[r0]-1/2//Simplify;
%/.s[r0]->(h-r0)/4/.Whrel//Simplify

So the W-Whittaker functions do not satisfy the kernel relations for these values of (Subscript[r, 0]).

21c. Identifications for Proposition 4.16 part ii)

We check Lemma 4.17, which is used for this purpose

Relations from Lemma 4.5, applied when two j-values are given

subst1={p->(j2-j1)/3,j1->jl,j2->jp,nu1->(jr-jp)/3,nu2->(jr-jl)/3,h->jl+jp};
subst2={p->(j2-j1)/3,j1->jl,j2->jr,nu1->(jr-jp)/3,nu2->(jp-jl)/3,h->jl+jr};
subst3={p->(j2-j1)/3,j1->jp,j2->jr,nu1->(jr-jl)/3,nu2->(jp-jl)/3,h->jp+jr};

Parameter comparison

Part i) of the lemma.

rel={kap[h,-p]==-m0[j1]-(eps j1+1)/2,s[h,-p]==zt1 nu1/2,
kap[h,p]==-m0[j2]-(eps j2+1)/2,
s[h,p]==zt2 nu2/2}//.parmsub/.m[h,r_]:>(eps/2)(r-r0)/.{m0[j1]->-eps(r0-p)/2,m0[j2]->-eps(r0+p)/2}/.h->j1+j2//Simplify

rel//.subst1/.jp->-jl-jr/.{zt1->-1,zt2->-1}//Simplify
rel//.subst2/.jp->-jl-jr/.{zt1->1,zt2->-1}//Simplify
rel//.subst3/.jp->-jl-jr/.{zt1->1,zt2->1}//Simplify

Parts ii) and iii) of Lemma 4.17

{t^(m0[j1]+1)WhittakerV[-p-(j1+1)/2,-(h+p)/4,2Pi ell t^2](*choice of sign of s is possible *), t^(p+1)WhittakerV[kap[h,r0],-s[h,r0],2Pi ell t^2](*choice of sign of s is possible *),t^(2+j1+2p+m0[j1])E^(Pi ell t^2)}//.parmsub/.m[h,r_]:>(1/2)(r-r0)/.m0[j1]->-eps(r0-p)/2/.j1->(h-3p)/2/.eps->1//.Whrel//.(ell t^2)^ee_:>ell^ee t^(2ee)//Simplify
{%[[1]],%[[2]]}/%[[3]]//Simplify

The ratios do not depend on t .

{t^(m0[j2]+1)WhittakerV[-p+(j2-1)/2,(h-p)/4,2Pi Abs[ell]t^2],t^(p+1)WhittakerV[kap[h,r0],s[h,r0],2Pi Abs[ell]t^2],t^(2-j2+2p+m0[j2])E^(Pi Abs[ell]t^2)}//.parmsub/.m[h,r_]:>(-1/2)(r-r0)/.m0[j2]->-eps(r0+p)/2/.j2->(h+3p)/2/.eps->-1//.Whrel/.(t^2)^ee_:>t^(2ee)//Simplify
{%[[1]],%[[2]]}/%[[3]]//Simplify

Ratios independent of t

21d. Computations related to Proposition 4.27

Three combinations ((Subscript[j, 1]),(Subscript[j, 2]))

This concerns the convention introduced before the statement of Proposition 4.27. See Figure 4.34.

h<-p/.h->2j1+3p//.subst1/.sub2l//Simplify
-p≤h≤p/.h->2j1+3p//.subst2/.sub2p//Simplify
h>p/.h->2j1+3p//.subst3/.sub2r//Simplify

This confirms the characterization of the three combinations in Figure 4.34.

Table (4.76)

p4={2p+j1-nu1,2p+j1+nu1,2p-j2-nu2,2p-j2+nu2};
p4//.subst1/.sub2p//Simplify
%/.sub2l//Simplify

p4//.subst2/.sub2p//Simplify

p4//.subst3/.sub2p//Simplify
%/.sub2r//Simplify

Relations for coefficients of (k^M)

We show the relations (4.80) and (4.74)

Clear[coA,coB,kap,s]
coA[r_]=-E^(Pi I kap[r])Gamma[1+2Abs[s[r]]]Gamma[1/2+Abs[s[r]]-kap[r]]^(-1)
coB[r_]=-I E^(Pi I(kap[r]-Abs[s[r]]))Gamma[1+2Abs[s[r]]]Gamma[1/2+Abs[s[r]]+kap[r]]^(-1)

Clear[coV,coW]
coW[r_]=E^(Pi I m[h,r]/2)Sqrt[Factorial[m[h,r]]]
coV[r_]=E^( Pi I m[h,r])/Sqrt[Factorial[m[h,r]]]

Clear[bt]
bt[r_]=coV[r]coW[r]^(-1)coB[r]coA[r]^(-1)/.kap[rr_]:>-m[h,rr]-eps s[rr]-1/2/.I^xx_:>E^(Pi I xx/2)//Simplify

We assume eps ((Subscript[r, 0])-h)>0 and eps(r-(Subscript[r, 0]))≥0.
Then eps s[r]<0.

bt[r]/.m[h,rr_]:>(eps/2)(rr-r0)/.{Abs[s[r]]->-eps s[r]}/.s[r]->(h-r)/4/.h->r0-Abs[h-r0]/eps/.Gamma[xx_]:>Factorial[xx-1]//Simplify

This confirms (4.80).

coV[r]/coA[r]/.Gamma[1+xx_]:>Factorial[xx]//Simplify

This confirms (4.74).

22 Lemma 4.18 on dimensions

General substitution

Clear[h,p,eps,r0,m0]
hpsub={j1->(h-3p)/2,j2->(h+3p)/2,nu1->Abs[h+p]/2,nu2->Abs[h-p]/2};
mrsub={m0[j1]->eps(p-r0)/2,m0[j2]->-eps(r0+p)};

22a. Case 0<(Subscript[m, 0])((Subscript[j, 1]))<p , and  ε=1

Now (Subscript[r, 0]) is active in restricting the components. We consider the two lowest components of F.

Clear[f,fp]
F=tht[0]f[r0,t]Phi[h,p,r0,p]+tht[1]f[r0+2,t]Phi[h,p,r0+2,p]

We use that one shift operator gives zero :

sh[3,-1,F,subnab]/.eps->1//Simplify(* should be zero *)
Coefficient[%,Phi[3+h,-1+p,1+r0,-1+p]]
fr0p2=f[2+r0,t]/.Solve[%==0,f[2+r0,t]][[1]]//Simplify

-((i ((-4+h-2 p-r0+4 ell π (t^2)) f[r0,t]+2 t Derivative[0,1][f][r0,t]))/(4 (Sqrt[2 π]) t (Sqrt[Abs[ell]])))

We get (SuperPlus[F])by the other downward shift operator.

Fp=sh[-3,-1,F,subnab]/.eps->1//Simplify
fp[r0-1,t]=Coefficient[Fp,Phi[-3+h,-1+p,-1+r0,-1+p]]/tht[0]//Simplify

We know the lowest order term of (SuperPlus[(Subscript[b, υ])]) .
Hence we have with a non-zero factor cnz:

Clear[cnz]
eq=(- (4+h+2 p-r0+4 ell π (t^2)) f[r0,t]+2 t Derivative[0,1][f][r0,t])==cnz t^(0+1)WhittakerV[-p+1-(j1+1)/2,nu1,2Pi Abs[ell]t^2]/.Abs[ell]->ell/.hpsub/.Abs[h+p]->h+p//Simplify
(* Use that V is even in the second parameter. *)

We solve for the derivative of (Subscript[f, (Subscript[r, 0])])

fr0d=Derivative[0,1][f][r0,t]/.Solve[eq,Derivative[0,1][f][r0,t]][[1]]//Simplify

This can be inserted in the eigenfunction equations for r=(Subscript[r, 0]), together with the expressions for (Subscript[f, (Subscript[r, 0])+2])

ei=efeqn[h,p,r0,f,ell,0,1]/.j->j1/.nu->nu1/.f[r0+2,t]->fr0p2/.Derivative[0,1][f][2+r0,t]->D[fr0p2,t]/.Derivative[0,2][f][r0,t]->D[fr0d,t]/. Derivative[0,1][f][r0,t]->fr0d//.Whrel/.hpsub/.Abs[h+p]^2->(h+p)^2//Simplify

These expressions should be zero. We insert the asymptotic behavior of the V-Whittaker function.

Clear[tau]
eia=ei/.t->Sqrt[tau]/Sqrt[2Pi Abs[ell]]/.Abs[ell]->ell/.WhittakerV[kap_,s_,tau_]:>-E^(-Pi I kap)tau^(-kap)E^(tau/2)//Simplify

eia E^(-tau/2)tau^(-1-(h+p)/4)//Simplify
Limit[%,tau->Infinity]

So cnz has to vanish.

22b. Case (Subscript[m, 0])((Subscript[j, 1]))=0 , and  ε=1

m0[j1]==0/.mrsub

So  (Subscript[r, 0 ])=p

Clear[F,Fp,Fm,f,fp,t,r0]
F=tht[0]f[p,t]Phi[h,p,p,p]

Fp=sh[-3,-1,F,subnab]//Simplify

The sole component of (SuperPlus[F]) has an expression in terms of (Subscript[f, p]) and on the other hand has an explicit expression in a V-Whittaker function.
With cnz denoting a non-zero factor, and r0 the quantity (Subscript[r, 0])(h):

eq=(((4+h+p+4 ell π (t^2)) f[p,t]-2 t Derivative[0,1][f][p,t])==cnz t^(0+1)WhittakerV[-p+1-(j1+1)/2,nu1/2,2Pi Abs[ell]t^2])/.eps->1/.hpsub//Simplify

Find expressions for derivatives of (Subscript[f, p])

fpd= Derivative[0,1][f][p,t]/.Solve[eq,Derivative[0,1][f][p,t]][[1]]//Simplify
fpdd=D[fpd,t]/.Whrel//Simplify

Insert these relations into the eigenfunction equations

ei=efeqn[h,p,p,f,ell,0,1]/.{nu->nu1,j->j1}/. Derivative[0,2][f][p,t]->fpdd/.Derivative[0,1][f][p,t]->fpd/.hpsub/.Abs[h+p]^2->(h+p)^2/.Abs[ell]->ell//Simplify

This should be zero.
Insert the asymptotic behavior.

Clear[tau]
ei/.t->Sqrt[tau]/Sqrt[2Pi Abs[ell]]/.WhittakerV[kap_,s_,tau_]:>-E^(-Pi I kap)tau^(-kap)E^(tau/2)/.Abs[ell]->ell//Simplify
% E^(-tau/2)tau^(-1-(h+p)/4)//Simplify
Limit[%,tau->Infinity]//.{(1/ell)^ee_:>ell^(-ee),(ell tau)^ee_:>ell^ee tau^ee}//Simplify

This shows that cnz should be zero.

22c. Case 0<(Subscript[m, 0])((Subscript[j, 2]))<p , and  ε=-1

Clear[r0]
F=tht[0]f[r0,t]Phi[h,p,r0,p]+tht[1]f[r0-2,t]Phi[h,p,r0-2,p]

We use that one shift operator gives zero:

sh[-3,-1,F,subnab]/.eps->-1//Simplify
Coefficient[%,Phi[-3+h,-1+p,-1+r0,-1+p]]
fr0m2=f[r0-2,t]/.Solve[%==0,f[r0-2,t]][[1]]//Simplify

Next we use the other shift operator

Fp=sh[3,-1,F,subnab]/.eps->-1//Simplify
fp[r0-1,t]=Coefficient[%,Phi[3+h,-1+p,1+r0,-1+p]]/tht[0]//Simplify

We know the lowest order term of (SuperMinus[(Subscript[b, υ])]) .
Hence we have with a non-zero factor cnz:

Clear[cnz]
eq=((-4+h-2 p-r0+4 ell π (t^2)) f[r0,t]+2 t Derivative[0,1][f][r0,t])==cnz t^(0+1)WhittakerV[-p+1+(j2-1)/2,nu2,2Pi Abs[ell]t^2]/.ell->-Abs[ell]/.hpsub//Simplify

We solve for the derivative of (Subscript[f, (Subscript[r, 0])])

fr0d=Derivative[0,1][f][r0,t]/.Solve[eq,Derivative[0,1][f][r0,t]][[1]]//Simplify

This can be inserted in the eigenfunction equations, together with the expressions for (Subscript[f, (Subscript[r, 0])+2])

ei=efeqn[h,p,r0,f,ell,0,-1]/.j->j2/.nu->nu2/.f[r0-2,t]->fr0m2/.Derivative[0,1][f][-2+r0,t]->D[fr0m2,t]/.Derivative[0,2][f][r0,t]->D[fr0d,t]/. Derivative[0,1][f][r0,t]->fr0d//.Whrel/.hpsub/.ell->-Abs[ell]/.Abs[h-p]^2->(h-p)^2//Simplify

These expressions should be zero. We insert the asymptotic behavior of the V-Whittaker function.

Clear[tau]
eia=ei/.t->Sqrt[tau]/Sqrt[2Pi Abs[ell]]/.Abs[ell]->ell/.WhittakerV[kap_,s_,tau_]:>-E^(-Pi I kap)tau^(-kap)E^(tau/2)//Simplify

eia E^(-tau/2)tau^(-1+(h-p)/4)//Simplify
Limit[%,tau->Infinity]

So cnz has to vanish.

22d. Case (Subscript[m, 0])((Subscript[j, 2]))=0 , and  ε=-1

m0[j2]/.mrsub

So  (Subscript[r, 0])=-p

Clear[F,Fp,Fm,f,fp,t,r0]
F=tht[0]f[-p,t]Phi[h,p,-p,p]

Fp=sh[3,-1,F,subnab]//Simplify

So the sole component of (SuperPlus[F]) has an expression in terms of (Subscript[f, p]) and on the other hand has an explicit expression in a V-Whittaker function.
With cnz denoting a non-zero factor, and r0 the quantity (Subscript[r, 0])(h):

eq=((-4+h-p+4 ell π (t^2)) f[-p,t]+2 t Derivative[0,1][f][-p,t]==cnz t^(0+1)WhittakerV[-p+1+(j2-1)/2,nu2/2,2Pi Abs[ell]t^2])/.eps->-1/.hpsub//Simplify

Find expressions for derivatives of (Subscript[f, p])

fmpd= Derivative[0,1][f][-p,t]/.Solve[eq,Derivative[0,1][f][-p,t]][[1]]//Simplify
fmpdd=D[fmpd,t]/.Whrel//Simplify

Insert these relations into the eigenfunction equations

ei=efeqn[h,p,-p,f,ell,0,-1]/.{nu->nu2,j->j2}/. Derivative[0,2][f][-p,t]->fmpdd/.Derivative[0,1][f][-p,t]->fmpd/.hpsub/.ell->-Abs[ell]/.Abs[h-p]^2->(h-p)^2//Simplify

This should be zero.
Insert the asymptotic behavior.

Clear[tau]
ei/.t->Sqrt[tau]/Sqrt[2Pi Abs[ell]]/.WhittakerV[kap_,s_,tau_]:>-E^(-Pi I kap)tau^(-kap)E^(tau/2)/.Abs[ell]->ell//Simplify
% E^(-tau/2)tau^(-1+(h-p)/4)//Simplify
Limit[%,tau->Infinity]

This shows that cnz should be zero.

22e. Case 0≤(Subscript[m, 0])((Subscript[j, 2])) <(Subscript[m, 0])((Subscript[j, 1]))  and  ε=1

m0[j1]/.mrsub/.eps->1
m0[j2]/.mrsub/.eps->1
m0[j1]-m0[j2]/.mrsub/.eps->1//Simplify

This shows that (Subscript[r, 0])≤-p .
The lowest component of F is (Subscript[f, -p]) and the highest component is (Subscript[f, p]). These orders are different, since p≥1.

We denote (SuperPlus[F]) by Fp, and (SuperMinus[F])by Fm.
The components of (F^(± ))depend on two components of F.

Clear[F,Fp,Fm,f,fph,fml]
F=tht[m[h,p]]f[p,t]Phi[h,p,p,p]+tht[m[h,p]-1]f[p-2,t]Phi[h,p,p-2,p]
sh[3,-1,F,subnab]/.eps->1/.j->j2//Simplify
fph=(* highest component of Fp *)
Coefficient[%,Phi[3+h,-1+p,-1+p,-1+p]]/tht[m[h,p]-1] //Simplify

F=tht[m[h,-p]]f[-p,t]Phi[h,p,-p,p]+tht[m[h,-p]+1]f[2-p,t]Phi[h,p,2-p,p]
sh[-3,-1,F,subnab]/.eps->1/.j->j1//Simplify
fml=(* lowest component of Fm *)
Coefficient[%,Phi[-3+h,-1+p,1-p,-1+p]]/tht[m[h,-p]+1] //Simplify

We assume that the derivatives (SuperPlus[F])and (SuperMinus[F]) are a linear combination of basis functions, with determining components as indicated in Table 4.9.
The K-type of (SuperPlus[F])corresponds to a point on the left boundary of the sector Sect((Subscript[j, 2])).
For (SuperPlus[F]) we have to use the lower part of Table 4.9, applying it with (x^(0,p-1)).

Clear[cop,cup]
eqp=(fph==t^(p-1+1) ( cop WhittakerW[-m0[j2]-(j2+1)/2,nu2/2,2Pi Abs[ell]t^2]+cup WhittakerV[-m0[j2]-(j2+1)/2,nu2/2,2Pi Abs[ell]t^2]))/.m[h,r_]:>m0[j2]+(1/6)(3r+2j2-h)/.hpsub/.eps->1//Simplify

For (SuperMinus[F])we deal  with a K-type on the right boundary of the sector Sect((Subscript[j, 1])). Since (Subscript[m, 0])((Subscript[j, 1])) ≥ p we get

Clear[com,cum]
eqm=(fml==t^(p-1+1) ( com WhittakerW[-m0[j1]-(j1+1)/2,nu1/2,2Pi Abs[ell]t^2]+cum WhittakerV[-m0[j1]-(j1+1)/2,nu1/2,2Pi Abs[ell]t^2]))/.m[h,r_]:>m0[j1]+(1/6)(3r+2j1-h)//.hpsub/.eps->1//Simplify

The quantities  cop, cup, com and cum are unknown coefficients.
Table 4.5 expresses the parameter (Subscript[κ, 0]) in terms of (Subscript[m, 0])((Subscript[j, 1])) and (Subscript[m, 0])((Subscript[j, 2])).
We prefer to leave these quantities (Subscript[m, 0])((Subscript[j, 1]))=(Subscript[m, 0])((h-3p)/2) and (Subscript[m, 0])((Subscript[j, 2]))=(Subscript[m, 0])((h+3p)/2) 
in the computations.

The resulting equations eqm and eqp involve 
the components (Subscript[f, ±p]) , (Subscript[f, ±(p-2)]) and their derivatives. 
We solve the equations for  (Subscript[f, ±(p-2)])’.

solp=Solve[eqp,Derivative[0,1][f][-2+p,t]][[1]]//Simplify
solm=Solve[eqm,Derivative[0,1][f][2-p,t]][[1]]//Simplify

We take the eigenfunction equations for the components of F, of order p for the + case, and of order -p for the - case.

eip=efeqn[h,p,p,f,ell,m[p],1]/.solp/.nu->nu2/.j->j2/.{eps->1,Abs[ell]->ell}/.m[x_]:>m0[j2]+(1/6)(3x+2j2-h)//.hpsub/.Abs[h-p]^2->(h-p)^2//Simplify
eim=efeqn[h,p,-p,f,ell,m[-p],1]/.solm/.nu->nu1/.j->j1/.{eps->1,Abs[ell]->ell}/.m[x_]:>m0[j1]+(1/6)(3x+2j1-h)//.hpsub/.Abs[h+p]^2->(h+p)^2//Simplify

The following quantities should vanish.

ei={eip[[2]],eim[[2]]}/.tht[mm_]:>1

Use the asymptotic behavior of the Whittaker functions. First look at the exponentially growing contributions.

ei/.WhittakerW[kp_,s_,tau_]:>0/.WhittakerV[kp_,s_,tau_]:>tau^(-kp)Exp[tau/2]/.(ell (t^2))^ee_:>ell^ee t^(2ee)//Simplify
Series[Simplify[E^(-Pi ell t^2)%],{t,Infinity,0}]//Simplify

This shows that the coefficients cum and cup vanish.
Now the contribution of the W-Whittaker functions.

ei/.{cum->0,cup->0}/.WhittakerW[kp_,s_,tau_]:>tau^kp Exp[-tau/2]/.(ell (t^2))^ee_:>ell^ee t^(2ee)//Simplify

This shows that the coefficient cop and cup vanish as well.

The conclusion is that the determining coefficients of (SuperPlus[F])and (SuperMinus[F])are zero, which completes the proof in this case.

22f. Case 0≤(Subscript[m, 0])((Subscript[j, 1])) <(Subscript[m, 0])((Subscript[j, 2]))  and  ε=-1

m0[j1]/.mrsub/.eps->-1
m0[j2]/.mrsub/.eps->-1
m0[j1]-m0[j2]/.mrsub/.eps->-1//Simplify

This shows that (Subscript[r, 0])≥p .
The lowest component of F is (Subscript[f, -p]) and the highest component is (Subscript[f, p]). These orders are different, since p≥1.

We denote (SuperPlus[F]) by Fp, and (SuperMinus[F])by Fm.
The components of  (F^(± )) depend on two components of F.

Clear[F,Fp,Fm,f,fph,fml]
F=tht[m[h,p]]f[p,t]Phi[h,p,p,p]+tht[m[h,p]+1]f[p-2,t]Phi[h,p,p-2,p]
sh[3,-1,F,subnab]/.eps->-1/.j->j2//Simplify
fph=(* highest component of Fp *)
Coefficient[%,Phi[3+h,-1+p,-1+p,-1+p]]/tht[m[h,p]+1] //Simplify

F=tht[m[h,-p]]f[-p,t]Phi[h,p,-p,p]+tht[m[h,-p]-1]f[2-p,t]Phi[h,p,2-p,p]
sh[-3,-1,F,subnab]/.eps->-1/.j->j1//Simplify
fml=(* lowest component of Fm *)
Coefficient[%,Phi[-3+h,-1+p,1-p,-1+p]] /tht[-1+m[h,-p]] //Simplify

We assume that the derivatives (SuperPlus[F])and (SuperMinus[F]) are a linear combination of basis functions, with determining components as indicated in Table 4.17.
The K-type of (SuperPlus[F])corresponds to a point on the left boundary of the sector Sect((Subscript[j, 2])).
For (SuperPlus[F]) we have to use the lower part of Table 4.17, applying it with (x^(0,p-1)).

Clear[cop,cup]
eqp=(fph==t^(p-1+1) ( cop WhittakerW[-m0[j2]-(j2+1)/2,nu2/2,2Pi Abs[ell]t^2]+cup WhittakerV[-m0[j2]-(j2+1)/2,nu2/2,2Pi Abs[ell]t^2]))

For (SuperMinus[F])we deal  with a K-type on the right boundary of the sector Sect((Subscript[j, 1])).

Clear[com,cum]
eqm=(fml==t^(p-1+1) ( com WhittakerW[-m0[j1]-(j1+1)/2,nu1/2,2Pi Abs[ell]t^2]+cum WhittakerV[-m0[j1]-(j1+1)/2,nu1/2,2Pi Abs[ell]t^2]))

The quantities  cop, cup, com and cum are unknown coefficients.
Table 4.5 expresses the parameter (Subscript[κ, 0]) in terms of (Subscript[m, 0])(w') and (Subscript[m, 0])(w'').

The resulting equations eqm and eqp involve the 
components (Subscript[f, ±p]) , (Subscript[f, ±(p-2)]) and their derivatives. We solve the equations for  (Subscript[f, ±(p-2)])’.

solp=Solve[eqp,Derivative[0,1][f][-2+p,t]][[1]]//Simplify
solm=Solve[eqm,Derivative[0,1][f][2-p,t]][[1]]//Simplify

We take the eigenfunction equations for the components of F, of order p for the + case, and of order -p for the - case.

eip=efeqn[h,p,p,f,ell,m[p],-1]/.solp/.nu->nu2/.j->j2/.{eps->-1,ell->-Abs[ell]}/.m[p]->m[h,p]/.m[h,x_]:>m0[j2]-(1/6)(3x+2j2-h)//Simplify
eim=efeqn[h,p,-p,f,ell,m[-p],-1]/.solm/.nu->nu1/.j->j1/.{eps->-1,ell->-Abs[ell]}/.m[-p]->m[h,-p]/.m[h,x_]:>m0[j1]-(1/6)(3x+2j1-h)//Simplify

The following quantities should vanish.

ei={eip[[2]],eim[[2]]}//.hpsub/.Abs[xx_]^2->xx^2//Simplify

Use the asymptotic behavior of the Whittaker functions

ei/.WhittakerW[kp_,s_,tau_]:>0/.WhittakerV[kp_,s_,tau_]:>tau^(-kp)Exp[tau/2]/.(Abs[ell] (t^2))^ee_:>(Abs[ell])^ee t^(2ee)//Simplify
Simplify[E^(-Pi Abs[ell] t^2)%]/.(t^2)^ee_:>t^(2ee)//Simplify

This shows that the coefficients cum and cup vanish.

ei/.{cum->0,cup->0}/.WhittakerW[kp_,s_,tau_]:>tau^kp Exp[-tau/2]/.((t^2))^ee_:>t^(2ee)//Simplify

This shows that the coefficient cop and cup vanish as well.

The conclusion is that the determining coefficients of (SuperPlus[F])and (SuperMinus[F])are zero, which completes the proof in this case.

23 Comparison of M with W and V

Computations for Proposition 4.33

23a. Basis quantity, part i)a)

Clear[m0sub]
m0sub[jj_]:={m0[j_]:>m0[jj]-(eps/3)(j-jj)}

Clear[bq]
bq[j_,nu_]:=2m0[j]+eps j-nu

Check non-negativity if (Subscript[m, 0])[(Subscript[j, r])]≥0 and ε=1

bq[jr,nur]/.eps->1
bq[jp,nup]/.m0sub[jr]//.sub2r/.eps->1//Simplify
bq[jl,nul]/.m0sub[jr]/.sub2p/.sub2r/.eps->1//Simplify

Check non-negativity if (Subscript[m, 0])[(Subscript[j, l])]≥0 and ε=-1

bq[jl,nul]/.eps->-1
bq[jp,nup]/.m0sub[jl]//.sub2l/.eps->-1//Simplify
bq[jr,nur]/.m0sub[jl]//.sub2p/.sub2l/.eps->-1//Simplify

23b. Parts i)b) and i)c)

Part i)b), with ε=1

2jl+3a==2jr-3a/.a->(nul-jl)/2//.sub2p//Simplify

2jp+3a==2jr-3a/.a->(nup-jp)/2//.sub2p//Simplify

Part i)c)
Now ε=-1.

2jr-3a==2jl+3a/.a->(jr+nur)/2//.sub2p//Simplify

2jp-3a==2jl+3a/.a->(jp+nup)/2//.sub2p//Simplify

23c) Part ii)

Take ε = 1.

jl+nul≤-2-2m0[jl]/.m0sub[jp]/.eps->1//.sub2p//Simplify

So (Subscript[m, 0])((Subscript[j, l])) is the sole non-negative (Subscript[m, 0])(j).
The basis point of Sect((Subscript[j, l])) satisfies the condition in Lemma 4.15.

The highest point satisfying the condition :

Clear[b1]
jl+nul==-2-2b1//.sub2p//Simplify
Solve[%,{b1}][[1]]
2jl+3(b1+1)==2jp-3(b1+1)/.%//.sub2p//Simplify

So the highest point is one step lower than the left boundary of the sector Sector((SubPlus[j])).

Take ε =- 1.

-jr+nur≤-2-2m0[jr]/.m0sub[jp]/.eps->-1//.sub2p//Simplify

Only the sector Sect((Subscript[j, r])) to be considered,

Higest point on the left boundary of Sect((Subscript[j, r])) that satisfies the condition in iv)in Lemma 4.15.

Clear[b1]
nur-jr==-2-2b1//.sub2p//Simplify
Solve[%,{b1}][[1]]
b=b1+1/.%

2jr-3b==2jp+3b//.sub2p//Simplify

So we can go up to one step below Sect((SubPlus[j])).

24  Structure of non-abelian Fourier term modules

Table 4.12, which discusses the structure of the modules of type W.

24a. Reformulation

Computations in relation with Table 4.12 
Conditions in terms of the three values of (Subscript[m, 0])  are 
transformed in a condition for one value of (Subscript[m, 0]) and spectral parameters

Clear[m0,m0sub,eps]
m0sub[jt_]:={m0[jj_]:>Simplify[m0[jt]-(eps/3)(jj-jt)]}

These computations are carried out  after the corresponding picture is made, with use of the Lemmas 4.25 and 4.26 on the kernels of shift operators.
In the picture we observe the isomorphism types of the irrducible module(s) in (Subscript[((W^ψ)), n]).  (Actually there is always only one irreducible module.)
That determines spectral  parameters according to the assignment in Table 4.3 (isomorphism types).
The computations in 24b reformulate the relation of  one value of (Subscript[m, 0]) to the spectral parameters. These relations occur in Table 4.12.

24b. The separate cases

Three (Subscript[m, 0]) non-negative and ℓ>0

Figures 4.35 and 4.36

(Subscript[m, 0])(j)  decreasing in j

m0[jr]≥0/.m0sub[jp]/.eps->1/.sub2p//Simplify

Three (Subscript[m, 0]) non-negative and ℓ<0

Figures 4.35 and 4.36

(Subscript[m, 0])(j)  increasing in j

m0[jl]≥0/.m0sub[jp]/.eps->-1/.sub2p//Simplify

Two (Subscript[m, 0]) non-negative, ℓ>0

Figures 4.37  and 4.39

rel=(* for Figure 4.37 *) m0[jr]<0≤m0[jp]<m0[jl]/.m0sub[jl]/.eps->1/.sub2p/.sub2l//Simplify

In Figure 4.37 (right)we observe a submodule of type (SubPlus[FI])((Subscript[j, l]),-(Subscript[ν, l]))

1≤nul<-jl&&rel//Simplify

For Figure 4.39

rel= m0[jr]<0≤m0[jp]==m0[jl]/.m0sub[jl]/.eps->1/.sub2p/.sub2l//Simplify

In Figure 39 we observe a submodule that can be type FI((Subscript[j, l]),(Subscript[j, l]))  (non-tempered repr.) or FI((Subscript[j, l]),0) (limit of ahol. discr. ser.) We have 
(Subscript[j, l])=(SubPlus[j]) in this figure.

(* FI(jl,jl) *)
nul==-jl&&jl≤-1
rel&&%//Simplify

(* FI(jl,0) *)
jl≤2&&nul==0
%&&rel//Simplify

Two (Subscript[m, 0]) non-negative, ℓ<0

Figure 4.40

rel=m0[jl]<0≤m0[jp]<m0[jr]/.m0sub[jr]/.eps->-1/.sub2p/.sub2r//Simplify

We observe a submodule of type (SubPlus[I])((Subscript[j, r]),(Subscript[ν, r]))

1≤nur<jr&&rel//Simplify

Figure 41

rel=m0[jl]<0≤m0[jp]==m0[jr]/.m0sub[jr]/.eps->-1/.sub2p/.sub2r//Simplify

Two possibilities

(* IF(jr,0) *)
nur==0&&jr≥2&&rel//Simplify

(* IF(jr,-jr) *)
nur==jr&&jr≥1&&rel//Simplify
%/.nur->jr//Simplify

One (Subscript[m, 0]) non-negative, ℓ>0

Figure 4.42

rel=m0[jr]<m0[jp]<0≤m0[jl]/.m0sub[jl]/.eps->1/.sub2p/.sub2l//Simplify

We observe  type FI((Subscript[j, l]),(Subscript[ν, l]))

1≤nul<-jl&&rel//Simplify

Figure 4.44

rel=m0[jr]==m0[jp]<0≤m0[jl]/.m0sub[jl]/.eps->1/.sub2p/.sub2l//Simplify

Two possibilities

(* FI((Subscript[j, l]),0) *)
jl≤-1&&nul==0
%&&rel//FullSimplify

(* FI((Subscript[j, l]),(Subscript[j, l])) *)
jl≤-1&&nul==-jl&&rel//Simplify

One (Subscript[m, 0]) non-negative, ℓ<0

Figure 4.45

rel=m0[jl]<m0[jp]<0≤m0[jr]/.m0sub[jr]/.eps->-1/.sub2p/.sub2r//Simplify

Type IF (jr, nur)

Figure 4.46

rel=m0[jl]==m0[jp]<0≤m0[jr]/.m0sub[jr]/.eps->-1/.sub2p/.sub2r//Simplify

(* IF((Subscript[j, r]),0) *)
jr≥2&&nur==0&&rel//FullSimplify

(* IF((Subscript[j, r]),-(Subscript[j, r])) *)
jr≥1&&nur==-jr&&rel//Simplify

25 Sesquilinear forms and unitarity

Computations for section 4.5

Preparation

Definition of c  in (4.91).

Clear[c,j,nu]
c[p_,r_,nu_]=Gamma[1+(j-nu+p+r)/2]Gamma[1+(-j-nu+p-r)/2]Gamma[1+(j+nu+p+r)/2]^(-1)Gamma[1+(-j+nu+p-r)/2]^(-1);

The function c determines an invariant form. The question is whether it, or a holomorphic multiple of it,  is positive definite on submodules, in which the K-types are (Subscript[((τ^h)), p])  with h = (Subscript[h, 0])+ 3 (a - b) and p =(Subscript[p, 0])+a+b.

Clear[a,b,h,p,r,h0,r0,p0,lsub0,lsub]
lsub0[h0_,p0_]={h->h0+3(a-b),p->p0+a+b,r->(h-2j)/3};
lsub[h0_,p0_]:=Union[lsub0[h0,p0],{Gamma[aa_]:>Factorial[aa-1]}];

Clear[gamsub]
gamsub[xx_]:=Gamma[xx]->Pi Gamma[1-xx]^(-1)Sin[Pi xx]^(-1)

25a. Type (SubPlus[II])

c[p,r,nu]//.lsub[-j,nu]//Simplify

This is the result in (4.29).

25b. Comparison of Tables 4.3 and 4.14

IF(jr,nur)

{2jr,0,Infinity,nul-1}=={2jr,0,Infinity,(jr-nur)/2-1}/.sub2p//Simplify

IF(jr,0)

{2jr,0,Infinity,nul-1}=={2jr,0,Infinity,(jr/2)-1}/.sub2p/.sub2r/.nur->0//Simplify

IF(jr,-jr)

{2jr,0,Infinity,jr-1}=={2jr,0,Infinity,jr-1}

(SubPlus[IF])(jr,-nur)

{-jl,nul,Infinity,nur-1}=={(jr+3nur)/2,(jr-nur)/2,Infinity,nur-1}/.sub2p/.sub2r//Simplify

FI(jl,nul)

{2jl,0,nur-1,Infinity}=={2jl,0,-(jl+nul)/2-1,Infinity}/.sub2p//Simplify

FI(jl,0)

{2jl,0,nur-1,Infinity}=={2jl,0,-(jl/2)-1,Infinity}/.sub2p/.sub2l/.nul->0//Simplify

FI(jl,jl)

{2jl,0,Abs[jl]-1,Infinity}=={2jl,0,-jl-1,Infinity}/.Abs[jl]->-jl

(SubPlus[FI])(jl,-nul)

{-jr,nur,nul-1,Infinity}=={(-3nul+jl)/2,-(nul+jl)/2,nul-1,Infinity}/.sub2p//Simplify

25c. Types IF and FI

See §4.5.3.2

Clear[gamsub,A,B]
gamsub[zz_]:={Gamma[zz]->Pi Gamma[1-zz]^(-1)Sin[Pi zz]^(-1)};

Case a

ca[p_,r_,nua_]=Sin[Pi(nua+j)/2]Sin[Pi(nua-j)/2]^(-1)c[p,r,nua]/.gamsub[1+(1/2) (-nua+p-r-j)]/.gamsub[1+(1/2) (nua+p-r-j)]//.{Csc[π (1+(1/2) (-j-nua+p-r))]->Csc[π ((1/2) (-j-nua))](-1)^(1+(p-r)/2),Sin[π (1+(1/2) (-j+nua+p-r))]->Sin[π (1+(1/2) (-j+nua))](-1)^(1+(p-r)/2),Sin[(1+(1/2) (-j+nua)) π]->-Sin[((1/2) (-j+nua)) π],Csc[(1/2) (-j-nua) π]->- Csc[(1/2) (j+nua) π]}//Simplify

ca[p,r,nu]//.lsub[2j,0]/.(-1)^(2b)->1//Simplify
%/.{j->2B+nu+2}//Simplify

Case c

Clear[cc]
cc[p_,r_,nua_]=Sin[Pi(j-nua)/2]^(-1)c[p,r,nua]/.gamsub[1+(1/2) (nua+p-r-j)]/.Sin[π (1+(1/2) (nua+p-r-j))]->(-1)^((p-r)/2)Sin[Pi(j-nua)/2]

cc[p,r,-nu]//.lsub[(j+3nu)/2,(j-nu)/2]//Simplify
%/.I^(2b+ee_):>(-1)^b I^ee/.nu->B+1//Simplify

This gives a posidefinite form if B=0, hence ν=1.

Can there be a positive definite sesquilinear form if ν≥2?

ph0=phi[h0,p0,r0,p0,-nu]
ph1=phi[h0-3,p0+1,r0-1,p0+1,-nu]

qup=sh[-3,1,ph0,subtriv]/ph1//Simplify
qdn=sh[3,-1,ph1,subtriv]/ph0//Simplify

qup qdn/.r0->(h0-2j)/3/.{h0->(j+3nu)/2,p0->(j-nu)/2}//Factor
%/.j->nu+pos+2//Simplify

Positive if ν >= 2.
Then the sum cannot be zero.

Case d

cd[p_,r_,nua_]=Sin[Pi(nua-j)]^(-1)c[p,r,nua]/.gamsub[1+(1/2) (nua+p-r-j)]/.Sin[π (1+(1/2) (nua+p-r-j))]->(-1)^((p-r)/2)Sin[Pi(-nua+j)]//Simplify

cd[p,r,-j]//.lsub[2j,0]/.nu->j/.j->B+1/.I^(2b)->(-1)^b//Simplify

The factorials are defined. The factor (((-1))^b)prohibits positive definite, unless B=1, hence ν=1

Can there be a positive definite sesquilinear form if ν≥2?

ph0=phi[h0,p0,r0,p0,-j]
ph1=phi[h0-3,p0+1,r0-1,p0+1,-j]

qup=sh[-3,1,ph0,subtriv]/ph1//Simplify
qdn=sh[3,-1,ph1,subtriv]/ph0//Simplify

qup qdn/.r0->(h0-2j)/3/.{h0->2j,p0->0}//Factor

This is positive if j=j ≥ 2. Hence no positive definite form.

Case e

Clear[ce]
ce[p_,r_,nua_]=Sin[Pi(j-nua)/2]Sin[Pi(j+nua)/2]^(-1)c[p,r,nua]/.gamsub[1+(1/2) (nua+p+r+j)]/.gamsub[1+(1/2) (-nua+p+r+j)]/.Csc[π (1+(1/2) (-nua+p+r+j))] ->Csc[π ((1/2) (-nua+j))] (-1)^(1+(p+r)/2)/.Sin[π (1+(1/2) (nua+p+r+j))]->Sin[π ((1/2) (nua+j))](-1)^(1+(p+r)/2)//Simplify

(ce[p,r,nu]//.lsub[2j,0]//Simplify)/.(-1)^(2a)->1/.j->-2A-nu-2//Simplify

This is positive as long as a≤-(nu+j)/2-1

Case g

Clear[cg]
cg[p_,r_,nua_]=Sin[Pi(nua+j)/2]^(-1)c[p,r,nua]/.gamsub[1+(1/2) (nua+p+r+j)]/.Sin[π (1+(1/2) (nua+p+r+j))]->-(-1)^((p+r)/2)Sin[Pi(nua+j)/2]//Simplify

cg[p,r,-nu] //.lsub[(j-3nu)/2,-(j+nu)/2]//Simplify
%/.(I^(2 a-nu-j))->(-1)^a I^(-nu-j)//.{nu->A+1,j->-(nu+2+pos)}//Simplify

If A=ν-1 ≥1, then the sign changes make the form indefinite. For ν=1, we get a multiple of a positive definite form.

Can there be a positive definite sesquilinear form if ν≥2?

ph0=phi[h0,p0,r0,p0,-nu]
ph1=phi[h0+3,p0+1,r0+1,p0+1,-nu]

qup=sh[3,1,ph0,subtriv]/ph1//Simplify
qdn=sh[-3,-1,ph1,subtriv]/ph0//Simplify

Check from the definitions that these shift operators are conjugate.

qup qdn/.r0->(h0-2j)/3/.{h0->(j-3nu)/2,p0->-(j+nu)/2}//Factor
%/.j->-(nu+2+pos)//Simplify

Positive if ν ≥ 2

Case h

Clear[ch]
ch[p_,r_,nua_]=Sin[Pi(nua+j)/2]^(-1)c[p,r,nua]/.gamsub[1+(1/2) (nua+p+r+j)]/.Sin[π (1+(1/2) (nua+p+r+j))]->-(-1)^((p+r)/2)Sin[Pi(nua+j)/2]

ch[p,r,j]//.lsub[2j,0]/.I^(2a)->(-1)^a/.j->-A-1//Simplify

The sesquilinear form is positive definite only if ν=-1

Can there be a positive definite sesquilinear form if ν≥2?

ph0=phi[h0,p0,r0,p0,j]
ph1=phi[h0+3,p0+1,r0+1,p0+1,j]

qup=sh[3,1,ph0,subtriv]/ph1//Simplify
qdn=sh[-3,-1,ph1,subtriv]/ph0//Simplify

qup qdn/.r0->(h0-2j)/3/.{h0->2j,p0->0}/.j->-Abs[j]//Factor

Positive if  j <-1

25d. Type FF

See §4.5.3.3

Clear[cff]
cff[p_,r_,nua_]=Sin[Pi(nua+j)/2]^(-1)Sin[Pi(nua-j)/2]^(-1)c[p,r,nua]/.gamsub[1+(1/2) (nua+p+r+j)]/.gamsub[1+(1/2) (nua+p-r-j)]/.Sin[π (1+(1/2) (nua+p+r+j))]->Sin[π ((1/2) (nua+j))](-1)^(1+(p+r)/2)/.Sin[π (1+(1/2) (nua+p-r-j))]->Sin[π ((1/2) (nua-j))](-1)^(1+(p-r)/2)//Simplify

cff[p,r,-nu]//.lsub[2j,0]//Simplify
%/.(I^(2 (a+b)))->(-1)^(a+b)//Simplify

Chapter 5 with Sections 26-27

26 Holomorphic automorphic forms

26a. Checks for Proposition 5.6

Factor of automorphy

UT=2^(-1/2){{1,0,-I},{0,2,0},{1,0,I}};
(* in (2.9) *)

Clear[h,jf]
jf[g_List,{z_,u_}]:=Module[{m},m=Inverse[UT].g.UT;
m[[3,1]]z+m[[3,2]]u+m[[3,3]]//Simplify]

Clear[ma,a,b]
ma[x_]:=Table[x[i,j],{i,1,3},{j,1,3}]

jf[ma[a],actX[ma[b],{z,u}]]jf[ma[b],{z,u}]==jf[ma[a].ma[b],{z,u}]

So j in (5.15) is a factor of automorphy .

Transformation behavior

We want to check that if F↦(Subscript[F, 1]) corresponds to f↦ (Subscript[f, 1])=L(g)g then

Use that

actX[nm[x,y,r],{I,0}]

First some substitutions

Clear[f,f1,F,F1,fsub,z,u,tau,zsub]
fsub[f_,F_]:={f[ns[xx_,yy_,rr_]**as[tt_]]:>tt^(-h/2)F[actX[nm[xx,yy,rr].am[tt],{I,0}]]}
sub1={x->Im[u],y->Re[u],r->Re[z]/2,t->tau^(1/2)};
sub2={Re[zz_]:>(zz+Conjugate[zz])/2,Im[zz_]:>(zz-Conjugate[zz])/(2I),u Conjugate[u]->Im[z]-tau,(pp_ qq_)^ee_:>pp^ee qq^ee,(pp_^ff_)^ee_:>pp^(ff ee)};
zsub[xx_]:=Simplify[xx/.sub1//.sub2]/.u Conjugate[u]->(z-Conjugate[z])/(2I)-tau//Simplify

sub1 is based on the following formula

actX[nm[x,y,r].am[t],{I,0}]

Check for g ∈ N

rel=f[ns[x1,y1,r1]**ns[x,y,r]**as[t]]==f1[ns[x,y,r]**as[t]]//.Gsub/.fsub[f,F]/.fsub[f1,F1]//zsub//Simplify

actX[nm[x1,y1,r1],{z,u}]//Simplify
jf[nm[x1,y1,r1],{z,u}]

Check for g ∈ A

rel=f[as[t1]**ns[x,y,r]**as[t]]==f1[ns[x,y,r]**as[t]]//.Gsub/.fsub[f,F]/.fsub[f1,F1]//zsub//Simplify;
%/.Conjugate[t1]->t1

actX[am[t1],{z,u}]
jf[am[t1],{z,u}]

Check for m ∈ M

rel=f[ms[zt]**ns[b,r]**as[t]]==f1[ns[b,r]**as[t]]//.Gsub/.f[gg_**ms[zt]]:>zt^h f[gg]

rel/.ns[b_,r_]:>ns[Re[b],Im[b],r]/.fsub[f,F]/.fsub[f1,F1]//Simplify
%//.{I ((Im[b (zt^3)])^2)+I ((Re[b (zt^3)])^2)->I(x^2+y^2),Im[bb_]+I Re[bb_]:>I Conjugate[bb],Conjugate[zt]->zt^(-1),I ((Im[b])^2)+I ((Re[b])^2)->I(x^2+y^2),Conjugate[b]->x-I y}//zsub
actX[mm[zt],{u,z}]
jf[mm[zt],{z,u}]

Check for w

Clear[dd]
f[ws**ns[b,r]**as[t]]==f1[ns[b,r]**as[t]]/.ws**ns[b,r]**as[t]->ns[bb,rr]**as[tt]**kk//Simplify
rel=%/.f[gg_**kk]:>f[gg] Conjugate[dd]^(h/2)Abs[dd]^(-h/2)/.{bb->b/dd,rr->-r/Abs[d]^2,tt->t/Abs[dd]}//Simplify

rel1=rel/.ns[b,r]->ns[Re[b],Im[b],r]/.ns[(b/dd),-(r/((Abs[d])^2))]->ns[Re[b/dd],Im[b/dd],-r/Abs[dd]^2]/.fsub[f,F]/.fsub[f1,F1]/.Im[xx_]+I Re[xx_]:>I Conjugate[xx]/.((Im[(b/dd)])^2)+((Re[(b/dd)])^2)->Abs[b]^2/Abs[dd]^2//Simplify

2I r+t^2+x^2+y^2//zsub

rel1//.{2I r + t^2+Abs[b]^2->I Conjugate[z],dd->I Conjugate[z],2 r+I (t^2)+I ((Im[b])^2)+I ((Re[b])^2)->I Conjugate[dd],b->x+I y}//Simplify
rel2=%/.Abs[z]^(-2)->z^(-1)Conjugate[z]^(-1)/.Conjugate[xi_]:>xi/.y->u-I x//Simplify

rel2
jf[wm,{z,u}]^(h/2)
actX[wm,{z,u}]

Differentiation

ff=f[ns[x,y,r]**as[t]]Phi[h,0,0,0]/.fsub[f,F]/.F[{z_,u_}]->F[z,u,Conjugate[z],Conjugate[u]]/.Conjugate[xx_]:>xx

Substitution rule

Clear[subNA]
subNA[xx_]:=xx/.{Rna[HHr,ff_]:>t D[ff,t],Rna[XX1,ff_]:>t D[ff,x]-t y D[ff,r],Rna[XX2,ff_]:>t D[ff,y]+t x D[ff,r],Rna[XX0,ff_]:>(t^2/2)D[ff,r]}//Simplify

eR[Z31,ff,subNA]/.sub1//.{Im[u]^2->Abs[u]^2-Re[u]^2,tau->Im[z]-Abs[u]^2,Re[zz_]+I Im[zz_]:>zz,Re[zz_]-I Im[zz_]:>Conjugate[zz]}//Simplify;
z31f=%/.Im[z]->tau+Abs[u]^2//Simplify

Coefficient[z31f,Phi[h+3,1,1,1]]//Simplify

Coefficient[z31f,Phi[h+3,1,-1,1]]//Simplify

So the antiholomorphic derivatives vanish .

26b. Spectral parameters of holomorphic automorphic forms

Start with a holomorphic function F and construct the corresponding function on G

Clear[F]
f[ns[x,y,r]**as[t_]]=t^(-h/2)F[actX[nm[x,y,r].am[t],{I,0}]]/.F[{z_,u_}]:>F[z,u]
ff=% Phi[h,0,0,0]

Eigenvalues of generators of ZU(g)

l2=eR[CasXW,ff,subNA]/ff
l3=eR[Dt3Z,ff,subNA]/ff//Factor

{ld2[-h-3,1]==l2,ld3[-h-3,1]==l3}//Simplify

This confirsm the spectral parameters mentioned in the proposition

26c. Fourier terms

We check the transition from (5.19) to (5.20) .
We use the following spectral parameters:

{j,nu}=S2[S1[{-h-3,1}]]

Fourier term of order 0 is multiple of the function in (3.77).
Take g=n(x,y,r)a(t)

Clear[h,x,y,r,t,k,g,F0,f0]
g=nm[x,y,r].am[t];gs=ns[x,y,r]**as[t]

F0[actX[g,{I,0}]]==t^(h/2)f0[gs]
%/.f0[ns[x,y,r]**as[t]]->t^(2+nu)//zsub

For the Fourier term of order (ell, c, d) we use (3.88)

Clear[Fl,fl]
rel=Fl[actX[g,{I,0}]]==t^(h/2)fl[gs]

rel1=rel/.fl[n_**as[t]]->Theta[ell,c,hlm0,n]t WhittakerW[kap,nu/2,2Pi Abs[ell]t^2]/.kap->-m0-(eps j +1)/2/.Abs[ell]->ell/.eps->1/.m0->0//.Whrel//.{(pp_^ff_)^ee_:>pp^(ff ee),(pp_ qq_)^ee_:>pp^ee qq^ee}//Simplify

Clear[k,sum]
rel2=rel1/.{Theta[ell_,c_,hlm0_,ns[x,y,r]]->sum[k]Exp[2Pi I ell(r-x(c/ell+2k+y))]hlm0[c/(2ell)+k+y]}/.{hlm0[xi_]:>Sqrt[2]ell^(1/4)E^(-2Pi ell xi^2)}//Simplify

Simplify[zsub[rel2]]
rel3=%/.E^xx_:>E^(Expand[xx])//Simplify

Comparison with (5.20)

rel3 /.Fl[{z,u}]->ell^(-1/4) E^(Pi I ell z) Pi^(-1/2)(2Pi ell)^(-h/4)E^(Pi(ell/2)(c/ell+2k)^2)E^(-Pi ell(u+c/ell+2k)^2)sum[k]//Simplify

27 General lattices

27a. Reduction to a lattice (Subscript[Λ, τ,σ])

Section 5.4.1

Let om1, om2 be an Z-basis of a lattice in C, and let n[om1,rho1], n[om2,rho2] and n[0,rho3] generate a lattice in N

Clear[om1,om2,rho1,rho2,rho3]
nu1=ns[om1,rho1]
nu2=ns[om2,rho2]
nu3=ns[0,rho3]

Commutator (in the center of the lattice)

nu1**nu2**iv[nu1]**iv[nu2]//.Gsub
%/.Im[om2 Conjugate[om2]]->0/.Im[om1 Conjugate[om1+om2]]->Im[om1 Conjugate[om2]]

ns[a,0]**nu1**iv[ns[a,0]]//.Gsub/.Im[a Conjugate[a+om1]]->Im[a Conjugate[om1]]
ns[a,0]**nu2**iv[ns[a,0]]//.Gsub/.Im[a Conjugate[a+om2]]->Im[a Conjugate[om2]]
ns[a,0]**nu3**iv[ns[a,0]]//.Gsub

There exists a in C such that we get new a lattice with generators

mu1=ns[om1,0]
mu2=ns[om2,0]
mu3=ns[0,rho3]

We take tau = om1/om2. By changing the order if necessary we arrange that Im[tau]>0

mu1a=mu1/.om1->tau om2
mu2a=mu2
nu3a=mu3

Conjugate with element of M

mu1a=ms[zt]**mu1**iv[ms[zt]]//.Gsub/.om1->tau om2
mu2a=ms[zt]**mu2**iv[ms[zt]]//.Gsub
mu3a=ms[zt]**mu3**iv[ms[zt]]//.Gsub

Take zt with |zt|=1 and t>0 such that om3 (zt^3) t = (Im tau)^(-1/2)

mu2b=as[t]**mu2a**iv[as[t]]//.Gsub/.om2 zt^3->t^(-1)Im[tau]^(-1/2)
mu1b=as[t]**mu1a**iv[as[t]]//.Gsub/.om2 zt^3->t^(-1)Im[tau]^(-1/2)
mu3b=as[t]**mu3a**iv[as[t]]//.Gsub/.om2 zt^3->t^(-1)Im[tau]^(-1/2)

The commutator of mu1b and mu2b

mu1b**mu2b**iv[mu1b]**iv[mu2b]//.Gsub//Simplify
%/.{Conjugate[(1/(Sqrt[Im[tau]]))]->(1/(Sqrt[Im[tau]]))}/.{Conjugate[(tau/(Sqrt[Im[tau]]))]->Conjugate[tau]/Sqrt[Im[tau]],Im[pp_/Im[tau]]->Im[pp]/Im[tau]}/.{Im[tau (1+Conjugate[tau])]->Im[tau]}/.Im[((Conjugate[tau])/(Im[tau]))]->-1//Simplify

If rho3 t^2 is in 2Z, we can drop the generator mu3b.
Otherwise 2 should be a multiple of rho3 t^2, cince the center is of the form { n[0,r]} with r running thoug a discrete subgroup of R.

27b. Isomorphism (Subscript[A, τ]) and unitary isomorphism (Subscript[U, τ])

The unitary operator U_tau  in Proposition 5.17

Clear[Ump,ivUmp,xi]
Ump[ell_,tau_,ph_]:=Im[tau]^(1/4)(ph/.xi->xi Sqrt[Im[tau]])E^(-2Pi I ell Re[tau]xi^2)//Simplify
ivUmp[ell_,tau_,ph_]:=Im[tau]^(-1/4)(ph/.xi-> xi/Sqrt[Im[tau]])E^( 2Pi I ell Re[tau]xi^2/Im[tau])//Simplify

Checks

Ump[ell,tau,phi[xi]]
ivUmp[ell,tau,%]

phi[xi]
ivUmp[ell,tau,%]
Ump[ell,tau,%]

The isomorphism (Subscript[A, tau]) in (5.36)

Clear[Ald]
Ald[tau_,ns[x_,y_,r_]]:=ns[(  x Im[tau]-  y Re[tau] )/Sqrt[Im[tau]], y  /Sqrt[Im[tau]],r]

The Schrödinger representation

Clear[pi,xi]
pi[ld_,ns[x_,y_,r_],ph_]:=E^(I ld(r-2xi x-y x))(ph/.xi->xi+y)

Relation

pi[2Pi ell,Ald[tau,ns[x,y,r]],Ump[ell,tau,phi[xi]]]==Ump[ell,tau,pi[2Pi ell, ns[x,y,r],phi[xi]]]//Simplify

Ald[I,ns[1,0,0]]
Ald[I,ns[0,1,0]]

Ald[tau,ns[1/Sqrt[Im[tau]],0,0]]
Ald[tau,ns[Re[tau]/Sqrt[Im[tau]],Sqrt[Im[tau]],0]]

27c. Holomorphic Fourier terms for general lattice

Computations for (5.45)

Now we have to deal with

fl0=Thetatau[ell,c,hlm0,ns[x,y,r]]t WhittakerW[kap,nu/2,2Pi Abs[ell]t^2]/.kap->-m0-(eps j +1)/2/.Abs[ell]->ell/.eps->1/.m0->0//.Whrel//Simplify

Use of (5.38)

Theta[ell,c,U[hlm0],Ald[tau,ns[x,y,r]]]
thetagen=%/.{Theta[ell,c,ph_,ns[x_,y_,r_]]:>sum[k]Exp[2Pi I ell(r-x(c/ell+2k+y))]ph[c/(2ell)+k+y]}/.{U[hlm0][xi_]:>Im[tau]^(1/4)E^(-2Pi I ell  xi^2 Re[tau])hlm0[xi Im[tau]^(1/2)]}/.{hlm0[xi_]:>Sqrt[2]ell^(1/4)E^(-2Pi ell xi^2)}//Simplify

Insertion of the general theta function, and transition to coordinates on X.

Clear[retau,imtau]
fl0/.Thetatau[ell,c,hlm0,ns[x,y,r]]->thetagen/.(ell (t^2))^ee_:>ell^ee t^(2ee)//Simplify
rel={Fl0[actX[nm[x,y,r].am[t],{I,0}]],t^(h/2)%}/.{x->Im[u],y->Re[u],r->Re[z]/2,t^2->Im[z]-u Conjugate[u]}/.{Im[tau]->imtau,Re[tau]->retau}//.{Re[zz_]:>(zz+Conjugate[zz])/2,Im[zz_]:>(zz-Conjugate[zz])/(2I)}//Simplify

Shift of the summation variable

Clear[al]
rel1=rel/.{retau->Re[tau],imtau->Im[tau]}/.k->al-c/(2ell)/.sum[al-(c/(2 ell))]->summod[al,c/(2ell)]/.E^xx_:>E^Expand[FullSimplify[xx]]

Comparison

rel1[[2]]==(Im[tau])^(1/4)Pi^(-1/2)ell^(-1/4)(2Pi ell)^(-h/4)E^(-Pi ell u^2)E^(Pi I ell z)summod[al,c/(2ell)]E^(-2Pi ell al^2 Im[tau]-2Pi I ell Re[tau]al^2-4Pi ell u al Sqrt[Im[tau]])//Simplify

Appendix

A1 Modified Bessel functions

Appendix A1

The functions (Subscript[I, ν])and (Subscript[K, ν]) are know to Mathematica, as BesselI and BesselK.

To direct Mathematica in the simplification of expression with use of the contiguous relations the following macros are useful.

Clear[Besselup,Besseldn]
Besselup[n_]:={BesselI[n,x_]:>Simplify[(2 (n+1)/x)BesselI[n+1,x]+BesselI[n+2,x]],
BesselK[n,x_]:>Simplify[-(2 (n+1)/x)BesselK[n+1,x]+BesselK[n+2,x]]};
Besseldn[n_]:={BesselI[n,x_]:>Simplify[(-2(n-1)/x)BesselI[n-1,x]+BesselI[n-2,x]],BesselK[n,x_]:>Simplify[(2(n-1)/x)BesselK[n-1,x]+BesselK[n-2,x]]};

Check of relations

rel={BesselK[nu-1,x]-BesselK[nu+1,x]==-2 nu x^(-1)BesselK[nu,x],BesselI[nu-1,x]-BesselI[nu+1,x]==2 nu x^(-1)BesselI[nu,x]};
rel/.Besselup[nu-1]//Simplify
rel/.Besseldn[nu+1]//Simplify

A2 Whittaker functions

Appendix A2

A2a. Definition of the V-Whittaker function, and various relations

We define (Subscript[V, κ,s]) as a linear combination of M-Whittaker functions. The substitution rule Whsub expresses both (Subscript[V, κ,s]) and (Subscript[W, κ,s]) as a linear combination of (Subscript[M, κ,s]) and (Subscript[M, κ,-s ]) (meromorphic in s).

Clear[WhittakerV,vvw,vvv]
vvw[kp_,s_]=(-Pi)(Sin[2Pi s])^(-1)Gamma[1/2-s-kp]^(-1)Gamma[1+2s]^(-1);
vvv[kp_,s_]=Pi I Sin[2Pi s]^(-1)E^(Pi I s)Gamma[1/2-s+kp]^(-1)Gamma[1+2s]^(-1);

Clear[Whsub]
Whsub:={WhittakerW[kp_,s_,tau_]:>vvw[kp,s]WhittakerM[kp,s,tau]+vvw[kp,-s]WhittakerM[kp,-s,tau],WhittakerV[kp_,s_,tau_]:>vvv[kp,s]WhittakerM[kp,s,tau]+vvv[kp,-s]WhittakerM[kp,-s,tau]}

Check of the expression of (Subscript[M, κ,s]) in the W- and V-Whittaker functions

relMWV=WhittakerM[kap,s,tau]==E^(Pi I kap)Gamma[2s+1]( -I E^(-Pi I s)Gamma[1/2+s+kap]^(-1)WhittakerW[kap,s,tau]-Gamma[1/2+s-kap]^(-1)WhittakerV[kap,s,tau])

Mathematica needs more help

Clear[gmsub]
gmsub[xx_]:={Gamma[1/2+xx]->Pi Gamma[1/2-xx]^(-1)Cos[Pi xx]^(-1)};
relMWV//.Whsub//Simplify
%/.gmsub[kap-s]/.gmsub[kap+s]//Simplify

A2b Exponential behavior

Some check, trusting that Mathematica has it right.

Clear[kap,s,tau]
tau^(-kap)E^(tau/2)WhittakerW[kap,s,tau]
Series[%,{tau,Infinity,2}]

-E^(Pi I kap)tau^kap E^(-tau/2)WhittakerV[kap,s,tau]/.Whsub
Series[%,{tau,Infinity,2}]//FullSimplify

A2c. Specializations

Check of the relation between (Subscript[M, κ,s])  and (Subscript[W, κ,s])

WhittakerM[kap,kap-1/2,tau]E^(tau/2)//Simplify
Series[%,{tau,0,20}]

Mathematica seems not to know this specialization

WhittakerM[kap,kap-1/2,tau]//FullSimplify

Check of relation between (Subscript[V, κ,s]) and (Subscript[M, κ,s]).

WhittakerM[kap,-kap-1/2,tau]E^(-tau/2)
Series[%,{tau,0,10}]

WhittakerV[kap,kap+1/2,tau]/WhittakerM[kap,-kap-1/2,tau]/.Whsub//FullSimplify

A2d. Contiguous and differential relations

Relations for the new function (Subscript[V, κ,s]) and the special relations

Clear[Whrel]
Whrel:={Derivative[0,0,1][WhittakerV][kp_,s_,tau_]:>(1/2-kp/tau)WhittakerV[kp,s,tau]+((kp+1/2)^2-s^2)tau^(-1)WhittakerV[kp+1,s,tau],Derivative[0,0,2][WhittakerV][kp_,s_,tau_]:>(1/4-kp/tau+(s^2-1/4)/tau^2)WhittakerV[kp,s,tau],WhittakerW[kp_,s_,tau_]/;Simplify[kp==1/2+s]:>tau^kp E^(-tau/2),WhittakerV[kp_,s_,tau_]/;Simplify[kp==-1/2+s]:>- E^(-Pi I kp)tau^(-kp) E^(tau/2)}

Substitutions for the application of contiguous relations. These are used repeatedly in the earlier sections.

Clear[Whdn,Whup,Whsup,Whsdn,Whups,Whdns]
Whdn[n_]:={WhittakerM[n,mu_,x_]:>(1/2+mu+n-1)^(-1)((1/2+mu-n+1)WhittakerM[n-2,mu,x]+(2n-2-x)WhittakerM[n-1,mu,x]),WhittakerW[n,mu_,x_]:>-((n-1-1/2)^2-mu^2)WhittakerW[n-2,mu,x]+(x-2n+2)WhittakerW[n-1,mu,x],WhittakerV[n,mu_,x_]:>(mu^2-(n-1/2)^2)^(-1)(WhittakerV[n-2,mu,x]+(x-2n+2)WhittakerV[n-1,mu,x])}
Whup[n_]:={WhittakerM[n,mu_,x_]:>(1/2+mu-n-1)^(-1)((1/2+mu+n+1)WhittakerM[n+2,mu,x]+(x-2n-2)WhittakerM[n+1,mu,x]),
WhittakerW[n,mu_,x_]:>((n+1/2)^2-mu^2)^(-1)(-WhittakerW[n+2,mu,x]+(x-2n-2)WhittakerW[n+1,mu,x]),
WhittakerV[n,mu_,x_]:>(mu-n-3/2)(mu+n+3/2)WhittakerV[n+2,mu,x]-(x-2n-2)WhittakerV[n+1,mu,x]};
Whsdn[kp_,s_]:={WhittakerW[kp,s,tau_]:>(s-(kp-1/2))WhittakerW[kp-1,s,tau]+tau^(1/2)WhittakerW[kp-1/2,s-1/2,tau],
WhittakerM[kp,s,tau_]:>(s+kp-1/2)^(-1)((kp-1/2-s)WhittakerM[kp-1,s,tau]+ 2s tau^(1/2)WhittakerM[kp-1/2,s-1/2,tau]),
WhittakerV[kp,s,tau_]:>(kp-1/2+s)^(-1)( WhittakerV[kp-1,s,tau]-I tau^(1/2)WhittakerV[kp-1/2,s-1/2,tau])
}

Whsup[kp_,s_]:={WhittakerW[kp,s,tau_]:>-(kp-1/2+s)WhittakerW[kp-1,s,tau]+tau^(1/2)WhittakerW[kp-1/2,s+1/2,tau],
WhittakerM[kp,s,tau_]:>WhittakerM[kp-1,s,tau]-(2s+1)^(-1)tau^(1/2)WhittakerM[kp-1/2,s+1/2,tau],
WhittakerV[kp,s,tau_]:>(kp-1/2-s)^(-1)(WhittakerV[kp-1,s,tau]-I tau^(1/2)WhittakerV[kp-1/2,s+1/2,tau])
}
Whdns[kp_,sp_]:={WhittakerW[kp,sp,tau_]:>tau^(-1/2)(WhittakerW[kp+1/2,sp-1/2,tau]+(kp+sp-1/2)WhittakerW[kp-1/2,sp-1/2,tau]),WhittakerV[kp,sp,tau_]:>-I(sp-1/2-kp)tau^(-1/2)(WhittakerV[kp+1/2,sp-1/2,tau]-(kp-sp+1/2)^(-1)WhittakerV[kp-1/2,sp-1/2,tau]),WhittakerM[kp,sp,tau_]:>-tau^(-1/2)(2sp)(WhittakerM[kp+1/2,sp-1/2,tau]-WhittakerM[kp-1/2,sp-1/2,tau])}
Whups[kp_,sm_]:={WhittakerW[kp,sm,tau_]:>tau^(-1/2)(WhittakerW[kp+1/2,sm+1/2,tau]-(sm+1/2-kp)WhittakerW[kp-1/2,sm+1/2,tau]),WhittakerV[kp,sm,tau_]:>I tau^(-1/2)(kp+sm+1/2)(WhittakerV[kp+1/2,sm+1/2,tau]-(sm+1/2+kp)^(-1)WhittakerV[kp-1/2,sm+1/2,tau]),
WhittakerM[kp,sm,tau_]:>(2sm+1)^(-1)tau^(-1/2)((sm+1/2+kp)WhittakerM[kp+1/2,sm+1/2,tau]-(kp-sm-1/2)WhittakerM[kp-1/2,sm+1/2,tau])
}

Checks

Some of the checks take long.

tm[]:=Module[{d},d=DateList[];
Print["time ",ToString[d[[4]]],":",ToString[d[[5]]],":",ToString[d[[6]]//Floor]]]

Differentiation of the V-Whittaker function.
(Some of the checks take a lot of time if one puts the precision at a high value)

prec=10;
tm[]

WhittakerV[kp,s,tau]/.Whsub;
u1=D[%,tau]//Simplify;
u2=D[WhittakerV[kp,s,tau],tau]/.Whrel/.Whsub//Simplify;
u1==u2//FullSimplify

tm[]

Checks for derivatives of  W- and M- Whittaker functions

u1=D[WhittakerM[kp,s,tau],tau]
u2=(1/2-kp/tau)WhittakerM[kp,s,tau]+(1/2+kp+s)tau^(-1)WhittakerM[kp+1,s,tau]
u1==u2//Simplify

u1=D[WhittakerW[kp,s,tau],tau]
u2=(1/2-kp/tau)WhittakerW[kp,s,tau]-tau^(-1)WhittakerW[kp+1,s,tau]
u1==u2//Simplify

For the M-Whittaker function we carry out a check based on the series expansion.

Clear[whm,n,kp,s,tau,sum]
whm[kp_,s_,tau_]=sum[n]tau^(s+1/2)E^(-tau/2)Gamma[1/2+s-kp+n]Gamma[1/2+s-kp]^(-1)Gamma[1+2s+n]^(-1)Gamma[1+2s]Factorial[n]^(-1)tau^n;

rel=Simplify[-D[whm[kp,s,tau],tau]+(1/2-kp/tau)whm[kp,s,tau]+(1/2+kp+s)tau^(-1)whm[kp+1,s,tau]]E^(tau/2)tau^(1/2-n-s)//Simplify

rel1=Expand[rel]/.tau ff_:>Simplify[ff/.n->n-1]//Simplify;
(* case n≥1 *)
%//.{}//FullSimplify
%/.sum[n-1]->sum[n]

(* case n=0 *)
rel1/.sum[n-1]->0/.n->0

Check of routines for use of contigous relations
shifts of kp

WhittakerM[kp+1,s,tau]/.Whdn[kp+1];
%==WhittakerM[kp+1,s,tau]//FullSimplify
WhittakerM[kp-1,s,tau]/.Whup[kp-1];
%==WhittakerM[kp-1,s,tau]//FullSimplify

tm[]

WhittakerW[kp+1,s,tau]/.Whdn[kp+1];
%==WhittakerW[kp+1,s,tau]//FullSimplify
WhittakerW[kp-1,s,tau]/.Whup[kp-1];
%==WhittakerW[kp-1,s,tau];
%//FullSimplify

tm[]

WhittakerV[kp+1,s,tau]/.Whdn[kp+1]
WhittakerV[kp+1,s,tau]-%/.Whsub/.Whup[kp-1]//FullSimplify

tm[]

WhittakerV[kp-1,s,tau]/.Whup[kp-1]
WhittakerV[kp-1,s,tau]-%/.Whsub/.Whdn[kp+1]//FullSimplify

tm[]

Coupled shifts of kp and s
Sometimes explicit computation does not work. Then  we use an asymptotic expansion instead.

x=(WhittakerW[kp+1/2,s,tau] /.Whsdn[kp+1/2,s])-WhittakerW[kp+1/2,s,tau]//FullSimplify
Series[E^(tau/2)x,{tau,Infinity,prec}]//FullSimplify

tm[]

x=(WhittakerW[kp+1/2,s,tau] /.Whsup[kp+1/2,s])-WhittakerW[kp+1/2,s,tau]//FullSimplify
Series[E^(tau/2)x,{tau,Infinity,prec}]//FullSimplify

tm[]

(WhittakerM[kp+1/2,s+1/2,tau] /.Whsdn[kp+1/2,s+1/2])-WhittakerM[kp+1/2,s+1/2,tau]//FullSimplify
Series[%,{tau,0,prec}]

tm[]

(WhittakerM[kp+1/2,s-1/2,tau]/.Whsup[kp+1/2,s-1/2])-WhittakerM[kp+1/2,s-1/2,tau]//FullSimplify
Series[%,{tau,0,prec}]

tm[]

(WhittakerV[kp+1/2,s,tau] /.Whsdn[kp+1/2,s])-WhittakerV[kp+1/2,s,tau]/.Whsub//FullSimplify
Series[%,{tau,0,prec}]

tm[]

(WhittakerV[kp+1/2,s,tau] /.Whsup[kp+1/2,s])-WhittakerV[kp+1/2,s,tau]/.Whsub//FullSimplify
Series[%,{tau,0,prec}]

tm[]

D[WhittakerM[kp,s,tau],tau]==(1/2-kp /tau) WhittakerM[kp,s,tau]+ (1/2+kp+s) tau^(-1)WhittakerM[kp+1,s,tau]//FullSimplify

tm[]

(tau-2kp)WhittakerM[kp,s,tau]==-(1/2+kp+s) WhittakerM[kp+1,s,tau]+(1/2-kp+s)WhittakerM[kp-1,s,tau]/.Whup[kp-1]//Simplify

tm[]

( WhittakerW[kp,s,tau]/.Whups[kp,s])-WhittakerW[kp,s,tau]//FullSimplify
Series[E^(tau/2)%,{tau,Infinity,prec}]//FullSimplify

tm[]

( WhittakerM[kp,s,tau]/.Whups[kp,s])-WhittakerM[kp,s,tau]//FullSimplify
Series[%,{tau,0,prec}]//Simplify

tm[]

( WhittakerV[kp,s,tau]/.Whups[kp,s])-WhittakerV[kp,s,tau]//.Whsub//FullSimplify
Series[%,{tau,0,prec}]//FullSimplify

tm[]

( WhittakerW[kp,s,tau]/.Whdns[kp,s])-WhittakerW[kp,s,tau]//FullSimplify
Series[E^(tau/2)%,{tau,Infinity,prec}]//FullSimplify

tm[]

( WhittakerM[kp,s,tau]/.Whdns[kp,s])-WhittakerM[kp,s,tau]//FullSimplify
Series[%,{tau,0,prec}]//Simplify

tm[]

( WhittakerV[kp,s,tau]/.Whdns[kp,s])-WhittakerV[kp,s,tau]//.Whsub//FullSimplify
Series[%,{tau,0,prec}]//Simplify

tm[]

A2e. Checks of the definitions of (Subscript[V, κ,s]) and (Subscript[W, κ,s])

Checks for the case that s=(Subscript[s, 0])∈(Subscript[Z, ≥0]) and κ such that W, respectively V, is not proportional to M. Determination of the leading term in the asymptotic behavior at 0.

Here the common factor (e^(-τ /2))of the Whittaker functions can be ignored.
Terms of the expansion of (Subscript[M, κ,s])

Clear[term,tau]
term[kp_,s_,n_]:=tau^(s+1/2+n)Gamma[1/2+s-kp+n]Gamma[1/2+s-kp]^(-1)Gamma[1+2s+n]^(-1)Gamma[1+2s]Factorial[n]^(-1)

W-Whittaker function

Clear[kp,s]
factWp=Gamma[-2s]Gamma[1/2-s-kp]^(-1)
factWm=Gamma[2s]Gamma[1/2+s-kp]^(-1)
Clear[gamsub]
gamsub[xx_]:=Gamma[xx]->Pi Gamma[1-xx]^(-1)Sin[Pi xx]^(-1)

For W we  work with the assumption that (Subscript[s, 0])- κ=(Subscript[p, 0])-1/2 with a positive integer (Subscript[p, 0]).

First terms

The terms with order 0≤m<2(Subscript[s, 0])  should give holomorphic conditions in s by themselves.

Clear[eta]
factWm term[kp,-s,m]//.{gamsub[1+m-2s],gamsub[1-2s],Sin[π (1+m-2 s)]->(-1)^m Sin[π (1-2 s)]}

wlw=%/.s->s0+eta//.{Sin[π (1+m-2 (eta+s0))]->Sin[-2Pi eta](-1)^(1+m-2s0),s0-kp->p0-1/2,-kp-s0->p0-1/2-2s0}//Simplify;
Series[%,{eta,0,0}]
%/.m->0

Holomorphic in s at (Subscript[s, 0]). 
Non-zero starting term with factor (tau^((1/2)-s0))

Case s = 0

factWm term[kp,-s,m]+factWp term[kp,s,m]//.{kp->1/2-p0,Gamma[-2s]->Gamma[1-2s]/(-2s),Gamma[2s]->Gamma[1+2s]/(2s)}//Simplify
Series[%,{s,0,0}]

Holomorphic, with a logarithmic term .

Case 0 < s

factWm term[kp,-s,m+2s0]+factWp term[kp,s,m]/.Gamma[1-2s]->Gamma[-2s](-2s)//.{kp->1/2-p0}/.s->s0+eta/.gamsub[-2 (eta+s0)] //.{Csc[2 π (eta+s0)]->Csc[2Pi eta](-1)^(2s0)}//Simplify;
Series[%,{eta,0,0}]//Simplify
%/.m->0//Simplify

Holomorphic, zero if (Subscript[p, 0])<(Subscript[s, 0]).

So (Subscript[W, κ,s]) is holomorphic and even in s.
If (Subscript[s, 0])>0 it starts with (τ^( -(Subscript[s, 0])+1/2)).
If (Subscript[s, 0])=0 its main contribution at zero is logarithmic.

V-Whittaker function

factVp=I E^(Pi I s)(Pi /Sin[2Pi s])Gamma[1/2-s+kp]^(-1)Gamma[1+2s]^(-1)
factVm=-I E^(-Pi I s)(Pi/Sin[2Pi s])Gamma[1/2+s+kp]^(-1)Gamma[1-2s]^(-1)

For V with (Subscript[s, 0])+κ=(Subscript[q, 0])-1/2

First terms

Take 0 <= m < 2(Subscript[s, 0])

Clear[eta]
vlw=factVm term[kp,-s,m]/.kp->-s0+q0-1/2/.s->eta+s0/.gamsub[1+m-2 (eta+s0)]/.gamsub[eta+q0]//.{Csc[2 π (eta+s0)]->(-1)^(2s0)Csc[2Pi eta],Sin[π (1+m-2 (eta+s0))]->Sin[2Pi eta](-1)^(m-2s0),Sin[π (eta+q0)]->Sin[Pi eta](-1)^q0}//Simplify

Suppose m≥(Subscript[q, 0])

Series[vlw,{eta,0,0}]

The coefficients with m  in [(Subscript[q, 0]),2(Subscript[s, 0])) are zero

Suppose m<(Subscript[q, 0])

(vlw/.gamsub[1-eta+m-q0] //.{Csc[π (1-eta+m-q0)]->Csc[Pi eta](-1)^(m-q0)}//Simplify)/.(((-1))^(2 m))->1;
Series[%,{eta,0,0}]//Simplify
%/.m->0

For 0≤m<min((Subscript[q, 0]),2(Subscript[s, 0])) 
the terms are holomorphic at (Subscript[s, 0]).
The initial term is non-zero, with (tau^((1/2)-s0))

Case (Subscript[s, 0])=0

w0=factVm term[kp,-s,m]+factVp term[kp,s,m]/.kp->q0-1/2/.gamsub[1+m-q0-s]/.gamsub[1-q0+s]/.gamsub[1+m-q0+s] /.gamsub[1-q0-s]//.{Csc[π (1+m-q0-s)] ->(-1)^(m-q0)Csc[Pi s],Sin[π (1-q0-s)]->Sin[Pi s](-1)^q0,Csc[π (1+m-q0+s)]->Csc[Pi s](-1)^(1+m-q0),Sin[π (1-q0+s)]->Sin[Pi s](-1)^(1-q0)}//Simplify;
Series[%,{s,0,0}]//Simplify;
%/.(-1)^(2q0)->1/.(-1)^(-2q0)->1
%/.m->0//Simplify

If s = 0 all terms are holomorphic at s=0. The initial term contains a non-zero multiple of (τ^(1/2))log(τ)

Terms with m≥2(Subscript[s, 0])>0

vhg=Simplify[factVm term[kp,-s,m]+factVp term[kp,s,m]/.kp->-s0+q0-1/2/.s->eta+s0 /.gamsub[1+m-2 (eta+s0)]/.gamsub[-eta+q0-2 s0]/.gamsub[1-eta-q0]]//.{Csc[2 π (eta+s0)] ->Csc[2Pi eta](-1)^(2s0),Sin[π (1+m-2 (eta+s0))]->-Sin[2Pi eta](-1)^(m-2s0),Sin[π (-eta+q0-2 s0)]->-Sin[Pi eta](-1)^(q0-2s0),Sin[π (-1+eta+q0)]->-Sin[Pi eta](-1)^q0}//Simplify

Case 1≤(Subscript[q, 0])≤2s0

Series[vhg,{eta,0,0}]//.{Gamma[1+xx_]:>Factorial[xx]}

Holomorphic, with non-zero value

Case   2 s0<(Subscript[q, 0]) ≤ m

vhg/.gamsub[-m+2 (eta+s0)]/.gamsub[1+m-2 (eta+s0)]//.{Csc[π (-m+2 (eta+s0))]->Csc[2Pi eta](-1)^(-m+2s0),Sin[π (1+m-2 (eta+s0))]->Sin[2Pi eta](-1)^(m-2s0)}//Simplify;
Series[%,{eta,0,0}]//.Gamma[1+xx_]:>Factorial[xx]//Simplify

Holomorphic and non-zero.

Case   2 s0≤m<(Subscript[q, 0])

vhg/.gamsub[1-eta+m-q0]//.{Csc[π (1-eta+m-q0)] ->Csc[Pi eta](-1)^(m-q0)}//Simplify;
(Series[%,{eta,0,0}]/.Gamma[xx_]:>Factorial[xx-1]//Simplify)/.(-1)^(2m)->1

This is also holomorphic .

The function (Subscript[V, κ,s])(τ) is holomorphic in s at all points with Re(s)≥0.
At s=0 the main term at 0 is a non-zero multiple of (τ^(1/2))logτ 
At points (Subscript[s, 0])∈(1/2)(Subscript[Z, ≥1])
the expansion starts with a multiple of (τ^(1/2-(Subscript[s, 0]))).