####################################################### ## make-win-package ETA ETALIST NULL wprog-eta-07-15-2013 13 ## Mon Jul 15 15:10:53 EDT 2013 ####################################################### ####################################################### printf("BEGIN ETA package\n"); printf("THIS VERSION DATED Mon Jul 15 15:10:53 EDT 2013 \n"); ETA:=table(); ETA[cuspmake]:=proc(N) ## Computes a set of inequivalent cusps for GAMMA_0(N) local S,SoD,c,a,lasta, SSc,lastd,gcN,d,md : SoD:=numtheory[divisors](N): SoD := SoD minus {1}: S:={0}: for c in SoD do SSc:={}: lastd:=c-1: gcN:=gcd(c,N/c): for d from 1 to lastd do md:=modp(d,gcN): if gcd(d,c)=1 and member(md,SSc)=false then S:= S union {d/c}: SSc:= SSc union {md}: fi: od: od: RETURN(S): end: ETA[cuspord]:=proc(etaprod,N,cusp) # Computes the order at a cusp of (GAMMA_0(N)) # of the given etaproduct. # local GP,ngp,S,s,ord,i,t,r,c: GP:=ETA[GPmake](etaprod): ngp:=nops(GP): ord:=0: for i from 1 to (ngp/2) do t:=GP[2*i-1]: r:=GP[2*i]: c:=denom(cusp): ord:=ord+gcd(t,c)^2/t*r/24: od: RETURN(ord): end: ETA[cuspORD]:=proc(etaprod,N,cusp) # Computes the order at a cusp of (GAMMA_0(N)) # of the given etaproduct. # RETURN(cuspord(etaprod,N,cusp)*fanwidth(cusp,N)): end: ETA[cuspORDS]:=proc(etaprod,CUSPS,N) # Computes the order at each cusp (GAMMA_0(N)) # of the given etaproduct and return result as a list. # local GP,ngp,S,s,ords,i,t,r,c, TOTORD,ORDS,cuspORDSLIST,ORD: global toterror: #for error checking cuspORDSLIST:=[]: GP:=ETA[GPmake](etaprod): ngp:=nops(GP): TOTORD:=0: if type(etaprod,constant) then cuspORDSLIST:=[seq([s,0],s in CUSPS)]: else for s in CUSPS do ords:=0: for i from 1 to (ngp/2) do t:=GP[2*i-1]: r:=GP[2*i]: c:=denom(s): ords:=ords+igcd(t,c)^2/t*r/24: od: ORD:=ords*fanwidth(s,N): cuspORDSLIST:=[op(cuspORDSLIST),[s,ORD]]: TOTORD:=TOTORD + ORD: od: fi: toterror:=TOTORD: RETURN(cuspORDSLIST): end: ETA[cuspORDSnotoo]:=proc(etaprod,CUSPS,N) # Computes the order at each cusp<> oo (GAMMA_0(N)) # of the given etaproduct and return result as a list. # local GP,ngp,S,s,ords,i,t,r,c,TOTORD,ORDS, cset,cuspORDSLIST,ORD : global toterror: #for error checking cset:=convert(CUSPS,set): if member(1/N,CUSPS) then ERROR("oo in CUSPS"); fi: cuspORDSLIST:=[]: if type(etaprod,constant) then cuspORDSLIST:=[seq([s,0],s in CUSPS)]: else GP:=ETA[GPmake](etaprod): ngp:=nops(GP): for s in CUSPS do ords:=0: for i from 1 to (ngp/2) do t:=GP[2*i-1]: r:=GP[2*i]: c:=denom(s): ords:=ords+igcd(t,c)^2/t*r/24: od: ORD:=ords*fanwidth(s,N): cuspORDSLIST:=[op(cuspORDSLIST),[s,ORD]]: od: fi: RETURN(cuspORDSLIST): end: ETA[etaCOF]:=proc(EP) RETURN(1): end: ETA[etaCONSTANT]:=proc() local epterm,cc: if nargs=0 then printf("-------------------------------------------------------------\n"); printf("etaCONSTANT(epterm) \n"); printf(" epterm = c*eta(t[1]*tau)^r[1]* ... *eta(t[s]*tau)^r[s] \n"); printf(" ie. an eta-quotient times a constant. \n"); printf(" Returns the constant c. \n"); printf(" \n"); printf("-------------------------------------------------------------\n"); elif nargs = 1 then epterm:=args[1]: if type(epterm,constant) then RETURN(epterm): else cc:=eval(subs(eta=etaCOF,epterm)): RETURN(cc): fi: else printf("nargs=%a\n",nargs); ERROR(`nargs must be 0 or 1`); fi: end: ETA[etamult]:=proc(M) # computes the etamultiplier of eta(M tau) # for a given M in SL_2(Z). local a,b,c,d,cm,dm: a:=M[1,1]: b:=M[1,2]: c:=M[2,1]: d:=M[2,2]: cm:=modp(c,2): dm:=modp(d,2): if cm=1 then ETA[jactopstar](d,c)*exp(Pi*I*((a+d)*c-b*d*(c^2-1)-3*c)/12): RETURN(%): else if dm=0 then print(` d= `, d); print(`ERROR: d is even `); fi: ETA[jacbotstar](c,d)*exp(Pi*I*((a+d)*c-b*d*(c^2-1)+3*d-3-3*c*d)/12): RETURN(%): fi: end: ETA[etanormalid]:=proc() local epcombo,K,VINF,N,j,VINF0,N0; global xprint: if not(type(xprint,boolean)) then xprint:=false: fi: if nargs=0 then printf("-------------------------------------------------------------\n"); printf("etanormalid(epcombo) \n"); printf(" Renormalizes a sum of etaprods by dividing by the term \n"); printf(" with the lowest v[oo]. \n"); printf("-------------------------------------------------------------\n"); elif nargs = 1 and type(args[1],`+`) then epcombo:=args[1]: K:=1: VINF:=vetainf(op(1,epcombo)): N:=nops(op(1,epcombo)): ## find term with smallest degree ## and smallest nops if there is a tie for j from 2 to nops(epcombo) do VINF0:=vetainf(op(j,epcombo)): N0:=nops(op(j,epcombo)): if VINF01 then print(` ERROR: M is not in SL_2(Z) `); fi: ETA[etamult](M)*( (c*N*tau+d*ee)/delta )^(1/2)*eta(ee*t/delta^2*tau): RETURN(%): end: ETA[fanwidth]:=proc(rat,N) local s,fw: s:=denom(rat): fw:=N/igcd(N,s^2): end: ETA[Ffind]:=proc(etaprod,N) # Returns 1 if etaprod is in F ie. only # negative valence at ioo = 1/N # (GAMMA_0(N)) local S,FS,find,cusp,ord: S:=ETA[cuspmake](N): FS:= S minus {1/N}: find:=1: for cusp in FS do ord:=ETA[cuspord](etaprod,N,cusp): if ord < 0 then find:=0: fi: od: RETURN(find): end: ETA[Fricke]:=proc(GP,N) #Fricke involution tau->-1/(N*tau) local NM,NGP,i,m,r: NM:=[seq(GP[2*i-1]/N,i=1..nops(GP)/2)]: NGP:=[]: for i from 1 to nops(GP)/2 do m:=GP[2*i-1]/N: r:=GP[2*i]: NGP:=[op(NGP),m,r]: od: RETURN(NGP): end: ETA[gammacheck]:=proc(GP,N) # This proc checks whether the eta-function # with generalised permutation GP is invariant under # GAMMA_0(N) (via Newman's Theorem) # Here GP=[t1,r1,t2,r2,...] # local ngp,w1,w2,w3,fail,p,c4,i,r,t,S,s,pp: global xprint: if not(type(xprint,boolean)) then xprint:=false: fi: ngp:=nops(GP): w1:=sum(GP[2*i],i=1..(ngp/2)): fail:=0: if w1=0 then if xprint then print(`Condition (1) holds`); fi: else if xprint then print(`Condition (1) does not hold`); fi: fail:=1: fi: w2:=sum(GP[2*i-1]*GP[2*i],i=1..(ngp/2)): if modp(w2,24)=0 then if xprint then print(`Condition (2) holds`); fi: else if xprint then print(`Condition (2) does not hold`); fi: fail:=1: fi: p:=product(GP[2*i-1]^abs(GP[2*i]),i=1..(ngp/2)): pp:=sqrt(p): if type(pp,integer)=true then if xprint then print(`Condition (3) holds`); fi: else if xprint then print(`Condition (3) does not hold`); fi: fail:=1: fi: c4:=1: for i from 1 to (ngp/2) do r:=GP[2*i]: t:=GP[2*i-1]: if r<>0 and modp(N,t)<>0 then c4:=0: fi: od: if c4=1 then if xprint then print(`Condition (4) holds`); fi: else if xprint then print(`Condition (4) does not hold`); fi: fail:=1: fi: w3:=sum((N/GP[2*'i'-1])*GP[2*'i'],'i'=1..(ngp/2)): if modp(w3,24)=0 then if xprint then print(`Condition (5) holds`); fi: else if xprint then print(`Condition (5) does not hold`); fi: fail:=1: fi: if fail=0 then if xprint then print(`function is invariant`); fi: RETURN(1): else if xprint then print(`function is NOT invariant`); fi: RETURN(0): fi: end: ETA[gammacheckM]:=proc(GP,N) ##gammacheckk:=proc(GP,N) # This proc checks whether the eta-function # with generalised permutation GP is invariant under # GAMMA_0(N) (via Newman's Theorem) # Here GP=[t1,r1,t2,r2,...] # local ngp,w1,w2,w3,fail,p,c4,i,r,t,S,s: ngp:=nops(GP): w1:=sum(GP[2*i],i=1..(ngp/2)): fail:=0: ## if w1=0 then ## ##print(`Condition (1) holds`); ## else ## ##print(`Condition (1) does not hold`); ## fail:=1: ## fi: w2:=sum(GP[2*i-1]*GP[2*i],i=1..(ngp/2)): if modp(w2,24)=0 then ##print(`Condition (2) holds`); else ##print(`Condition (2) does not hold`); fail:=1: fi: p:=product(GP[2*i-1]^abs(GP[2*i]),i=1..(ngp/2)): if type(eval(sqrt(p)),integer)=true then ##print(`Condition (3) holds`); else ##print(`Condition (3) does not hold`); fail:=1: fi: c4:=1: for i from 1 to (ngp/2) do r:=GP[2*i]: t:=GP[2*i-1]: if r<>0 and modp(N,t)<>0 then c4:=0: fi: od: if c4=1 then ##print(`Condition (4) holds`); else ##print(`Condition (4) does not hold`); fail:=1: fi: w3:=sum((N/GP[2*'i'-1])*GP[2*'i'],'i'=1..(ngp/2)): if modp(w3,24)=0 then ##print(`Condition (5) holds`); else ##print(`Condition (5) does not hold`); fail:=1: fi: if fail=0 then ##print(`function is invariant`); else ##print(`function is NOT invariant`); fi: RETURN(modp(fail+1,2)): end: ETA[gp2etaprod]:=proc(gp) # Converts a gen perm into an eta-product local ngp,xm,i,t,r: ngp:=nops(gp): xm:=1: for i from 1 to (ngp/2) do t:=gp[2*i-1]: r:=gp[2*i]: xm:=xm*eta(tau*t)^r: od: RETURN(xm): end: ETA[GPmake]:=proc(etaprod) # This proc finds the GP corresponding to the given etaproduct # 06/21/00: bug fix. Now works for single eta function # like eta(40*tau)^12 local L1,L1n,GP,i,r,p,t: if whattype(etaprod)=`^` then L1:=[etaprod]: else if whattype(etaprod)=function then RETURN([op(etaprod)/tau,1]); else L1:=[op(etaprod)]: fi: fi: L1n:=nops(L1): GP:=NULL: for i from 1 to L1n do r:=degree(L1[i]): if r=1 then p:=op(L1[i]): t:=p/tau: else p:=op(L1[i]): t:=op(p[1])/tau: fi: GP:=GP,t,r: od: RETURN([GP]); end: ETA[jacbotstar]:=proc(c,d) local dd,m,mm: dd:=abs(d): if c=0 then if dd=1 then RETURN(1): fi: else m:=(csgn(c)-1)/2*(csgn(d)-1)/2: mm:=(-1)^m: RETURN(mm*numtheory[jacobi](c,dd)): fi: end: ETA[jactopstar]:=proc(c,d) local dd: dd:=abs(d): if c=0 then if dd=1 then RETURN(1): fi: else RETURN(numtheory[jacobi](c,dd)): fi: end: ETA[mintotGAMMA0ORDS]:=proc() # 09/06/09: version of mintotORD2 (mintotORD2 does not work if L in an array) local nL,numORDS,L,num,N; global xprint: #05/07/10: added xprint if not(type(xprint,boolean)) then xprint:=false: fi: #L is a list [ORDS(f1), ORDS(f2), ...] #It calculates #a lower bounds for sum ORD g where g = (1 + c1 f1 + c2 f2 + ...) if nargs=0 then printf("-------------------------------------------------------------\n"); printf("mintotORDS(L,N) \n"); printf(" L is a list (or array) [[ORDS(f1), ORDS(f2), ...]. \n"); printf(" num = nops(L) (list) or dim(L) (array) \n"); printf(" This proc calculates a lower bound for sum ORD g where \n"); printf(" g = (1 + c1 f1 + c2 f2 + ...) \n"); printf(" Here sum is over cusps not equivalent to oo. \n"); printf(" (Usually) each ORDS(f) was produced by cuspORDSnotoo \n"); printf("-------------------------------------------------------------\n"); elif nargs = 2 then L:=args[1]: num:=args[2]: nL:=num: numORDS:=nops(L[1]): ## cusp oo = 1/N has been removed. ##for i from 1 to numORDS do ##print(i,seq(L[j][i][2],j=1..nL),"*",min(seq(L[j][i][2],j=1..nL))); ##od; RETURN(add(min(seq(L[j][i][2],j=1..nL)),i=1..numORDS)); else printf("nargs=%a\n",nargs); ERROR(`nargs must be 0 or 2`); fi: end: ETA[POWERPq]:=proc(a,N,M) #compute a^N to O(q^M) (where N>=0) local j,Q,Y,n,b: global xprint: j:=1: Q:=1: Y:=1: n:=N: if not(type(xprint,boolean)) then xprint:=false: fi: while n>0 do if xprint then print("n=",n); fi: if modp(n,2)=1 then b:=1: if n=N then Q:=series(a,q,M): Y:=Q: else Q:=series(Q^2,q,M): Y:=series(Q*Y,q,M): fi: else b:=0: if n=N then Q:=series(a,q,M): else Q:=series(Q^2,q,M): fi: fi: n:=trunc(n/2): od: if xprint then print("POWERPq done."); fi: RETURN(Y); end: ETA[POWERPqMODP]:=proc(a,N,M,p) #compute a^n to O(q^M) mod p #here a>=0 local j,Q,Y,n,b: j:=1: Q:=1: Y:=1: n:=N: while n>0 do print("N=",N,"n=",n); if modp(n,2)=1 then b:=1: if n=N then Q:=modp(series(a,q,M),p): Y:=Q: else Q:=modp(series(Q^2,q,M),p): Y:=modp(series(Q*Y,q,M),p): fi: else b:=0: if n=N then Q:=modp(series(a,q,M),p): else Q:=modp(series(Q^2,q,M),p): fi: fi: n:=trunc(n/2): od: RETURN(Y); end: ETA[POWERq]:=proc(a,N,M) #compute a^n to O(q^M) local mN: if N>=0 then RETURN(ETA[POWERPq](a,N,M)) else mN:=-N: RETURN(ETA[POWERPq](1/a,mN,M)) fi: end: ETA[POWERqMODP]:=proc(a,N,M,p) #compute a^n to O(q^M) mod p local mN: if N>=0 then RETURN(ETA[POWERPqMODP](a,N,M,p)) else mN:=-N: RETURN(ETA[POWERPqMODP](1/a,mN,M,p)) fi: end: ETA[printcuspords]:=proc(etaprod,N) # Computes the order at each cusp (GAMMA_0(N)) # of the given etaproduct and prints result. # local GP,ngp,S,s,ords,i,t,r,c: GP:=ETA[GPmake](etaprod): ngp:=nops(GP): S:=ETA[cuspmake](N): for s in S do ords:=0: for i from 1 to (ngp/2) do t:=GP[2*i-1]: r:=GP[2*i]: c:=denom(s): ords:=ords+gcd(t,c)^2/t*r/24: od: print(` Order at cusp `,s, ` is `,ords); od: RETURN(): end: ETA[printcuspORDS]:=proc(etaprod,N) # Computes the order at each cusp (GAMMA_0(N)) # of the given etaproduct and prints result. # local GP,ngp,S,s,ords,i,t,r,c, TOTORD,ORDS : GP:=ETA[GPmake](etaprod): ngp:=nops(GP): S:=ETA[cuspmake](N): TOTORD:=0: for s in S do ords:=0: for i from 1 to (ngp/2) do t:=GP[2*i-1]: r:=GP[2*i]: c:=denom(s): ords:=ords+gcd(t,c)^2/t*r/24: od: ORDS:=ords*fanwidth(s,N): TOTORD:=TOTORD+ORDS: print(`cusp =`,s,` order =`,ords,` ORD=`,ORDS); od: print(`TOT ORD = `,TOTORD); RETURN(): end: ETA[provemodfuncGAMMA0id]:=proc() local CW; local etaid,N,CUSPS,CUSPS1,nn,j,XX,cc,ordtmp,mftmp,num2; local num3,proofq,ff1,TT,qsj,ss; global qcheck,modfunccheck, totcheck, _ORDS,jptmp,jpqd,eptmp,gltmp: global etaPRODL,GPL,COFS,conpres,CONTERMS,mintottmp,consL,MFLB: ## ## proving jacid as a modfunc on Gamma1(N) ## global xprint: if not(type(xprint,boolean)) then xprint:=false: fi: if nargs=0 then printf("-------------------------------------------------------------\n"); printf("provemodfuncGAMMA0id(etaid,N) \n"); printf(" etaid = sum of modular functions on Gamma[0](N) \n"); printf(" Each term in the sum is a eta-quotient to base N. \n"); printf(" CUSPS = Set of inequivalent cusps for Gamma[0](N). \n"); printf(" WIDS = List of corresponding widths. \n"); printf(" global vars (can be used for error-checking): \n"); printf(" qcheck, modfunccheck, totcheck, _ORDS, jptmp, jpqd, eptmp,\n"); printf(" gltmp, EPRODL, GETAL, COFS, conpres, CONTERMS, mintottmp \n"); printf(" \n"); ## printf("** Do you want a DETAILED DESCRIPTION of this proc? (yes/no) "); ## desq:=readline(terminal); ## printf("\n"); ## if desq = "yes" then ## printf("DESCRIPTION: \n"); ## printf(" (I) We cycle through the terms of jacid. \n"); ## printf(" Let j be term number. \n"); ## printf(" (1) Test if term is a constant. \n"); ## printf(" If constant then conpres=1, j added to CONTERMS \n"); ## printf(" list, EPROD[j]=1, GETAL[j]=[], and \n"); ## printf(" _ORDS[j]=[0,0..]. \n"); ## printf(" (2) Assuming term is not a constant. \n"); ## printf(" Let jpqd = power of q in jacterm. \n"); ## printf(" Use jac2eprod to convert jacterm to GETA-prod. \n"); ## printf(" Use GETAP2getalist to convert eprod to getalist. \n"); ## printf(" Use getaprodcuspORDS to calculate ORDS of jacterm.\n"); ## printf(" Result is stored in the array _ORDS as _ORDS[j]. \n"); ## printf(" (3) Check that the power of q matches ORD at oo. \n"); ## printf(" If not, j is added to qcheck list. \n"); ## printf(" (4) Use Gamma1ModFunc to check whether GETA-prod is a \n"); ## printf(" modular function on Gamma[1](N). \n"); ## printf(" If not, j is added to modfunccheck list. \n"); ## printf(" (II) We now should have a complete array _ORDS. \n"); ## printf(" (5) Final error check made. Each of the arrays qcheck,\n"); ## printf(" modfunccheck, and totcheck should be empty. If not\n"); ## printf(" an error message is returned which terminates the \n"); ## printf(" proc. \n"); ## printf(" (6) A WARNING is printed if any terms were constants. \n"); ## printf(" (7) We use mintotORDS to min power of q to check \n"); ## printf(" identity. \n"); ## printf(" A query is made whether to check now. \n"); ## printf(" If not (suggested), this min power is returned. \n"); ## fi: printf("-------------------------------------------------------------\n"); elif nargs = 2 then ##jacid:=args[1]: CUSPS:=args[2]: WIDS:=args[3]: N:=args[4]: etaid:=args[1]: N:=args[2]: CUSPS:=convert(cuspmake(N),list): CUSPS1:=cuspmake(N) minus {1/N}: CUSPS1:=convert(CUSPS1,list): conpres:=0: #conpres=0 if no terms are constants qcheck:=[]: modfunccheck:=[]: totcheck:=[]: CONTERMS:=[]: nn:=nops(etaid): _ORDS:=array(1..nn): etaPRODL:=array(1..nn): consL:=array(1..nn): GPL:=array(1..nn): COFS:=array(1..nn): for j from 1 to nn do lprint("TERM ",j,"of ",nn," *****************"); XX:=op(j,etaid): if xprint then print("XX=",XX); fi: cc:=eval(subs(eta=etaCOF,XX)): COFS[j]:=cc: eptmp:=eval(XX/cc): if eptmp=1 then etaPRODL[j]:=1: consL[j]:=cc: GPL[j]:=[]: ordtmp:=cuspORDSnotoo(eptmp,CUSPS1,N): _ORDS[j]:=ordtmp: conpres:=1: CONTERMS:=[op(CONTERMS),j]: else etaPRODL[j]:=eptmp: gltmp:=GPmake(eptmp): consL[j]:=cc: GPL[j]:=gltmp: cuspORDS(eptmp,CUSPS,N): ordtmp:=cuspORDSnotoo(eptmp,CUSPS1,N): _ORDS[j]:=ordtmp: if toterror<>0 then lprint("WARNING: totcheck: "); totcheck:=[op(totcheck),j]: fi: mftmp:=gammacheck(gltmp,N): if mftmp<>1 then lprint("WARNING: modfunccheck: "); modfunccheck:=[op(modfunccheck),j]: fi: fi: od: mintottmp:=mintotGAMMA0ORDS(_ORDS,nn): lprint("mintotord = ",mintottmp); lprint("TO PROVE the identity we need to show that v[oo](ID) > ",-mintottmp); MFLB:=-mintottmp: num2:=nops(modfunccheck): num3:=nops(totcheck): if num2+num3>0 then lprint("***********************************"); lprint("See qcheck, modfunccheck, totcheck."); error("There were errors."); else printf("*** There were NO errors. \n"); printf("*** o Each term was modular function on\n"); printf(" Gamma0(%a). \n",N); printf("*** o We also checked that the total order of\n",N); printf(" each term was zero.\n"); fi: if conpres=1 then lprint("*** WARNING: some terms were constants. ***"); lprint("See array CONTERMS."); fi: printf("To prove the identity we will need to verify if up to \n"); printf("q^(%a).\n",-mintottmp); printf("Do you want to prove the identity? (yes/no)\n"); proofq:=readline(terminal); if proofq = "yes" then printf("You entered yes.\n"); printf("We verify the identity to O(q^(\%a)).\n",-mintottmp+2*N); ff1:=0: TT:=-mintottmp+2*N: for j from 1 to nn do if etaPRODL[j]<>1 then qsj:=etaprodtoqseries(etaPRODL[j],TT): qsj:=convert(qsj,polynom): ff1 := ff1 + consL[j]*qsj: else ff1 := ff1 + consL[j]*1: fi: od: ss:=simplify(series(ff1,q,-mintottmp+2*N)); ss:=convert(ss,polynom): if ss=0 then printf("RESULT: The identity holds to O(q^(\%a)).\n",-mintottmp+2*N); printf("CONCLUSION: This proves the identity since we had only\n"); printf(" to show that v[oo](ID) > %a.\n",MFLB); else printf("WARNING: ss <> 0. Something is wrong.\n"); printf("ss = %a. Something is wrong.\n",ss); fi: else printf("You did not enter yes.\n"); fi: RETURN(); else printf("nargs=%a\n",nargs); ERROR(`nargs must be 0 or 2`); fi: end: ETA[UpLB]:=proc(EP,r,N1,p) ### ### See ### math/reports/referee/bkim/revised-paper/prog1a ### local N,d,LB: global xprint, minSET: if not(type(xprint,boolean)) then xprint:=false: fi: if modp(N1,p)<>0 then ERROR("p does not divide N1"); fi: # Suppose EP is an etaprod on Gamma0(N1) # p|N1 and r=c/d is a cusp Gamma0(N) where N1=p*N N:=N1/p: d:=denom(r): if vp(d,p) >= vp(N,p)/2 then LB:= cuspORD(EP,N1,r/p)/p: if xprint then print("case 1",LB); fi: fi: if vp(d,p) > 0 and vp(d,p)< vp(N,p)/2 then LB:= cuspORD(EP,N1,r/p): if xprint then print("case 2",LB); fi: fi: if vp(d,p)=0 then minSET:=[seq(cuspORD(EP,N1,(r+b)/p),b=0..p-1)]: LB:=min(op(minSET)): if xprint then print("case 3",LB); fi: fi: RETURN(LB); end: ETA[vetainf]:=proc() local epterm,cc,eprod,GP,ngp,w2: if nargs=0 then printf("-------------------------------------------------------------\n"); printf("vetainf(epterm) \n"); printf(" epterm = c*eta(t[1]*tau)^r[1]* ... *eta(t[s]*tau)^r[s] \n"); printf(" ie. an eta-quotient times a constant. \n"); printf(" Returns the v[oo](epterm). \n"); printf(" \n"); printf("-------------------------------------------------------------\n"); elif nargs = 1 then epterm:=args[1]: if type(epterm,constant) then RETURN(0): else eprod:=epterm/ETA[etaCONSTANT](epterm): GP:=GPmake(eprod): ngp:=nops(GP): w2:=sum(GP[2*i-1]*GP[2*i],i=1..(ngp/2)): RETURN(w2/24): fi: else printf("nargs=%a\n",nargs); ERROR(`nargs must be 0 or 1`); fi: end: ETA[vp]:=proc(n,p) local x,n1: x:=0: if n=0 then RETURN(oo): else n1:=n: while type(n1,integer) do n1:=n1/p: x:=x+1: od: RETURN(x-1); fi: end: printf("TABLE TYPE ETA = %a\n",type(ETA,table)); save( ETA , "c:\\Program Files\\Maple 13\\mylib\\ETA.m"); printf("END ETA package\n"); ## mylib above must be changed to the name of the directory ## in which you want stuff stored