intrinsic XHldata()->Tup
{data for X_H(l)}

k:=18;//weight
l:=29;//level

//==== equation for X_H(l)===
X:=[0, 2, -4, 2, 0, -4, 4, -2, -1, 0 ,-1, 0, -6, 6];
Y:=[0, 1, -3, 2, 0, -4, 3 ,-1, 1, 0, -1, 0, -4, 4];

R<x,y>:=PolynomialRing(Rationals(),2);

XHl :=10*x^4-5*x^5+5*x^2+4*y^5+y^6-40*x*y^4-28*x*y^5-12*x*y^6-5*x*y-16*x*y^2-33*x*y^3-2*x*y^7+26*x^2*y+71*x^2*y^2+110*x^2*y^3-49*x^3*y-107*x^3*y^2-114*x^3*y^3-60*x^3*y^4-30*x^3*y^5+92*x^2*y^4+41*x^2*y^5+11*x^2*y^6+4*x^2*y^7+x^2*y^8-19*x^3*y^6-2*x^3*y^7+41*x^4*y+63*x^4*y^2+44*x^4*y^3+37*x^4*y^4+6*y^4+4*y^3+y^2+33*x^4*y^5+x^4*y^6-14*x^5*y-14*x^5*y^2-20*x^5*y^3-10*x^3+x^6+4*x^6*y^2+9*x^6*y^3-26*x^5*y^4+x^6*y-x^7*y^2-x;


//==== two generators of each cusp of XHl computed using function RationalCuspsOfXHl.m ====
genx1:=x; 
geny1:=-183111707170929433601/67190339170004171241*x^2/(x^18 + 9*x^17 - 110/3*x^16
    + 152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 + 7414/3*x^11 -
    2930*x^10 + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6 + 4498/3*x^5 -
    2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y^7 +
    (456763076399822960573879263209634948911707677/2228652626236338503772839865\
    300775248177000*x^18 + 9795470177352569603336691191589945373223767/42450526\
    21402549530995885457715762377480*x^17 -
    17476087199175074152245217553839562994103083719/668595787870901551131851959\
    5902325744531000*x^16 + 2857511979313288979318185684705770525963895067/1310\
    97213308019911986637639135339720481000*x^15 -
    24272239233666884246483049324033496524367453109/668595787870901551131851959\
    590232574453100*x^14 + 61555473091161064206034675426230132019320566059/8357\
    44734838626938914814949487790718066375*x^13 -
    165308318470832728490043022157613124531099204129/13371915757418031022637039\
    19180465148906200*x^12 + 17708034507820914436175725371478064220456448019/16\
    7148946967725387782962989897558143613275*x^11 -
    1031499634710678485468412779150091877922862101857/6685957878709015511318519\
    595902325744531000*x^10 + 594660531270615296983251372163056716991340861751/\
    6685957878709015511318519595902325744531000*x^9 -
    130338596099822928191773529420608450821037155299/16714894696772538778296298\
    98975581436132750*x^8 + 1570599914431545072664386423513878556883237211/1872\
    8173329717130283805377019334245783000*x^7 -
    24790957142912054373909992776486808780535209137/393291639924059735959912917\
    406019161443000*x^6 + 1362233619336169000478592664464128609080672793/786583\
    27984811947191982583481203832288600*x^5 -
    25156597815109754418207397088971637467008807497/668595787870901551131851959\
    5902325744531000*x^4 + 1830696629220793311404886074788463606957693593/33429\
    78939354507755659259797951162872265500*x^3 +
    313944412282113451519547/94335236194685856422364*x^2 +
    366223414341858867202/67190339170004171241*x)/(x^16 + 11*x^15 - 47/3*x^14 +
    329/3*x^13 - 614/3*x^12 + 1216/3*x^11 - 2089/3*x^10 + 2020/3*x^9 - 887*x^8 +
    629*x^7 - 1480/3*x^6 + 1523/3*x^5 - 1241/3*x^4 + 493/3*x^3 - 121/3*x^2 +
    22/3*x - 2/3)*y^6 + (3465972924597253521434449313894290312495988983/4457305\
    252472677007545679730601550496354000*x^20 +
    10082141505063848841518971512345691550226927217/148576841749089233584855991\
    0200516832118000*x^19 - 203793413259790055174469208810967046219850951327/66\
    85957878709015511318519595902325744531000*x^18 +
    23301789570233645794397755926262050263293975201/185721052186361541981069988\
    775064604014750*x^17 - 4977833588950009862711715735471096521067012424817/13\
    371915757418031022637039191804651489062000*x^16 +
    10753092824026226338275635873639518570813146686023/133719157574180310226370\
    39191804651489062000*x^15 - 28745881320870538981323799005147732542214994111\
    31/1910273679631147288948148455972093069866000*x^14 +
    14972543444396019463833656589065106236496636831227/668595787870901551131851\
    9595902325744531000*x^13 - 865790937899060422538290620514389407806303056353\
    /318378946605191214824691409328682178311000*x^12 +
    38750389809793059780850963809062470209372002575363/133719157574180310226370\
    39191804651489062000*x^11 - 68764829842498434535020040620964808250612337861\
    49/2674383151483606204527407838360930297812400*x^10 +
    554672963262102938798910272228506020162307640837/26743831514836062045274078\
    3836093029781240*x^9 - 24522753256589082316732800717714903779764958975521/1\
    3371915757418031022637039191804651489062000*x^8 +
    9925842300592483026135652799669377288408280789513/6685957878709015511318519\
    595902325744531000*x^7 - 2817522817801603883995241214985217615836086605201/\
    3342978939354507755659259797951162872265500*x^6 +
    4017138243707476215637810958818181248239383892259/1337191575741803102263703\
    9191804651489062000*x^5 - 132347674540406794303820336939349777737139473963/\
    1910273679631147288948148455972093069866000*x^4 +
    15754985288012698504547199233608922955387984317/133719157574180310226370391\
    9180465148906200*x^3 - 7331212617210117896929501434232938712625994247/66859\
    57878709015511318519595902325744531000*x^2 +
    1228588608925796097135277/47167618097342928211182*x -
    183111707170929433601/67190339170004171241)/(x^18 + 9*x^17 - 110/3*x^16 +
    152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 + 7414/3*x^11 - 2930*x^10
    + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6 + 4498/3*x^5 -
    2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y^5 +
    (237973764953266144638169/318935020124383133625*x^20 +
    1441343002785937632629286627494148371737904761/3183789466051912148246914093\
    28682178311000*x^19 - 26413794346031592923505377223150846783355386221/55716\
    3156559084625943209966325193812044250*x^18 +
    1272801333554700489078323540329770427951004904757/6685957878709015511318519\
    595902325744531000*x^17 - 166758650945990901724784992422320288922038169347/\
    257152226104192904281481522919320220943500*x^16 +
    3567900509172339104849081937106363042199230234117/2228652626236338503772839\
    865300775248177000*x^15 - 376873031430726518213378352851238546767446200542/\
    119392104976946705559259278498255816866625*x^14 +
    4427385075880098323433736471960839278546313686594/8357447348386269389148149\
    49487790718066375*x^13 - 1748296567314594941443451741843247178870477499003/\
    247628069581815389308093318366752805353000*x^12 +
    13312224290862167119376587638517014027320577398287/167148946967725387782962\
    9898975581436132750*x^11 - 524687459659899536039953780254310696565696894413\
    87/6685957878709015511318519595902325744531000*x^10 +
    13977621907766812370764714564201015457381957363/215676060603516629397371599\
    8678169595010*x^9 - 35873224127150203225443393958328027095735501420297/6685\
    957878709015511318519595902325744531000*x^8 +
    93178529578544934740031881430149929482692315917/196069146003196935815792363\
    51619723591000*x^7 - 22246508724097872132899639212175597435090491447837/668\
    5957878709015511318519595902325744531000*x^6 +
    5029019914353870314442751789943889159404032162679/3342978939354507755659259\
    797951162872265500*x^5 - 103044157524837973236833549930147739362752969859/2\
    47628069581815389308093318366752805353000*x^4 +
    2802122770525522436882211776108853775531198432/3342978939354507755659259797\
    9511628722655*x^3 - 6781428081330118079410900220666427379209689687/60781435\
    2609910501028956326900211431321000*x^2 +
    958018227832743266086811802754948276998334109/16714894696772538778296298989\
    75581436132750*x - 714410935189826247583669/94335236194685856422364)/(x^18 +
    9*x^17 - 110/3*x^16 + 152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 +
    7414/3*x^11 - 2930*x^10 + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6
    + 4498/3*x^5 - 2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y^4 +
    (-511361779262209899472244/318935020124383133625*x^20 -
    943866109311862028811376033972106268506855507/50651196050825875085746360575\
    017619276750*x^19 + 258021878108156802972673868097733508437297247/124854488\
    86478086855870251346222830522000*x^18 -
    1232249836172307431266906829640647824034555279183/1337191575741803102263703\
    9191804651489062000*x^17 + 505177575236551858364559804976877665903468553443\
    /6685957878709015511318519595902325744531000*x^16 +
    90827232698382985757228322715776256555293139232/278581578279542312971604983\
    162596906022125*x^15 - 1963376304407404765477655283750075762939293027899/19\
    10273679631147288948148455972093069866000*x^14 +
    40133970525431377850958943171353049376347135024759/133719157574180310226370\
    39191804651489062000*x^13 - 21341495276023942382225021205319144293888746648\
    93/405209568406607000685970884600140954214000*x^12 +
    45420755340302483338483034375333059209539608943609/668595787870901551131851\
    9595902325744531000*x^11 - 536370658023189096380852867144821214658793206624\
    29/6685957878709015511318519595902325744531000*x^10 +
    18685335951231173272781602184505777662844473719891/267438315148360620452740\
    7838360930297812400*x^9 - 7049879011978278476690067584150880197674080139848\
    1/13371915757418031022637039191804651489062000*x^8 +
    1395791702115247028597092669895066708751880629319/2674383151483606204527407\
    83836093029781240*x^7 - 398442735589443064353642263810618289965399159183/86\
    270424241406651758948639947126783800400*x^6 +
    3433937668514456167186693651318913454852796048399/1337191575741803102263703\
    919180465148906200*x^5 - 16782977903926652934744794629921263682579155959/20\
    260478420330350034298544230007047710700*x^4 +
    2458501561698466410345336303340631457598552066199/1337191575741803102263703\
    9191804651489062000*x^3 - 382014150419672548368270548649516970211932595941/\
    13371915757418031022637039191804651489062000*x^2 +
    13710344662135619999228985361759091041398294847/668595787870901551131851959\
    5902325744531000*x - 1605980993239057967039915/1698034251504345415602552)/(\
    x^18 + 9*x^17 - 110/3*x^16 + 152*x^15 - 1319/3*x^14 + 2773/3*x^13 -
    5135/3*x^12 + 7414/3*x^11 - 2930*x^10 + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7
    - 5767/3*x^6 + 4498/3*x^5 - 2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x -
    2/3)*y^3 + (-658761313528686752066471/106311673374794377875*x^19 -
    5492542490710028193755921297565655422410177497/8571740870139763476049384097\
    3106740314500*x^18 + 321252608203413665668679159265951335406076039711/22286\
    52626236338503772839865300775248177000*x^17 -
    481395171458499376647998693363883481534850688083/66859578787090155113185195\
    9590232574453100*x^16 + 1406016913897833959952126035226829609347631330979/8\
    35744734838626938914814949487790718066375*x^15 -
    10405114927822466555254500401865258641332285902113/334297893935450775565925\
    9797951162872265500*x^14 + 123243444876702614386858872411022158830750759377\
    33/2228652626236338503772839865300775248177000*x^13 -
    1467312957919709072838949470489326748169252437329/2387842099538934111185185\
    56996511633733250*x^12 + 45118381599583273599923941356447480708458445144443\
    /6685957878709015511318519595902325744531000*x^11 -
    40560015239726369212897628685464713613069201543359/668595787870901551131851\
    9595902325744531000*x^10 + 118328193570259204357105664055390183031367788597\
    7/318378946605191214824691409328682178311000*x^9 -
    58520335663265621306789623351571047037247085427/154054329002511878140979714\
    19129782821500*x^8 + 1115422367956922883450414383793492665842233911/3122674\
    26963197212242236214838275921000*x^7 -
    829774139562586590480317615373591547335376483867/51430445220838580856296304\
    5838640441887000*x^6 + 7591923711864478831459891058948364008143005703/27858\
    1578279542312971604983162596906022125*x^5 +
    493893401764280044744468343514000404882590202807/33429789393545077556592597\
    97951162872265500*x^4 - 44969736093227961757513914794076851550050705138/835\
    744734838626938914814949487790718066375*x^3 +
    762896153370930359930588884234379685759283409/57144939134265089840329227315\
    404493543000*x^2 - 352453445529236747589704779871456887928592259/2387842099\
    53893411118518556996511633733250*x - 416476058687221283500879/2830057085840\
    57569267092)/(x^17 + 10*x^16 - 80/3*x^15 + 376/3*x^14 - 943/3*x^13 +
    610*x^12 - 3305/3*x^11 + 4109/3*x^10 - 4681/3*x^9 + 1516*x^8 - 3367/3*x^7 +
    1001*x^6 - 2764/3*x^5 + 578*x^4 - 614/3*x^3 + 143/3*x^2 - 8*x + 2/3)*y^2 +
    (-5874823698851026316024/12757400804975325345*x^19 -
    17797456030161804442166200207101188665281460763/445730525247267700754567973\
    0601550496354000*x^18 + 81508293844206108266038861884170911481810410301/445\
    7305252472677007545679730601550496354000*x^17 -
    502919822815828235982949325166070196669665179739/66859578787090155113185195\
    95902325744531000*x^16 + 6815602396043309592255719739009464587303417217/303\
    90717630495525051447816345010571566050*x^15 -
    6513524141039672673951903368712056444471532150883/1337191575741803102263703\
    9191804651489062000*x^14 + 135750001538623654280039002163737649393233985592\
    1/1485768417490892335848559910200516832118000*x^13 -
    1406693612681714086643860538924061627347935447223/1028608904416771617125926\
    091677280883774000*x^12 + 1115924288324734872744441322216281370800760955019\
    1/6685957878709015511318519595902325744531000*x^11 -
    11930555772320451537130749058091355305489831049791/668595787870901551131851\
    9595902325744531000*x^10 + 31566977502051570588946523306406468681943089547/\
    19810245566545231144647465469340224428240*x^9 -
    593892489802591546438044846519022873999579103/46133916706634573133127614944\
    9875849200*x^8 + 1439057572668054049337443489415753922505058789/12698875363\
    17001996451760607008988745400*x^7 - 123373331444923928764878697710429588604\
    90157092099/13371915757418031022637039191804651489062000*x^6 +
    1658762412761778859172372463625995067756640381/3116996680050823082199776035\
    385699647800*x^5 - 647919766811843594510367494465591190269149893479/3342978\
    939354507755659259797951162872265500*x^4 +
    121548261171732172163532646264453303389390179797/26743831514836062045274078\
    38360930297812400*x^3 - 34684386387700129755081575635358984744229039713/445\
    7305252472677007545679730601550496354000*x^2 +
    379802051143032770834268405467023973451539941/51430445220838580856296304583\
    8640441887000*x - 2994937590094527865428013/1698034251504345415602552)/(x^1\
    8 + 9*x^17 - 110/3*x^16 + 152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12
    + 7414/3*x^11 - 2930*x^10 + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 -
    5767/3*x^6 + 4498/3*x^5 - 2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x -
    2/3)*y + (183111707170929433601/3937469384251643625*x^16 +
    87829415942803195189622262313722122582/167974541840873279953936588228702215\
    *x^15 - 159078340724685948244974930239491756401034/264559903399375415927450\
    126460205988625*x^14 + 25697957483860763337126505878218150783362/5187449086\
    262263057400982871768744875*x^13 - 4398267396839689445877643815417420039891\
    23/52911980679875083185490025292041197725*x^12 +
    4452108368727802581623664061859741876966692/2645599033993754159274501264602\
    05988625*x^11 - 1496828290616044601708853280072757442856094/529119806798750\
    83185490025292041197725*x^10 + 1292731835725685132735611135811470479007322/\
    52911980679875083185490025292041197725*x^9 -
    9341252329176362549726183549617139380159427/2645599033993754159274501264602\
    05988625*x^8 + 5465493474619118863951535550517358480667886/2645599033993754\
    15927450126460205988625*x^7 - 4740131325761074626284684891213309609582656/2\
    64559903399375415927450126460205988625*x^6 +
    14260996329872782296981671336123669232946/741064155180323293914426124538392\
    125*x^5 - 226417528274155421385046661862050520252632/1556234725878678917220\
    2948615306234625*x^4 + 12763671522044754835265831255960180044198/3112469451\
    757357834440589723061246925*x^3 - 23331779903131628929693846605632253815346\
    7/264559903399375415927450126460205988625*x^2 +
    33870659291162499187353233893505104860796/264559903399375415927450126460205\
    988625*x)/(x^16 + 11*x^15 - 47/3*x^14 + 329/3*x^13 - 614/3*x^12 +
    1216/3*x^11 - 2089/3*x^10 + 2020/3*x^9 - 887*x^8 + 629*x^7 - 1480/3*x^6 +
    1523/3*x^5 - 1241/3*x^4 + 493/3*x^3 - 121/3*x^2 + 22/3*x - 2/3);
genx2:=x; 
geny2:=-1312489794750547875/22396779723334723747*x^2/(x^18 + 9*x^17 - 110/3*x^16 +
    152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 + 7414/3*x^11 - 2930*x^10
    + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6 + 4498/3*x^5 -
    2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y^7 +
    (295719138388342969279613/566011417168115138534184*x^18 +
    1299523685566665044996057/188670472389371712844728*x^17 +
    7900884706492512516475289/1698034251504345415602552*x^16 +
    24162462263169714630890987/566011417168115138534184*x^15 +
    12239140714163148067311703/849017125752172707801276*x^14 +
    1956347835320330591692331/212254281438043176950319*x^13 +
    79284302976705656482656251/1698034251504345415602552*x^12 -
    71648729049142010583470065/212254281438043176950319*x^11 +
    217652547078894921482272447/1698034251504345415602552*x^10 -
    901477206445598089052242217/1698034251504345415602552*x^9 +
    101732308844471477738770781/424508562876086353900638*x^8 -
    95526569857685859810232915/566011417168115138534184*x^7 +
    427045375609895490348931295/1698034251504345415602552*x^6 -
    451629060841820388036046547/1698034251504345415602552*x^5 +
    128662600574164789880476247/1698034251504345415602552*x^4 -
    14188340288611859876560711/849017125752172707801276*x^3 +
    251054254818989547237971/94335236194685856422364*x^2 +
    2624979589501095750/22396779723334723747*x)/(x^16 + 11*x^15 - 47/3*x^14 +
    329/3*x^13 - 614/3*x^12 + 1216/3*x^11 - 2089/3*x^10 + 2020/3*x^9 - 887*x^8 +
    629*x^7 - 1480/3*x^6 + 1523/3*x^5 - 1241/3*x^4 + 493/3*x^3 - 121/3*x^2 +
    22/3*x - 2/3)*y^6 + (-2140820683349014166979137/1132022834336230277068368*x\
    ^20 - 5215326499536831400100791/377340944778743425689456*x^19 +
    164581156385985225712025129/1698034251504345415602552*x^18 -
    58857736061226323092438117/141502854292028784633546*x^17 +
    4615826769416387983669765399/3396068503008690831205104*x^16 -
    11300645438005481869729339601/3396068503008690831205104*x^15 +
    22687846097880538216570604971/3396068503008690831205104*x^14 -
    18916522909911324177934968493/1698034251504345415602552*x^13 +
    2878737233314267740512415131/188670472389371712844728*x^12 -
    60131693071609851835547423957/3396068503008690831205104*x^11 +
    60162141189061191723859314479/3396068503008690831205104*x^10 -
    26181942328264520317643270395/1698034251504345415602552*x^9 +
    43606282656043325546369403239/3396068503008690831205104*x^8 -
    18537881935722202932327783343/1698034251504345415602552*x^7 +
    6870494731422002197774815511/849017125752172707801276*x^6 -
    14661540729564304111518110069/3396068503008690831205104*x^5 +
    5116891901267467149420662491/3396068503008690831205104*x^4 -
    578071896703404040183474151/1698034251504345415602552*x^3 +
    95366204563506196793249201/1698034251504345415602552*x^2 -
    217885012726053701340971/47167618097342928211182*x -
    1312489794750547875/22396779723334723747)/(x^18 + 9*x^17 - 110/3*x^16 +
    152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 + 7414/3*x^11 - 2930*x^10
    + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6 + 4498/3*x^5 -
    2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y^5 +
    (1076991915329851566977653/188670472389371712844728*x^19 +
    5640780077446065826337389/141502854292028784633546*x^18 -
    178188206734131148764791209/566011417168115138534184*x^17 +
    83083004127528162264392153/65309009673244054446252*x^16 -
    7121402354323062788113903745/1698034251504345415602552*x^15 +
    2136116355619601421061449184/212254281438043176950319*x^14 -
    463182245115224066925726257/23583809048671464105591*x^13 +
    54739227269777941668774625063/1698034251504345415602552*x^12 -
    17954403414167150060654343463/424508562876086353900638*x^11 +
    80280886832253198055752935717/1698034251504345415602552*x^10 -
    2163298738787604805503652681/47167618097342928211182*x^9 +
    64099734883846392887861108255/1698034251504345415602552*x^8 -
    661204527672597956547367703/20963385821041301427192*x^7 +
    46839743741646638198162779667/1698034251504345415602552*x^6 -
    5326099957576084174673698879/283005708584057569267092*x^5 +
    14092252774297357746248026783/1698034251504345415602552*x^4 -
    478409024286948915422371607/212254281438043176950319*x^3 +
    251478360824027193443452513/566011417168115138534184*x^2 -
    23991841966046191350105295/424508562876086353900638*x +
    228941426757032316639971/94335236194685856422364)/(x^18 + 9*x^17 -
    110/3*x^16 + 152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 +
    7414/3*x^11 - 2930*x^10 + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6
    + 4498/3*x^5 - 2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y^4 +
    (9230652225157217617007/15722539365780976070394*x^19 -
    2440234292052691512307477/125780314926247808563152*x^18 -
    277548612656778057513936317/1132022834336230277068368*x^17 +
    555005129953201131292448345/566011417168115138534184*x^16 -
    840306492852563144029530416/212254281438043176950319*x^15 +
    37974215880075472864472626603/3396068503008690831205104*x^14 -
    78854902804279581510791895073/3396068503008690831205104*x^13 +
    48082072976619195369482464633/1132022834336230277068368*x^12 -
    102693105629397393307311117007/1698034251504345415602552*x^11 +
    120570947642373970814769514795/1698034251504345415602552*x^10 -
    250955735862662952879771870265/3396068503008690831205104*x^9 +
    70954865323918308050840725405/1132022834336230277068368*x^8 -
    85798572163806019751672054729/1698034251504345415602552*x^7 +
    51980054616361857542170271825/1132022834336230277068368*x^6 -
    59781573033283978394870556941/1698034251504345415602552*x^5 +
    5036697002704624521259025975/283005708584057569267092*x^4 -
    18711231939639810286579044353/3396068503008690831205104*x^3 +
    4032539118123458054837836067/3396068503008690831205104*x^2 -
    100678241351064222721396915/566011417168115138534184*x +
    21034475693485547574327445/1698034251504345415602552)/(x^18 + 9*x^17 -
    110/3*x^16 + 152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 +
    7414/3*x^11 - 2930*x^10 + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6
    + 4498/3*x^5 - 2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y^3 +
    (x^19 - 98773016564146199021081/2418852210120150164676*x^18 -
    103119366082684671297522307/188670472389371712844728*x^17 +
    128828149447522449172404577/94335236194685856422364*x^16 -
    451115658536832116256742037/70751427146014392316773*x^15 +
    1428052427070014574277472831/94335236194685856422364*x^14 -
    16109902836693812032699432835/566011417168115138534184*x^13 +
    7115155499843504002615586311/141502854292028784633546*x^12 -
    33042905904783601748958079007/566011417168115138534184*x^11 +
    36712107107442379934033606531/566011417168115138534184*x^10 -
    3772429430129790375958130017/62890157463123904281576*x^9 +
    11415908646643278786592549783/283005708584057569267092*x^8 -
    3064993224825694384790545/79306629840004923432*x^7 +
    1555106020435734150658643695/43539339782162702964168*x^6 -
    1331250644150269400910383773/70751427146014392316773*x^5 +
    1034582659197045482357843837/283005708584057569267092*x^4 -
    26574204135097417459234/70751427146014392316773*x^3 -
    6954834691321967184440437/43539339782162702964168*x^2 +
    8763311600289320060780801/141502854292028784633546*x -
    2303180782580938411948159/283005708584057569267092)/(x^17 + 10*x^16 -
    80/3*x^15 + 376/3*x^14 - 943/3*x^13 + 610*x^12 - 3305/3*x^11 + 4109/3*x^10 -
    4681/3*x^9 + 1516*x^8 - 3367/3*x^7 + 1001*x^6 - 2764/3*x^5 + 578*x^4 -
    614/3*x^3 + 143/3*x^2 - 8*x + 2/3)*y^2 + (-2*x^19 -
    4584761295423067703000833/377340944778743425689456*x^18 +
    143501119203727603393969013/1132022834336230277068368*x^17 -
    289373168990488795489914529/566011417168115138534184*x^16 +
    739302968913239290039323499/424508562876086353900638*x^15 -
    14630757683745125353815615883/3396068503008690831205104*x^14 +
    28912686218270428024285146673/3396068503008690831205104*x^13 -
    138445279759846578900776333/9675408840480600658704*x^12 +
    32490196245020563760907123127/1698034251504345415602552*x^11 -
    36755116773442889743301669623/1698034251504345415602552*x^10 +
    72606653740673435074545113017/3396068503008690831205104*x^9 -
    6691140651556656221394959255/377340944778743425689456*x^8 +
    1916652439207769094200323217/130618019346488108892504*x^7 -
    1631090307781458061143928849/125780314926247808563152*x^6 +
    1193826444803590967244639017/130618019346488108892504*x^5 -
    1188556778574307243230487741/283005708584057569267092*x^4 +
    4043479046066026537116164513/3396068503008690831205104*x^3 -
    825065730641410921006395371/3396068503008690831205104*x^2 +
    1438858308350497904648767/43539339782162702964168*x -
    2994937590094527865428013/1698034251504345415602552)/(x^18 + 9*x^17 -
    110/3*x^16 + 152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 +
    7414/3*x^11 - 2930*x^10 + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6
    + 4498/3*x^5 - 2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y +
    (2*x^16 + 498180498955207836767/22396779723334723747*x^15 -
    1921398893403374714743/67190339170004171241*x^14 +
    14525897379205689661025/67190339170004171241*x^13 -
    25761415746962057062273/67190339170004171241*x^12 +
    17182701204655627903948/22396779723334723747*x^11 -
    29219623839403167198651/22396779723334723747*x^10 +
    26846829909513946169850/22396779723334723747*x^9 -
    110611785513860623422994/67190339170004171241*x^8 +
    72110588114362457568875/67190339170004171241*x^7 -
    19677929748954932948872/22396779723334723747*x^6 +
    61913955745628636889203/67190339170004171241*x^5 -
    48814894571558701706371/67190339170004171241*x^4 +
    5655492348572002625367/22396779723334723747*x^3 -
    1328064402700188585218/22396779723334723747*x^2 +
    225900604161966599210/22396779723334723747*x - 2/3)/(x^16 + 11*x^15 -
    47/3*x^14 + 329/3*x^13 - 614/3*x^12 + 1216/3*x^11 - 2089/3*x^10 + 2020/3*x^9
    - 887*x^8 + 629*x^7 - 1480/3*x^6 + 1523/3*x^5 - 1241/3*x^4 + 493/3*x^3 -
    121/3*x^2 + 22/3*x - 2/3);
genx3:=x; 
geny3:=175236768402426146351/67190339170004171241*x^2/(x^18 + 9*x^17 - 110/3*x^16 +
    152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 + 7414/3*x^11 - 2930*x^10
    + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6 + 4498/3*x^5 -
    2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y^7 +
    (-454434306292340209813887167198832594003873427/222865262623633850377283986\
    5300775248177000*x^18 - 9736992066197956995831956190340774128718777/4245052\
    621402549530995885457715762377480*x^17 +
    17538306182455706754899431719669674373996848969/668595787870901551131851959\
    5902325744531000*x^16 - 2846319161029834104994893937301773472675835317/1310\
    97213308019911986637639135339720481000*x^15 +
    24291515730407510323455967606100884929546590459/668595787870901551131851959\
    590232574453100*x^14 - 61540066971748022650037499288057360105205486309/8357\
    44734838626938914814949487790718066375*x^13 +
    165433190277081732480837716804518732432151424079/13371915757418031022637039\
    19180465148906200*x^12 - 17820880378641529653793799873918465313350682269/16\
    7148946967725387782962989897558143613275*x^11 +
    1033213635191733561992066675025782182042463502607/6685957878709015511318519\
    595902325744531000*x^10 - 601759609072575778841845278111880643739068695001/\
    6685957878709015511318519595902325744531000*x^9 +
    131139731802751606488243309148305570793786997549/16714894696772538778296298\
    98975581436132750*x^8 - 1576921476518893206486492506818003988527353461/1872\
    8173329717130283805377019334245783000*x^7 +
    24988778094929725793562527498633224058882237887/393291639924059735959912917\
    406019161443000*x^6 - 1404075398162121720919640062140733654533750743/786583\
    27984811947191982583481203832288600*x^5 +
    26169807916427698027678553390920853882051758247/668595787870901551131851959\
    5902325744531000*x^4 - 1942428940220299966417317381622667234654928343/33429\
    78939354507755659259797951162872265500*x^3 +
    188164097355865642956395/94335236194685856422364*x^2 -
    350473536804852292702/67190339170004171241*x)/(x^16 + 11*x^15 - 47/3*x^14 +
    329/3*x^13 - 614/3*x^12 + 1216/3*x^11 - 2089/3*x^10 + 2020/3*x^9 - 887*x^8 +
    629*x^7 - 1480/3*x^6 + 1523/3*x^5 - 1241/3*x^4 + 493/3*x^3 - 121/3*x^2 +
    22/3*x - 2/3)*y^6 + (-3482831756392972372927040391433083499164092233/445730\
    5252472677007545679730601550496354000*x^20 -
    10123211881905453976487308968648127415052141967/148576841749089233584855991\
    0200516832118000*x^19 + 205089479788779152597903388345908581710956256577/66\
    85957878709015511318519595902325744531000*x^18 -
    23456289926078607508219827593922391773860677951/185721052186361541981069988\
    775064604014750*x^17 + 5014182942125182259940102079934380810634820287567/13\
    371915757418031022637039191804651489062000*x^16 -
    10842084714895085518813807400185612059953250073273/133719157574180310226370\
    39191804651489062000*x^15 + 29001117604884875376617231810866131313550266853\
    81/1910273679631147288948148455972093069866000*x^14 -
    15121509904024560766839583670722861874092315445477/668595787870901551131851\
    9595902325744531000*x^13 + 875506600517472031068113618356092795924934219103\
    /318378946605191214824691409328682178311000*x^12 -
    39223923210778420717685306753887201589595905223613/133719157574180310226370\
    39191804651489062000*x^11 + 69712376198590247404667350227830817721898380046\
    99/2674383151483606204527407838360930297812400*x^10 -
    562920210969125638437405612713751139418231879387/26743831514836062045274078\
    3836093029781240*x^9 + 24866150062427470396646232654125816653757256378271/1\
    3371915757418031022637039191804651489062000*x^8 -
    10071826985734038565706058445478425816009575066263/668595787870901551131851\
    9595902325744531000*x^7 + 2871627543120876589270196181062451289301875139951\
    /3342978939354507755659259797951162872265500*x^6 -
    4132596979204712124349092131449090146173208212509/1337191575741803102263703\
    9191804651489062000*x^5 + 138104133170054175996059679631737865652321408213/\
    1910273679631147288948148455972093069866000*x^4 -
    16665441446079071322307761375540646189168559267/133719157574180310226370391\
    9180465148906200*x^3 + 8082215638732287958902601332014896289561981497/66859\
    57878709015511318519595902325744531000*x^2 -
    1664358634377903499817219/47167618097342928211182*x +
    175236768402426146351/67190339170004171241)/(x^18 + 9*x^17 - 110/3*x^16 +
    152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 + 7414/3*x^11 - 2930*x^10
    + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6 + 4498/3*x^5 -
    2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y^5 +
    (-237973764953266144638169/318935020124383133625*x^20 -
    1437708183334196636381365286620975281256551511/3183789466051912148246914093\
    28682178311000*x^19 + 26458215143748073922403314100727899857437376471/55716\
    3156559084625943209966325193812044250*x^18 -
    1277010997206602552792585186186313017480210260507/6685957878709015511318519\
    595902325744531000*x^17 + 167412924516198491882481731152018576125643118597/\
    257152226104192904281481522919320220943500*x^16 -
    3586594045001062195033637647134205730686758817867/2228652626236338503772839\
    865300775248177000*x^15 + 379276143645426911644481854156187928789279072542/\
    119392104976946705559259278498255816866625*x^14 -
    4460212862250560756584032529945074543429558595844/8357447348386269389148149\
    49487790718066375*x^13 + 5292786153386527786859067165344899440422736757759/\
    742884208745446167924279955100258416059000*x^12 -
    13453614118373739792141014875295744158626626145037/167148946967725387782962\
    9898975581436132750*x^11 + 531009530340750893729179749676918700749221251496\
    37/6685957878709015511318519595902325744531000*x^10 -
    14175457528351838145816418133205873260061932273/215676060603516629397371599\
    8678169595010*x^9 + 36378005614437787741048390996823722601131112669047/6685\
    957878709015511318519595902325744531000*x^8 -
    94415369926577739865206952463485954354506147667/196069146003196935815792363\
    51619723591000*x^7 + 22615368837995724466021658999160396165777451793587/668\
    5957878709015511318519595902325744531000*x^6 -
    5154848047476389170775680127310595019288452140929/3342978939354507755659259\
    797951162872265500*x^5 + 321463097875387505001720058737034817039541400327/7\
    42884208745446167924279955100258416059000*x^4 -
    2952820441427887426190361735828860502353802862/3342978939354507755659259797\
    9511628722655*x^3 + 7321530815809969904189367127167544805511514937/60781435\
    2609910501028956326900211431321000*x^2 -
    1146952514258964546194028232250093118129322859/1671489469677253877829629898\
    975581436132750*x + 1172293788703890880863611/94335236194685856422364)/(x^1\
    8 + 9*x^17 - 110/3*x^16 + 152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12
    + 7414/3*x^11 - 2930*x^10 + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 -
    5767/3*x^6 + 4498/3*x^5 - 2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x -
    2/3)*y^4 + (511361779262209899472244/318935020124383133625*x^20 +
    943925583620007315662951632228078579330159757/50651196050825875085746360575\
    017619276750*x^19 - 258506332619855548691040698242184665763022497/124854488\
    86478086855870251346222830522000*x^18 +
    1225692801182441940223626102164288919129581104433/1337191575741803102263703\
    9191804651489062000*x^17 - 492065680992791852504240609045648653203502249693\
    /6685957878709015511318519595902325744531000*x^16 -
    93033020091046212408905332039110771145246471232/278581578279542312971604983\
    162596906022125*x^15 + 2006096965098478982435877713984527605231764558149/19\
    10273679631147288948148455972093069866000*x^14 -
    40754948056611357710890477435053322564604713744009/133719157574180310226370\
    39191804651489062000*x^13 + 21685716531072653976289389872563980799063623766\
    43/405209568406607000685970884600140954214000*x^12 -
    46229457259081428042243101361723672653888490204359/668595787870901551131851\
    9595902325744531000*x^11 + 545865546322630204410774400927687621469243305261\
    79/6685957878709015511318519595902325744531000*x^10 -
    19080588161935804319486465936381268642591079444141/267438315148360620452740\
    7838360930297812400*x^9 + 7217508577904254628923325788541471444649206415723\
    1/13371915757418031022637039191804651489062000*x^8 -
    1422818042203846348549591249007942090559816945529/2674383151483606204527407\
    83836093029781240*x^7 + 406365440375648991924314168960406959257113160433/86\
    270424241406651758948639947126783800400*x^6 -
    3528092913938839899048220893949282695932156908849/1337191575741803102263703\
    919180465148906200*x^5 + 17504135731050343005270623663703691328408907209/20\
    260478420330350034298544230007047710700*x^4 -
    2605851367506392912794296295922116713842601465449/1337191575741803102263703\
    9191804651489062000*x^3 + 413770149056489025137812674211673599378043841691/\
    13371915757418031022637039191804651489062000*x^2 -
    16088849620016299261601770640586911309924796097/668595787870901551131851959\
    5902325744531000*x + 43674932380210153115694805/1698034251504345415602552)/\
    (x^18 + 9*x^17 - 110/3*x^16 + 152*x^15 - 1319/3*x^14 + 2773/3*x^13 -
    5135/3*x^12 + 7414/3*x^11 - 2930*x^10 + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7
    - 5767/3*x^6 + 4498/3*x^5 - 2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x -
    2/3)*y^3 + (658655001855311957688596/106311673374794377875*x^19 +
    5482970485332179154360760930289018895264087247/8571740870139763476049384097\
    3106740314500*x^18 - 323510492074558808009470410832448018515332936961/22286\
    52626236338503772839865300775248177000*x^17 +
    482969904261665811451646116668596887827458660333/66859578787090155113185195\
    9590232574453100*x^16 - 1415886331178352905191033291233610001929778124104/8\
    35744734838626938914814949487790718066375*x^15 +
    10500209705155947645063251172641117793490613379863/334297893935450775565925\
    9797951162872265500*x^14 - 124438432891460515219493744804213046757879378064\
    83/2228652626236338503772839865300775248177000*x^13 +
    1490345256696571522518948877710649965904642870829/2387842099538934111185185\
    56996511633733250*x^12 - 45867717212953796424240569008464140557622442815693\
    /6685957878709015511318519595902325744531000*x^11 +
    41396924289895529833841702040191404382722781644609/668595787870901551131851\
    9595902325744531000*x^10 - 122040550478036474221266984215204245625453124172\
    7/318378946605191214824691409328682178311000*x^9 +
    59716924506503167687279601241338628713186759177/154054329002511878140979714\
    19129782821500*x^8 - 1138695894760176379120474970732289906415641161/3122674\
    26963197212242236214838275921000*x^7 +
    865621429710843933932409988683518371511103592117/51430445220838580856296304\
    5838640441887000*x^6 - 17904391931014770249923758940585675717403215203/2785\
    81578279542312971604983162596906022125*x^5 -
    469929622476211626908955579535641494503364634557/33429789393545077556592597\
    97951162872265500*x^4 + 44989166156172932006986890871782861911683398638/835\
    744734838626938914814949487790718066375*x^3 -
    781266742362273207502527487838013456855212159/57144939134265089840329227315\
    404493543000*x^2 + 382029392212776583115078590118351189437772509/2387842099\
    53893411118518556996511633733250*x - 4189885506474655540395439/283005708584\
    057569267092)/(x^17 + 10*x^16 - 80/3*x^15 + 376/3*x^14 - 943/3*x^13 +
    610*x^12 - 3305/3*x^11 + 4109/3*x^10 - 4681/3*x^9 + 1516*x^8 - 3367/3*x^7 +
    1001*x^6 - 2764/3*x^5 + 578*x^4 - 614/3*x^3 + 143/3*x^2 - 8*x + 2/3)*y^2 +
    (5900338500460976966714/12757400804975325345*x^19 +
    17929836370386347594413277263377269842119739013/445730525247267700754567973\
    0601550496354000*x^18 - 81358838472809051129964050211777615275870306051/445\
    7305252472677007545679730601550496354000*x^17 +
    502181028440067297733317335459133642474571085989/66859578787090155113185195\
    95902325744531000*x^16 - 6789919188942294084219027359297705152409710067/303\
    90717630495525051447816345010571566050*x^15 +
    6472468464934011229123597623988744651161058611133/1337191575741803102263703\
    9191804651489062000*x^14 - 149717828144481278690280118725157813489318822519\
    /165085379721210259538728878911168536902000*x^13 +
    1392509126792184295135423649202254996130018654473/1028608904416771617125926\
    091677280883774000*x^12 - 1102092371674886085409529268416993830355646529944\
    1/6685957878709015511318519595902325744531000*x^11 +
    11764520888825611678520855461348270286393416041041/668595787870901551131851\
    9595902325744531000*x^10 - 93100507946360062769947269046583990646205207871/\
    59430736699635693433942396408020673284720*x^9 +
    583408698201675175852936185440914225993536353/46133916706634573133127614944\
    9875849200*x^8 - 12747928530734883580346328654185430426539519651/1142898782\
    6853017968065845463080898708600*x^7 + 1211081901855481507952263014517843970\
    3697319212349/13371915757418031022637039191804651489062000*x^6 -
    1616422191880096019627280175384117189035384131/3116996680050823082199776035\
    385699647800*x^5 + 624901601363539751199386127346938661719780053729/3342978\
    939354507755659259797951162872265500*x^4 -
    116073075164428488292968786751029502638400449547/26743831514836062045274078\
    38360930297812400*x^3 + 32750385557898196482575416007491292407811674463/445\
    7305252472677007545679730601550496354000*x^2 -
    347866505727429134700808107255597046741125691/51430445220838580856296304583\
    8640441887000*x - 2994937590094527865428013/1698034251504345415602552)/(x^1\
    8 + 9*x^17 - 110/3*x^16 + 152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12
    + 7414/3*x^11 - 2930*x^10 + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 -
    5767/3*x^6 + 4498/3*x^5 - 2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x -
    2/3)*y + (-171299299018174502726/3937469384251643625*x^16 -
    82204486522224843968969548577759918717/167974541840873279953936588228702215\
    *x^15 + 148092213909187945859463696096508444629409/264559903399375415927450\
    126460205988625*x^14 - 24023895725442285999410790336076030894237/5187449086\
    262263057400982871768744875*x^13 + 4100821440769935302519712598942707444063\
    23/52911980679875083185490025292041197725*x^12 -
    4153405156646563861425120668922349611833692/2645599033993754159274501264602\
    05988625*x^11 + 1395611017351731628410663273700181770905419/529119806798750\
    83185490025292041197725*x^10 - 1201508951050627371058244745845215115161322/\
    52911980679875083185490025292041197725*x^9 +
    8704855925495137217562586748510105855043302/2645599033993754159274501264602\
    05988625*x^8 - 5064035187895960726269052745641747263169261/2645599033993754\
    15927450126460205988625*x^7 + 4405760069179645084470021440524606692191656/2\
    64559903399375415927450126460205988625*x^6 -
    13271471494802105683887974098112030692321/741064155180323293914426124538392\
    125*x^5 + 210242546370091108409680784683192134520757/1556234725878678917220\
    2948615306234625*x^4 - 11703272027218095027828772408663528724023/3112469451\
    757357834440589723061246925*x^3 + 21261310424607913385090577656667157274984\
    2/264559903399375415927450126460205988625*x^2 -
    30473904972794428119575315794781856226546/264559903399375415927450126460205\
    988625*x - 2/3)/(x^16 + 11*x^15 - 47/3*x^14 + 329/3*x^13 - 614/3*x^12 +
    1216/3*x^11 - 2089/3*x^10 + 2020/3*x^9 - 887*x^8 + 629*x^7 - 1480/3*x^6 +
    1523/3*x^5 - 1241/3*x^4 + 493/3*x^3 - 121/3*x^2 + 22/3*x - 2/3);
genx4:=x - 1;
geny4:=3937469384251643625/21664616488358927827*x^2/(x^18 + 9*x^17 - 110/3*x^16
    + 152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 + 7414/3*x^11 -
    2930*x^10 + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6 + 4498/3*x^5 -
    2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y^7 +
    (39208254502302515471869/10529003613342438923922*x^18 +
    197020576654157417607421/5264501806671219461961*x^17 -
    1550231025344819654145184/15793505420013658385883*x^16 +
    7165263915828447247054750/15793505420013658385883*x^15 -
    35961358595111949073129823/31587010840027316771766*x^14 +
    33760071321947883423544547/15793505420013658385883*x^13 -
    122119981140115000165413253/31587010840027316771766*x^12 +
    5059723162290863974139825/1089207270345769543854*x^11 -
    18032068621759466579229541/3509667871114146307974*x^10 +
    26364642392747230270545800/5264501806671219461961*x^9 -
    106754768212982732830418641/31587010840027316771766*x^8 +
    102231092222689649620015103/31587010840027316771766*x^7 -
    47233514986462243020244648/15793505420013658385883*x^6 +
    26898063467527381752976163/15793505420013658385883*x^5 -
    7115694098903368219605077/15793505420013658385883*x^4 +
    2875033615691074479454555/31587010840027316771766*x^3 -
    186624067873028413226947/15793505420013658385883*x^2 -
    7874938768503287250/21664616488358927827*x)/(x^16 + 11*x^15 - 47/3*x^14 +
    329/3*x^13 - 614/3*x^12 + 1216/3*x^11 - 2089/3*x^10 + 2020/3*x^9 - 887*x^8 +
    629*x^7 - 1480/3*x^6 + 1523/3*x^5 - 1241/3*x^4 + 493/3*x^3 - 121/3*x^2 +
    22/3*x - 2/3)*y^6 + (82013005192645069448294/5264501806671219461961*x^20 +
    1259232492008659915867045/10529003613342438923922*x^19 -
    11891731873755816909051025/15793505420013658385883*x^18 +
    99762672536385939449089675/31587010840027316771766*x^17 -
    5506247432550576376148057/544603635172884771927*x^16 +
    758016767287470987819704837/31587010840027316771766*x^15 -
    745844664262869961122148829/15793505420013658385883*x^14 +
    1213730812790232739398610564/15793505420013658385883*x^13 -
    3228052374077525209695758819/31587010840027316771766*x^12 +
    1833820465037332652441343860/15793505420013658385883*x^11 -
    14747072265543401948909747/129987698930153566962*x^10 +
    508784069530753148854046390/5264501806671219461961*x^9 -
    31660992562446469139752151/389963096790460700886*x^8 +
    242057449560980878338197767/3509667871114146307974*x^7 -
    1539078723129709008880786921/31587010840027316771766*x^6 +
    382293869098571569399187191/15793505420013658385883*x^5 -
    249873229460101123961884519/31587010840027316771766*x^4 +
    9133866635774431345384667/5264501806671219461961*x^3 -
    2877475400534289919023133/10529003613342438923922*x^2 +
    338803153572623448022394/15793505420013658385883*x +
    3937469384251643625/21664616488358927827)/(x^18 + 9*x^17 - 110/3*x^16 +
    152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 + 7414/3*x^11 - 2930*x^10
    + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6 + 4498/3*x^5 -
    2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y^5 +
    (64833234719447908629385/2339778580742764205316*x^20 +
    669908175987349106903039/3509667871114146307974*x^19 -
    31619009031438100899542407/21058007226684877847844*x^18 +
    35442569989197683592392545/5264501806671219461961*x^17 -
    1423076072560507281299512183/63174021680054633543532*x^16 +
    201355312189091324609990611/3509667871114146307974*x^15 -
    1874793089114799464493478264/15793505420013658385883*x^14 +
    12898293175998834388304321933/63174021680054633543532*x^13 -
    9196647621427596648810243335/31587010840027316771766*x^12 +
    22058819955592004681473583579/63174021680054633543532*x^11 -
    3800115228008262643248101867/10529003613342438923922*x^10 +
    20542381480092831225297012341/63174021680054633543532*x^9 -
    17125246954937777099422548755/63174021680054633543532*x^8 +
    14476390883306131074702401147/63174021680054633543532*x^7 -
    2822125221083810302119104258/15793505420013658385883*x^6 +
    6652695460044719422809852725/63174021680054633543532*x^5 -
    1319077916721943032841109009/31587010840027316771766*x^4 +
    685463290160174641195128005/63174021680054633543532*x^3 -
    64675613500033032208375565/31587010840027316771766*x^2 +
    7858810302466969044435845/31587010840027316771766*x -
    175142407148550620416447/15793505420013658385883)/(x^18 + 9*x^17 -
    110/3*x^16 + 152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 +
    7414/3*x^11 - 2930*x^10 + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6
    + 4498/3*x^5 - 2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y^4 +
    (-22056980513955960949246/584944645185691051329*x^20 -
    2906607789762703087394213/7019335742228292615948*x^19 +
    4192907845117421775648611/5264501806671219461961*x^18 -
    46558460165472317921916947/21058007226684877847844*x^17 +
    66384052779194033680391965/31587010840027316771766*x^16 +
    230574992280663722686853215/21058007226684877847844*x^15 -
    659941684504302144941566594/15793505420013658385883*x^14 +
    1777936382866715610688812128/15793505420013658385883*x^13 -
    13773146001034497130000549807/63174021680054633543532*x^12 +
    4882551160852704781634531711/15793505420013658385883*x^11 -
    7863913552539740003862384227/21058007226684877847844*x^10 +
    5864378132302406585360235533/15793505420013658385883*x^9 -
    19098385705532624331062754383/63174021680054633543532*x^8 +
    16483586700493444962369033527/63174021680054633543532*x^7 -
    15216231069051586319732451815/63174021680054633543532*x^6 +
    5410518275248211652784685641/31587010840027316771766*x^5 -
    4996614156335415798060481735/63174021680054633543532*x^4 +
    367509034630524191668250090/15793505420013658385883*x^3 -
    305127581875839347843412091/63174021680054633543532*x^2 +
    10809579982433619349268269/15793505420013658385883*x -
    1418070579047687974370963/31587010840027316771766)/(x^18 + 9*x^17 -
    110/3*x^16 + 152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 +
    7414/3*x^11 - 2930*x^10 + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6
    + 4498/3*x^5 - 2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y^3 +
    (-590091507912328089736577/4679557161485528410632*x^19 -
    16866732424769016239733733/14038671484456585231896*x^18 +
    42288055227227384215644953/10529003613342438923922*x^17 -
    177006763226258883573052505/10529003613342438923922*x^16 +
    5754478144856597219271385967/126348043360109267087064*x^15 -
    11161156220870253732092986123/126348043360109267087064*x^14 +
    19824007339246858064273065417/126348043360109267087064*x^13 -
    2134114626681173420050579379/10529003613342438923922*x^12 +
    13516716399068115722625305029/63174021680054633543532*x^11 -
    888411658782583839371441437/4356829081383078175416*x^10 +
    17745939501501628266387080077/126348043360109267087064*x^9 -
    182873356182839030798026393/1754833935557073153987*x^8 +
    13882717583645760871316207875/126348043360109267087064*x^7 -
    363721195181885329840116734/5264501806671219461961*x^6 +
    98195674907423213030672009/15793505420013658385883*x^5 +
    73963038255868296895532681/4679557161485528410632*x^4 -
    1044727701430453877783380351/126348043360109267087064*x^3 +
    35761653218365806341716955/15793505420013658385883*x^2 -
    3063196517586685694047009/7019335742228292615948*x +
    1268216050703634485170519/31587010840027316771766)/(x^17 + 10*x^16 -
    80/3*x^15 + 376/3*x^14 - 943/3*x^13 + 610*x^12 - 3305/3*x^11 + 4109/3*x^10 -
    4681/3*x^9 + 1516*x^8 - 3367/3*x^7 + 1001*x^6 - 2764/3*x^5 + 578*x^4 -
    614/3*x^3 + 143/3*x^2 - 8*x + 2/3)*y^2 +
    (-29730054632823889356857/42116014453369755695688*x^19 -
    1428670860135979734887/584944645185691051329*x^18 +
    7410346037235636202037881/126348043360109267087064*x^17 -
    5752170620897080360950893/21058007226684877847844*x^16 +
    124882555874521309218401503/126348043360109267087064*x^15 -
    85942225746688330959817763/31587010840027316771766*x^14 +
    183396989847505521842569627/31587010840027316771766*x^13 -
    1319565395671570230763234301/126348043360109267087064*x^12 +
    18018158521243590178006103/1169889290371382102658*x^11 -
    2367508553515142023874315507/126348043360109267087064*x^10 +
    312147567693226264780015015/15793505420013658385883*x^9 -
    2256396243101658037237482125/126348043360109267087064*x^8 +
    1844486013254072047003875809/126348043360109267087064*x^7 -
    54609263613768579162731221/4356829081383078175416*x^6 +
    639720737839665710279149823/63174021680054633543532*x^5 -
    755384523432854683778335481/126348043360109267087064*x^4 +
    71283995983352174480626771/31587010840027316771766*x^3 -
    67474456005753977309574985/126348043360109267087064*x^2 +
    2945237435188045188231319/31587010840027316771766*x -
    194409353320147154925595/21058007226684877847844)/(x^18 + 9*x^17 -
    110/3*x^16 + 152*x^15 - 1319/3*x^14 + 2773/3*x^13 - 5135/3*x^12 +
    7414/3*x^11 - 2930*x^10 + 9229/3*x^9 - 7915/3*x^8 + 6370/3*x^7 - 5767/3*x^6
    + 4498/3*x^5 - 2348/3*x^4 + 757/3*x^3 - 167/3*x^2 + 26/3*x - 2/3)*y + (x^16
    + 221956746246416463098/21664616488358927827*x^15 -
    1569932176723137560294/64993849465076783481*x^14 +
    267627926238474584434/2241167222933682189*x^13 -
    18527563783731332782907/64993849465076783481*x^12 +
    35106767669393949560212/64993849465076783481*x^11 -
    63002006341830722887642/64993849465076783481*x^10 +
    73590026367676370495530/64993849465076783481*x^9 -
    27800390998901145341089/21664616488358927827*x^8 +
    26041902332680555455486/21664616488358927827*x^7 -
    53845668605389163517472/64993849465076783481*x^6 +
    51915116786717442012998/64993849465076783481*x^5 -
    47207527167327677334356/64993849465076783481*x^4 +
    26030899213237040634034/64993849465076783481*x^3 -
    6928901049930742440427/64993849465076783481*x^2 +
    1399891048766380553908/64993849465076783481*x -
    177709911316726198136/64993849465076783481)/(x^16 + 11*x^15 - 47/3*x^14 +
    329/3*x^13 - 614/3*x^12 + 1216/3*x^11 - 2089/3*x^10 + 2020/3*x^9 - 887*x^8 +
    629*x^7 - 1480/3*x^6 + 1523/3*x^5 - 1241/3*x^4 + 493/3*x^3 - 121/3*x^2 +
    22/3*x - 2/3);
genx5:=1/x; 
geny5:=1/5/x^2*y^7 + (-1/5*x^3 + 4/5*x^2 - 1/5*x - 4/5)/x^4*y^6 + (-3*x^3 +
    9/5*x^2 - 2/5*x - 14/5)/x^4*y^5 + (18/5*x^4 - 21/5*x^3 + 18/5*x^2 + 49/5*x -
    1)/x^4*y^4 + (-8/5*x^3 + 16/5*x^2 - 24/5*x - 42/5)/x^2*y^3 + (1/5*x^2 -
    4/5*x + 12/5)*y^2 + (-1/5*x + 7/5)*y - 1/5*x + 2;
genx6:=1/x; 
geny6:=1/5/x^2*y^7 + (-1/5*x^3 + 4/5*x^2 - 1/5*x - 4/5)/x^4*y^6 + (-3*x^3 +
    9/5*x^2 - 2/5*x - 19/5)/x^4*y^5 + (18/5*x^4 - 21/5*x^3 + 18/5*x^2 + 54/5*x -
    4)/x^4*y^4 + (-8/5*x^4 + 16/5*x^3 - 24/5*x^2 - 42/5*x + 15)/x^3*y^3 +
    (1/5*x^4 - 4/5*x^3 + 12/5*x^2 - 18)/x^2*y^2 + (-1/5*x^2 + 7/5*x + 8)/x*y -
    1/5*x + 1;
genx7:=1/x;
geny7:=1/5/x^2*y^7 + (-1/5*x^3 + 4/5*x^2 - 1/5*x - 4/5)/x^4*y^6 + (-3*x^3 +
    9/5*x^2 - 2/5*x - 9/5)/x^4*y^5 + (18/5*x^4 - 21/5*x^3 + 18/5*x^2 + 44/5*x +

    5)/x^4*y^4 + (-8/5*x^4 + 16/5*x^3 - 24/5*x^2 - 42/5*x - 15)/x^3*y^3 +
    (1/5*x^4 - 4/5*x^3 + 12/5*x^2 + 18)/x^2*y^2 + (-1/5*x^2 + 7/5*x - 8)/x*y -
    1/5*x + 2; 


CuspsOfXHl:=[[genx1,geny1],[genx2,geny2],[genx3,geny3],[genx4,geny4],[genx5,geny5],[genx6,geny6],[genx7,geny7]];

//==correspondences between cusps of XH1 represented by two different ways computed using function FindCuspsCorr.m ==

//CorrOfCusps:=[[1,12],[4,10],[11,13],[9,8],[2,5],[6,14],[3,7]];


return <<XHl,X,Y,CuspsOfXHl>,<k,l>>;

end intrinsic;

intrinsic PolyXxXyYxYy()->Tup
{polynomial relations of (X,x),(X,y),(Y,x) and (Y,y)}

R1<X,x>:=PolynomialRing(Rationals(),2);

PolyXx:=5*X^9+3*x^8*X-11*x^7*X-10*X^8-5*X^6-x^6+X^5+42*X^2*x^7-62*X^2*x^8-3*X^2*x^10-9*X^2*x^5+7*X^2*x^6+26*X^2*x^9+26*X^3*x^7+114*X^3*x^8+X^3*x^12-19*X^3*x^11+98*X^3*x^10-3*X^3*x^3+3*X^3*x^4+16*X^3*x^5-57*X^3*x^6-180*X^3*x^9-192*X^4*x^7+127*X^4*x^8-50*X^4*x^12+4*X^4*x^13+178*X^4*x^11-252*X^4*x^10+29*X^4*x^3-39*X^4*x^4-32*X^4*x^5+133*X^4*x^6-X^4*x^2+97*X^4*x^9+381*X^5*x^7-399*X^5*x^8+140*X^5*x^12-59*X^5*x^13-110*X^5*x^11+9*X^5*x^14-104*X^5*x^10+8*X^5*x-45*X^5*x^3+190*X^5*x^4-120*X^5*x^5-183*X^5*x^6-26*X^5*x^2+317*X^5*x^9-223*X^6*x^7+456*X^6*x^8+68*X^6*x^12+18*X^6*x^13-221*X^6*x^11-24*X^6*x^14+347*X^6*x^10-5*X^6*x-83*X^6*x^3-217*X^6*x^4+513*X^6*x^5-284*X^6*x^6+80*X^6*x^2-427*X^6*x^9-X^6*x^16+8*X^6*x^15-599*X^7*x^7+127*X^7*x^8-94*X^7*x^12+54*X^7*x^13+115*X^7*x^11-16*X^7*x^14-152*X^7*x^10-20*X^7*x+247*X^7*x^3-156*X^7*x^4-367*X^7*x^5+778*X^7*x^6-69*X^7*x^2+140*X^7*x^9+2*X^7*x^15+571*X^8*x^7-606*X^8*x^8-13*X^8*x^12+5*X^8*x^13+30*X^8*x^11-X^8*x^14-113*X^8*x^10+40*X^8*x-157*X^8*x^3+373*X^8*x^4-290*X^8*x^5-153*X^8*x^6-21*X^8*x^2+345*X^8*x^9+253*X^9*x^7+17*X^9*x^8+7*X^9*x^12-46*X^9*x^11+127*X^9*x^10-28*X^9*x-33*X^9*x^3-109*X^9*x^4+312*X^9*x^5-402*X^9*x^6+59*X^9*x^2-162*X^9*x^9-202*X^10*x^7+206*X^10*x^8-5*X^10*x^11+37*X^10*x^10+7*X^10*x+53*X^10*x^3-73*X^10*x^4+33*X^10*x^5+87*X^10*x^6-24*X^10*x^2-118*X^10*x^9-56*X^11*x^7+28*X^11*x^8+X^11*x^10-8*X^11*x^3+28*X^11*x^4-56*X^11*x^5+70*X^11*x^6-8*X^11*x^9+2*x^5*X+6*x^6*X-X^10+x^2*X^11+x^2*X^3-2*x*X^4-x^4*X^2+10*X^7;

R2<X,y>:=PolynomialRing(Rationals(),2);

PolyXy:=-13*X^11*y^4-X^11*y^6+11*X^11*y^3+2*X^11*y^2-2*X^12*y+X^12*y^2+X*y^11+X^12-75*X^10*y^4-3*X^10*y^6+39*X^10*y^3+2*X^10*y^8+5*X^11*y^5+2*X^5*y^14+39*X^5*y^13-2*X^5*y^15-168*X^5*y^12+94*X^5*y^6-1033*X^5*y^9+1205*X^5*y^8+57*X^6*y^10-1033*X^6*y^7-7*X^6*y^5+157*X^6*y^11-4*X^4*y^14+X^4*y^16+67*X^4*y^13-4*X^4*y^15-161*X^4*y^12+2*X^4*y^6-625*X^4*y^9+442*X^4*y^8+262*X^5*y^10-625*X^5*y^7+16*X^5*y^5+201*X^5*y^11+y^10+2*X*y^8+X*y^9-X*y^10+X^6*y^14+11*X^6*y^13-75*X^6*y^12+343*X^6*y^6-771*X^6*y^9+1340*X^6*y^8-13*X^7*y^10-771*X^7*y^7+61*X^7*y^5+46*X^7*y^11-13*X^7*y^12-46*X^7*y^4+262*X^7*y^6-304*X^7*y^9+769*X^7*y^8-168*X^9*y^4-13*X^9*y^6+67*X^9*y^3-5*X^9*y^9+31*X^9*y^8-5*X^10*y^7+46*X^10*y^5+2*X^2*y^10+X^2*y^7+16*X^2*y^11-X*y^12-13*y^4*X^6+4*y^3*X^7+31*y^3*X^8-7*y^2*X^9-4*y^2*X^10-4*y*X^11+y^6*X^2-y^6*X^3+y^5*X^4-y^4*X^5-3*X^8*y^10-304*X^8*y^7+201*X^8*y^5+5*X^8*y^11-161*X^8*y^4+57*X^8*y^6-61*X^8*y^9+236*X^8*y^8-X^9*y^10-61*X^9*y^7+157*X^9*y^5-2*X*y^7-2*y^9+y^8+4*X^2*y^13-13*X^2*y^12-16*X^2*y^9+5*X^2*y^8+94*X^3*y^10-16*X^3*y^7-7*X^3*y^11-7*X^3*y^14+31*X^3*y^13-46*X^3*y^12-118*X^3*y^9+69*X^3*y^8+343*X^4*y^10-118*X^4*y^7+61*X^4*y^11;


R3<Y,x>:=PolynomialRing(Rationals(),2);

PolyYx:= -Y^11-10*x^12*Y+x*Y^6+6*x*Y^7-x^7*Y^2+3*x^6*Y^3-5*x^5*Y^4-x^2*Y^5-x^12+x^13+5*x^11*Y+6*x^13*Y-Y*x^14-41*Y^2*x^12+18*Y^2*x^13-5*Y^2*x^9-5*Y^2*x^10+34*Y^2*x^11+3*Y^2*x^8-3*Y^2*x^14-87*Y^3*x^12+28*Y^3*x^13-38*Y^3*x^9-35*Y^3*x^10+109*Y^3*x^11-16*Y^3*x^7+39*Y^3*x^8-3*Y^3*x^14-102*Y^4*x^12+21*Y^4*x^13-104*Y^4*x^9-109*Y^4*x^10+192*Y^4*x^11+39*Y^4*x^6-121*Y^4*x^7+190*Y^4*x^8-Y^4*x^14-58*Y^5*x^12+5*Y^5*x^13+5*Y^5*x^3-130*Y^5*x^9-183*Y^5*x^10+184*Y^5*x^11-5*Y^5*x^4-38*Y^5*x^5+190*Y^5*x^6-415*Y^5*x^7+445*Y^5*x^8-10*Y^6*x^12+34*Y^6*x^3-50*Y^6*x^9-157*Y^6*x^10+80*Y^6*x^11-35*Y^6*x^4-104*Y^6*x^5+445*Y^6*x^6-717*Y^6*x^7+523*Y^6*x^8-10*Y^6*x^2+109*Y^7*x^3+18*Y^7*x^9-54*Y^7*x^10+10*Y^7*x^11-109*Y^7*x^4-130*Y^7*x^5+523*Y^7*x^6-623*Y^7*x^7+291*Y^7*x^8-41*Y^7*x^2+18*Y^8*x+192*Y^8*x^3+11*Y^8*x^9-5*Y^8*x^10-183*Y^8*x^4-50*Y^8*x^5+291*Y^8*x^6-255*Y^8*x^7+69*Y^8*x^8-87*Y^8*x^2+28*Y^9*x+184*Y^9*x^3+Y^9*x^9-157*Y^9*x^4+18*Y^9*x^5+69*Y^9*x^6-43*Y^9*x^7+5*Y^9*x^8-102*Y^9*x^2+21*Y^10*x+80*Y^10*x^3-54*Y^10*x^4+11*Y^10*x^5+5*Y^10*x^6-2*Y^10*x^7-58*Y^10*x^2+5*Y^11*x+10*Y^11*x^3-5*Y^11*x^4+Y^11*x^5-10*Y^11*x^2-Y^8-3*Y^9-3*Y^10;

R4<Y,y>:=PolynomialRing(Rationals(),2);

PolyYy:=3*Y*y^12+199*Y*y^10-2352*Y*y^7-2124*Y*y^5-36*Y*y^11+1191*Y*y^4+2646*Y*y^6-444*Y*y^3-666*Y*y^9+1494*Y*y^8+99*Y*y^2+45*Y^2*y^12-3*Y^2*y^13+1309*Y^2*y^10-11254*Y^2*y^7-9684*Y^2*y^5-311*Y^2*y^11-25*Y^6*y^13+5829*Y^6*y^10-51854*Y^6*y^7-52126*Y^6*y^5-1491*Y^6*y^11+Y^6*y^14+32580*Y^6*y^4+60309*Y^6*y^6-548*Y^6*y-13995*Y^6*y^3-16260*Y^6*y^9+33516*Y^6*y^8+3775*Y^6*y^2+76*Y^7*y^12-5*Y^7*y^13+2516*Y^7*y^10-29368*Y^7*y^7-33273*Y^7*y^5-555*Y^7*y^11+21921*Y^7*y^4+36393*Y^7*y^6-470*Y^7*y-9958*Y^7*y^3-7837*Y^7*y^9+17637*Y^7*y^8+2888*Y^7*y^2+10*Y^8*y^12+670*Y^8*y^10-11290*Y^8*y^7-14876*Y^8*y^5-117*Y^8*y^11+10435*Y^8*y^4+15166*Y^8*y^6-280*Y^8*y-5034*Y^8*y^3-2435*Y^8*y^9+6163*Y^8*y^8+1567*Y^8*y^2+99*Y^9*y^10-2845*Y^9*y^7-4457*Y^9*y^5-10*Y^9*y^11+10*y^10-210*y^7-210*y^5-y^11+206*Y^3*y^12-22*Y^3*y^13+4196*Y^3*y^10-30729*Y^3*y^7-26210*Y^3*y^5-1137*Y^3*y^11+Y^3*y^14+14804*Y^3*y^4+33084*Y^3*y^6-135*Y^3*y-5624*Y^3*y^3-11023*Y^3*y^9+21303*Y^3*y^8+1285*Y^3*y^2-10*y*Y-46*y*Y^2-2*y*Y^11+y^2*Y^12+120*y^4+252*y^6+35*Y^6-y+3369*Y^9*y^4+4186*Y^9*y^6-108*Y^9*y-1744*Y^9*y^3-470*Y^9*y^9+1392*Y^9*y^8+581*Y^9*y^2+5*Y^10*y^10-460*Y^10*y^7-845*Y^10*y^5+672*Y^10*y^4+751*Y^10*y^6-22*Y^10*y-369*Y^10*y^3-44*Y^10*y^9+184*Y^10*y^8+127*Y^10*y^2-33*Y^11*y^7-113*Y^11*y^5+98*Y^11*y^4+79*Y^11*y^6-51*Y^11*y^3-Y^11*y^9+8*Y^11*y^8+15*Y^11*y^2-4*Y^12*y^5+6*Y^12*y^4+Y^12*y^6-4*Y^12*y^3+5413*Y^2*y^4+12247*Y^2*y^6-2025*Y^2*y^3-3733*Y^2*y^9+7588*Y^2*y^8+454*Y^2*y^2+427*Y^4*y^12-52*Y^4*y^13+7645*Y^4*y^10-53628*Y^4*y^7-46883*Y^4*y^5-2176*Y^4*y^11+3*Y^4*y^14+27104*Y^4*y^4+58215*Y^4*y^6-287*Y^4*y-10601*Y^4*y^3-19521*Y^4*y^9+37231*Y^4*y^8+2516*Y^4*y^2+454*Y^5*y^12-54*Y^5*y^13+8451*Y^5*y^10-63350*Y^5*y^7-58503*Y^5*y^5-2359*Y^5*y^11+3*Y^5*y^14+34998*Y^5*y^4+70561*Y^5*y^6-460*Y^5*y-14277*Y^5*y^3-22031*Y^5*y^9+42956*Y^5*y^8+3589*Y^5*y^2+254*Y^6*y^12-45*y^3-45*y^9+120*y^8+35*Y^7+21*Y^8+7*Y^9+Y^10+10*y^2+21*Y^5+Y^3+7*Y^4;

return <PolyXx,PolyXy,PolyYx,PolyYy>;

end intrinsic;

intrinsic EquationsForX1()->SeqEnum
{equations for X_1(N) for N<=31 copyied from Sutherland's website}

R<x,y>:=PolynomialRing(Rationals(),2);

r:=(x^2*y-x*y+y-1)/(x*(x*y-1));
s:=(x*y-y+1)/(x*y);
b:=r*s*(r-1);//-1*(x-1)*(y-1)*x^(-3)*y^(-1)*(x*y-1)^(-2)*(x*y-y+1)*(x^2*y-x*y+y-1);
c:=s*(r-1);//-1*(x-1)*(y-1)*x^(-2)*y^(-1)*(x*y-1)^(-1)*(x*y-y+1);
//x:=(s-r)/(r*s-2*r+1);
//y:=(r*s-2*r+1)/(s^2-s-r+1);
f:=[];
f[2-1] := b/(16*b^2+(1-20*c-8*c^2)*b+c*(c-1)^3);
f[3-1] := b;
f[4-1] := c;
f[5-1] := b-c;
f[6-1] := s-1;
f[7-1] := s-r;
f[8-1] := r*s-2*r+1;
f[9-1] := s^2-s-r+1;
f[10-1] := x-y+1;
f[11-1] := x^2*y-x*y^2+y-1;
f[12-1] := x-y;
f[13-1] := x^3*y-x^2*y^2-x^2*y+x*y^2-y+1;
f[14-1] := x^2*y-x*y^2-x*y+y^2-1;
f[15-1] := x^2*y-x^2-x*y^2+x*y-x+y-1;
f[16-1] := x^2*y^2-2*x^2*y-x*y^3+2*x*y^2-y+1;
f[17-1] := x^4*y-x^3*y^3-x^3*y+x^2*y^4+x^2*y-x^2-x*y^4+x*y^3-x*y^2+x*y+y^3-2*y^2+y;
f[18-1] := x^4*y-3*x^3*y^2+x^3*y+2*x^2*y^3+x^2*y^2-2*x^2*y-2*x*y^3+2*x*y^2+y^2-2*y+1;
f[19-1] := x^5*y^2-3*x^4*y^3+3*x^3*y^4+2*x^3*y^2-2*x^3*y-x^2*y^5-x^2*y^4-x^2*y^3+x^2*y^2+x^2*y+x*y^5-x*y^4+2*x*y^3-2*x*y^2-x*y+x-y^4+2*y^3-y^2;
f[20-1] := x^4*y-2*x^3*y^2-x^3*y+x^2*y^3+x^2*y^2+2*x^2*y-x^2-2*x*y^2+x*y+y-1;
f[21-1] := x^5*y^2-3*x^4*y^3-x^4*y^2+3*x^3*y^4+3*x^3*y^3-x^2*y^5-3*x^2*y^4-2*x^2*y^2+3*x^2*y+x*y^5+3*x*y^3-4*x*y^2-y^4+y^3+y-1;
f[22-1] := x^5*y^2-x^5*y-2*x^4*y^3+2*x^4*y+x^3*y^4+3*x^3*y^3-4*x^3*y^2+x^3-2*x^2*y^4+x^2*y^3+x^2*y^2-x^2*y+x*y^4-x*y^3+x*y^2-x*y-y^3+2*y^2-y;
f[23-1]:=x^7*y^4 - 2*x^7*y^3 + x^7*y^2 - 3*x^6*y^5 + 4*x^6*y^4 + 3*x^5*y^6 - 5*x^5*y^4 - 
    3*x^5*y^3 + 3*x^5*y^2 - x^5*y - x^4*y^7 - 4*x^4*y^6 + 5*x^4*y^5 + 6*x^4*y^4 
    - x^4*y^3 - x^4*y^2 - x^4*y + 2*x^3*y^7 - 3*x^3*y^5 - 6*x^3*y^4 + 2*x^3*y^3 
    + 5*x^3*y^2 - x^3*y - x^2*y^7 + 3*x^2*y^5 + 2*x^2*y^4 - x^2*y^3 - 7*x^2*y^2 
    + 4*x^2*y + x*y^6 - 2*x*y^5 - 3*x*y^4 + 8*x*y^3 - 4*x*y^2 + y^3 - 3*y^2 + 
    3*y - 1;
f[24-1]:=x^5*y^4 - 3*x^5*y^3 + 3*x^5*y^2 - 2*x^4*y^5 + 5*x^4*y^4 - 5*x^4*y^3 + x^3*y^6 - 
    x^3*y^5 + x^3*y^4 - x^3*y^3 + 4*x^3*y^2 - 3*x^3*y - x^2*y^6 + x^2*y^5 - 
    x^2*y^4 + x^2*y^3 - x^2*y^2 + x^2*y + 2*x*y^5 - 5*x*y^4 + 5*x*y^3 - 2*x*y^2 
    - x*y + x - y^4 + 3*y^3 - 3*y^2 + y;
f[25-1]:=x^8*y^2 + x^7*y^5 - 4*x^7*y^4 - x^7*y^2 - 3*x^6*y^6 + 11*x^6*y^5 - 2*x^6*y^4 + 
    2*x^6*y^2 - 2*x^6*y + 3*x^5*y^7 - 9*x^5*y^6 - 4*x^5*y^5 + 4*x^5*y^4 - 
    2*x^5*y^3 + 4*x^5*y^2 - x^4*y^8 + x^4*y^7 + 9*x^4*y^6 - 5*x^4*y^5 + 
    6*x^4*y^4 - 15*x^4*y^3 + 7*x^4*y^2 - 2*x^4*y + x^4 + x^3*y^8 - 4*x^3*y^7 + 
    3*x^3*y^6 - 14*x^3*y^5 + 26*x^3*y^4 - 15*x^3*y^3 + 7*x^3*y^2 - 5*x^3*y + x^3
    - x^2*y^7 + 8*x^2*y^6 - 13*x^2*y^5 + 12*x^2*y^4 - 18*x^2*y^3 + 19*x^2*y^2 - 
    8*x^2*y + x^2 - 4*x*y^5 + 13*x*y^4 - 16*x*y^3 + 10*x*y^2 - 4*x*y + x + y^4 -
    4*y^3 + 6*y^2 - 4*y + 1;
f[26-1]:=x^6*y^2 - 5*x^5*y^3 + 2*x^5*y^2 + x^4*y^5 + 5*x^4*y^4 - 2*x^4*y^2 - x^4*y - 
    2*x^3*y^6 - 4*x^3*y^4 + 9*x^3*y^2 - 4*x^3*y + x^2*y^7 + 5*x^2*y^4 - 
    11*x^2*y^3 + 4*x^2*y^2 + x^2*y - x*y^7 + 2*x*y^6 - 4*x*y^5 + 6*x*y^4 - 
    3*x*y^3 + x*y^2 - 2*x*y + x + y^6 - 3*y^5 + 3*y^4 - y^3;
f[27-1]:=x^10*y^3 - 6*x^9*y^4 + 15*x^8*y^5 + 3*x^8*y^3 - 3*x^8*y^2 - 19*x^7*y^6 - 
    6*x^7*y^5 - 3*x^7*y^4 + 5*x^7*y^3 + 3*x^7*y^2 + 12*x^6*y^7 + 18*x^6*y^6 - 
    6*x^6*y^5 + 3*x^6*y^4 - 12*x^6*y^3 - 3*x^6*y^2 + 3*x^6*y - 3*x^5*y^8 - 
    18*x^5*y^7 + 6*x^5*y^6 - 12*x^5*y^5 + 27*x^5*y^4 - 3*x^5*y^3 - x^5*y^2 - 
    2*x^5*y + 6*x^4*y^8 + 3*x^4*y^7 + 10*x^4*y^6 - 24*x^4*y^5 + 3*x^4*y^4 - 
    2*x^4*y^3 + 5*x^4*y^2 + x^4*y - x^4 - 3*x^3*y^8 - 3*x^3*y^7 + 15*x^3*y^5 - 
    6*x^3*y^4 - 3*x^3*y^3 - x^3*y^2 + x^3*y + 6*x^2*y^7 - 12*x^2*y^6 + 
    10*x^2*y^5 - 13*x^2*y^4 + 15*x^2*y^3 - 7*x^2*y^2 + x^2*y - 4*x*y^6 + 
    13*x*y^5 - 16*x*y^4 + 10*x*y^3 - 4*x*y^2 + x*y + y^5 - 4*y^4 + 6*y^3 - 4*y^2
    + y;
f[28-1]:=x^8*y^2 - 5*x^7*y^3 + 10*x^6*y^4 + 2*x^6*y^2 - x^6*y - 10*x^5*y^5 - 10*x^5*y^3 +
    8*x^5*y^2 - x^5*y + 5*x^4*y^6 + x^4*y^5 + 13*x^4*y^4 - 9*x^4*y^3 - x^4*y^2 -
    x^4*y - x^3*y^7 - 2*x^3*y^6 - 4*x^3*y^5 - 4*x^3*y^4 + 8*x^3*y^3 + 2*x^3*y^2 
    - x^3*y + x^2*y^7 - x^2*y^6 + 8*x^2*y^5 - 11*x^2*y^4 + 8*x^2*y^3 - 
    10*x^2*y^2 + 5*x^2*y - 2*x*y^6 + 5*x*y^5 - 10*x*y^4 + 14*x*y^3 - 8*x*y^2 + 
    x*y + y^5 - 3*y^4 + 4*y^3 - 4*y^2 + 3*y - 1;
f[29-1]:=x^12*y^5 - x^12*y^4 - 6*x^11*y^6 + 4*x^11*y^5 + 2*x^11*y^4 + 15*x^10*y^7 - 
    3*x^10*y^6 - 10*x^10*y^5 - 3*x^10*y^4 + x^10*y^3 - 20*x^9*y^8 - 10*x^9*y^7 +
    18*x^9*y^6 + 14*x^9*y^5 + 4*x^9*y^4 - 7*x^9*y^3 + 15*x^8*y^9 + 25*x^8*y^8 - 
    10*x^8*y^7 - 27*x^8*y^6 - 23*x^8*y^5 + 18*x^8*y^4 + 6*x^8*y^3 - 6*x^7*y^10 -
    24*x^7*y^9 - 9*x^7*y^8 + 21*x^7*y^7 + 46*x^7*y^6 - 17*x^7*y^5 - 7*x^7*y^4 - 
    20*x^7*y^3 + 10*x^7*y^2 + x^6*y^11 + 11*x^6*y^10 + 15*x^6*y^9 + 4*x^6*y^8 - 
    51*x^6*y^7 + 8*x^6*y^6 - 15*x^6*y^5 + 54*x^6*y^4 - 18*x^6*y^3 - 5*x^6*y^2 - 
    2*x^5*y^11 - 7*x^5*y^10 - 15*x^5*y^9 + 26*x^5*y^8 + 39*x^5*y^6 - 63*x^5*y^5 
    + 14*x^5*y^4 + 12*x^5*y^2 - 5*x^5*y + x^4*y^11 + 6*x^4*y^10 + x^4*y^9 - 
    4*x^4*y^8 - 29*x^4*y^7 + 26*x^4*y^6 + 6*x^4*y^5 + x^4*y^4 - 12*x^4*y^3 + 
    2*x^4*y^2 + 2*x^4*y - 4*x^3*y^10 + 2*x^3*y^9 + 21*x^3*y^7 - 33*x^3*y^6 + 
    20*x^3*y^5 - 13*x^3*y^4 + 11*x^3*y^3 - 3*x^3*y^2 - 2*x^3*y + x^3 + 6*x^2*y^9
    - 18*x^2*y^8 + 25*x^2*y^7 - 33*x^2*y^6 + 42*x^2*y^5 - 34*x^2*y^4 + 
    15*x^2*y^3 - 3*x^2*y^2 - 4*x*y^8 + 17*x*y^7 - 30*x*y^6 + 30*x*y^5 - 20*x*y^4
    + 9*x*y^3 - 2*x*y^2 + y^7 - 5*y^6 + 10*y^5 - 10*y^4 + 5*y^3 - y^2;
f[30-1]:=x^8*y^4 - x^8*y^3 - 4*x^7*y^5 + x^7*y^4 + 4*x^7*y^3 + 6*x^6*y^6 + 5*x^6*y^5 - 
    11*x^6*y^4 - 7*x^6*y^3 + 3*x^6*y^2 - 4*x^5*y^7 - 11*x^5*y^6 + 9*x^5*y^5 + 
    15*x^5*y^4 + 6*x^5*y^3 - 9*x^5*y^2 + x^4*y^8 + 8*x^4*y^7 - 9*x^4*y^5 - 
    20*x^4*y^4 + 6*x^4*y^3 + 13*x^4*y^2 - 3*x^4*y - 2*x^3*y^8 - 3*x^3*y^7 + 
    x^3*y^6 + 9*x^3*y^5 + 15*x^3*y^4 - 17*x^3*y^3 - 8*x^3*y^2 + 6*x^3*y + 
    x^2*y^8 + 3*x^2*y^6 - 14*x^2*y^5 + 5*x^2*y^4 + 6*x^2*y^3 + 5*x^2*y^2 - 
    7*x^2*y + x^2 - x*y^7 + 2*x*y^6 - x*y^5 + 5*x*y^4 - 10*x*y^3 + 4*x*y^2 + 
    2*x*y - x - y^3 + 3*y^2 - 3*y + 1;
f[31-1]:=x^13*y^7 - 3*x^13*y^6 + 3*x^13*y^5 - x^13*y^4 - 6*x^12*y^8 + 15*x^12*y^7 - 
    10*x^12*y^6 + 15*x^11*y^9 - 27*x^11*y^8 + 12*x^11*y^6 + 12*x^11*y^5 - 
    8*x^11*y^4 + 2*x^11*y^3 - 20*x^10*y^10 + 15*x^10*y^9 + 42*x^10*y^8 - 
    23*x^10*y^7 - 45*x^10*y^6 + 12*x^10*y^5 + 2*x^10*y^4 + 2*x^10*y^3 + 
    15*x^9*y^11 + 15*x^9*y^10 - 70*x^9*y^9 + 6*x^9*y^8 + 49*x^9*y^7 + 42*x^9*y^6
    - 15*x^9*y^5 - 28*x^9*y^4 + 7*x^9*y^3 - x^9*y^2 - 6*x^8*y^12 - 27*x^8*y^11 +
    42*x^8*y^10 + 21*x^8*y^9 + 9*x^8*y^8 - 111*x^8*y^7 - 3*x^8*y^6 + 51*x^8*y^5 
    + 24*x^8*y^4 - 13*x^8*y^3 - 2*x^8*y^2 + x^7*y^13 + 15*x^7*y^12 - 20*x^7*y^10
    - 45*x^7*y^9 + 60*x^7*y^8 + 71*x^7*y^7 - 16*x^7*y^6 - 96*x^7*y^5 + 
    13*x^7*y^4 + 26*x^7*y^3 - 3*x^7*y^2 - 3*x^6*y^13 - 10*x^6*y^12 + 3*x^6*y^11 
    + 14*x^6*y^10 + 50*x^6*y^9 - 111*x^6*y^8 + 3*x^6*y^7 + 47*x^6*y^6 + 
    47*x^6*y^5 - 14*x^6*y^4 - 44*x^6*y^3 + 17*x^6*y^2 + 3*x^5*y^13 + 3*x^5*y^12 
    + 12*x^5*y^11 - 58*x^5*y^10 + 64*x^5*y^9 - 42*x^5*y^8 + 87*x^5*y^7 - 
    97*x^5*y^6 - 32*x^5*y^5 + 87*x^5*y^4 - 22*x^5*y^3 - 5*x^5*y^2 - x^4*y^13 - 
    6*x^4*y^12 + 9*x^4*y^11 - 4*x^4*y^10 + 32*x^4*y^9 - 69*x^4*y^8 + 34*x^4*y^7 
    + 43*x^4*y^6 - 51*x^4*y^5 + 23*x^4*y^4 - 30*x^4*y^3 + 27*x^4*y^2 - 7*x^4*y +
    4*x^3*y^12 - 6*x^3*y^11 + 4*x^3*y^10 - 24*x^3*y^9 + 59*x^3*y^8 - 70*x^3*y^7 
    + 60*x^3*y^6 - 59*x^3*y^5 + 59*x^3*y^4 - 34*x^3*y^3 + 6*x^3*y^2 + x^3*y - 
    6*x^2*y^11 + 24*x^2*y^10 - 46*x^2*y^9 + 70*x^2*y^8 - 96*x^2*y^7 + 
    100*x^2*y^6 - 70*x^2*y^5 + 31*x^2*y^4 - 10*x^2*y^3 + 6*x^2*y^2 - 4*x^2*y + 
    x^2 + 4*x*y^10 - 21*x*y^9 + 48*x*y^8 - 65*x*y^7 + 60*x*y^6 - 39*x*y^5 + 
    16*x*y^4 - 3*x*y^3 - y^9 + 6*y^8 - 15*y^7 + 20*y^6 - 15*y^5 + 6*y^4 - y^3;
f[37-1]:=x^19*y^8 - 2*x^19*y^7 + x^19*y^6 - 10*x^18*y^9 + 17*x^18*y^8 - 4*x^18*y^7 - 
    3*x^18*y^6 + 45*x^17*y^10 - 60*x^17*y^9 - 10*x^17*y^8 + 18*x^17*y^7 + 
    9*x^17*y^6 - 2*x^17*y^5 - 120*x^16*y^11 + 105*x^16*y^10 + 100*x^16*y^9 - 
    24*x^16*y^8 - 61*x^16*y^7 - 13*x^16*y^6 + 14*x^16*y^5 + 210*x^15*y^12 - 
    60*x^15*y^11 - 285*x^15*y^10 - 100*x^15*y^9 + 171*x^15*y^8 + 129*x^15*y^7 - 
    48*x^15*y^6 - 26*x^15*y^5 + x^15*y^4 - 252*x^14*y^13 - 127*x^14*y^12 + 
    419*x^14*y^11 + 440*x^14*y^10 - 130*x^14*y^9 - 484*x^14*y^8 + 38*x^14*y^7 + 
    71*x^14*y^6 + 84*x^14*y^5 - 31*x^14*y^4 + 210*x^13*y^14 + 342*x^13*y^13 - 
    317*x^13*y^12 - 715*x^13*y^11 - 475*x^13*y^10 + 1010*x^13*y^9 + 156*x^13*y^8
    + 27*x^13*y^7 - 392*x^13*y^6 + 53*x^13*y^5 + 45*x^13*y^4 - 120*x^12*y^15 - 
    405*x^12*y^14 + 39*x^12*y^13 + 520*x^12*y^12 + 1427*x^12*y^11 - 
    1036*x^12*y^10 - 575*x^12*y^9 - 569*x^12*y^8 + 877*x^12*y^7 + 50*x^12*y^6 - 
    46*x^12*y^5 - 127*x^12*y^4 + 35*x^12*y^3 + 45*x^11*y^16 + 290*x^11*y^15 + 
    170*x^11*y^14 - 37*x^11*y^13 - 1632*x^11*y^12 - x^11*y^11 + 837*x^11*y^10 + 
    1462*x^11*y^9 - 930*x^11*y^8 - 422*x^11*y^7 - 186*x^11*y^6 + 411*x^11*y^5 - 
    21*x^11*y^4 - 42*x^11*y^3 - 10*x^10*y^17 - 130*x^10*y^16 - 195*x^10*y^15 - 
    205*x^10*y^14 + 773*x^10*y^13 + 1202*x^10*y^12 - 541*x^10*y^11 - 
    1508*x^10*y^10 - 470*x^10*y^9 + 1085*x^10*y^8 + 634*x^10*y^7 - 561*x^10*y^6 
    - 140*x^10*y^5 + 31*x^10*y^4 + 84*x^10*y^3 - 21*x^10*y^2 + x^9*y^18 + 
    34*x^9*y^17 + 115*x^9*y^16 + 145*x^9*y^15 + 65*x^9*y^14 - 1261*x^9*y^13 + 
    31*x^9*y^12 + 130*x^9*y^11 + 2377*x^9*y^10 - 1173*x^9*y^9 - 819*x^9*y^8 - 
    189*x^9*y^7 + 695*x^9*y^6 - 25*x^9*y^5 - 145*x^9*y^4 - 10*x^9*y^3 + 
    21*x^9*y^2 - 4*x^8*y^18 - 39*x^8*y^17 - 52*x^8*y^16 - 210*x^8*y^15 + 
    505*x^8*y^14 + 189*x^8*y^13 + 883*x^8*y^12 - 2109*x^8*y^11 + 88*x^8*y^10 + 
    46*x^8*y^9 + 1928*x^8*y^8 - 1433*x^8*y^7 + 190*x^8*y^6 - 105*x^8*y^5 + 
    175*x^8*y^4 - 32*x^8*y^3 - 26*x^8*y^2 + 7*x^8*y + 6*x^7*y^18 + 17*x^7*y^17 +
    69*x^7*y^16 - 12*x^7*y^15 - 165*x^7*y^14 - 476*x^7*y^13 + 193*x^7*y^12 + 
    890*x^7*y^11 + 700*x^7*y^10 - 2097*x^7*y^9 + 946*x^7*y^8 - 601*x^7*y^7 + 
    1090*x^7*y^6 - 728*x^7*y^5 + 165*x^7*y^4 + 5*x^7*y^3 + 2*x^7*y^2 - 4*x^7*y -
    4*x^6*y^18 - 7*x^6*y^17 - 46*x^6*y^16 + 79*x^6*y^15 - 57*x^6*y^14 + 
    600*x^6*y^13 - 768*x^6*y^12 - 174*x^6*y^11 + 18*x^6*y^10 + 407*x^6*y^9 + 
    943*x^6*y^8 - 1700*x^6*y^7 + 868*x^6*y^6 - 212*x^6*y^5 + 85*x^6*y^4 - 
    40*x^6*y^3 + 6*x^6*y^2 + 3*x^6*y - x^6 + x^5*y^18 + 9*x^5*y^17 - 11*x^5*y^16
    + 59*x^5*y^15 - 231*x^5*y^14 + 230*x^5*y^13 - 324*x^5*y^12 + 904*x^5*y^11 - 
    660*x^5*y^10 - 339*x^5*y^9 + 210*x^5*y^8 + 336*x^5*y^7 - 73*x^5*y^6 - 
    209*x^5*y^5 + 119*x^5*y^4 - 23*x^5*y^3 + x^5*y^2 + x^5*y - 4*x^4*y^17 + 
    4*x^4*y^16 - 6*x^4*y^15 + 24*x^4*y^14 + 64*x^4*y^13 - 174*x^4*y^12 + 
    78*x^4*y^11 - 320*x^4*y^10 + 1040*x^4*y^9 - 1154*x^4*y^8 + 658*x^4*y^7 - 
    453*x^4*y^6 + 401*x^4*y^5 - 194*x^4*y^4 + 40*x^4*y^3 - 5*x^4*y^2 + x^4*y + 
    6*x^3*y^16 - 26*x^3*y^15 + 64*x^3*y^14 - 137*x^3*y^13 + 159*x^3*y^12 + 
    48*x^3*y^11 - 366*x^3*y^10 + 621*x^3*y^9 - 997*x^3*y^8 + 1322*x^3*y^7 - 
    1095*x^3*y^6 + 527*x^3*y^5 - 160*x^3*y^4 + 44*x^3*y^3 - 11*x^3*y^2 + x^3*y -
    4*x^2*y^15 + 24*x^2*y^14 - 67*x^2*y^13 + 122*x^2*y^12 - 129*x^2*y^11 - 
    52*x^2*y^10 + 444*x^2*y^9 - 767*x^2*y^8 + 795*x^2*y^7 - 647*x^2*y^6 + 
    466*x^2*y^5 - 263*x^2*y^4 + 94*x^2*y^3 - 17*x^2*y^2 + x^2*y + x*y^14 - 
    7*x*y^13 + 21*x*y^12 - 35*x*y^11 + 26*x*y^10 + 43*x*y^9 - 190*x*y^8 + 
    342*x*y^7 - 371*x*y^6 + 259*x*y^5 - 119*x*y^4 + 37*x*y^3 - 8*x*y^2 + x*y + 
    y^9 - 8*y^8 + 28*y^7 - 56*y^6 + 70*y^5 - 56*y^4 + 28*y^3 - 8*y^2 + y;
    
f[41-1]:=x^23*y^7 + x^22*y^12 - 6*x^22*y^11 + 15*x^22*y^10 - 20*x^22*y^9 - 3*x^22*y^7 - 
    10*x^21*y^13 + 55*x^21*y^12 - 123*x^21*y^11 + 143*x^21*y^10 + 10*x^21*y^9 + 
    8*x^21*y^7 - 5*x^21*y^6 + 45*x^20*y^14 - 220*x^20*y^13 + 415*x^20*y^12 - 
    384*x^20*y^11 - 204*x^20*y^10 + 13*x^20*y^9 + 30*x^20*y^8 + 9*x^20*y^7 + 
    10*x^20*y^6 - 120*x^19*y^15 + 495*x^19*y^14 - 685*x^19*y^13 + 355*x^19*y^12 
    + 901*x^19*y^11 + 210*x^19*y^10 - 284*x^19*y^9 - 167*x^19*y^8 + 25*x^19*y^7 
    - 25*x^19*y^6 + 10*x^19*y^5 + 210*x^18*y^16 - 660*x^18*y^15 + 360*x^18*y^14 
    + 400*x^18*y^13 - 1887*x^18*y^12 - 1090*x^18*y^11 + 274*x^18*y^10 + 
    1299*x^18*y^9 - 130*x^18*y^8 - 8*x^18*y^7 - 45*x^18*y^6 - 10*x^18*y^5 - 
    252*x^17*y^17 + 462*x^17*y^16 + 690*x^17*y^15 - 1260*x^17*y^14 + 
    2140*x^17*y^13 + 2066*x^17*y^12 + 1608*x^17*y^11 - 3833*x^17*y^10 - 
    518*x^17*y^9 + 72*x^17*y^8 + 617*x^17*y^7 - 96*x^17*y^6 + 30*x^17*y^5 - 
    10*x^17*y^4 + 210*x^16*y^18 - 1554*x^16*y^16 + 864*x^16*y^15 - 
    1335*x^16*y^14 - 1620*x^16*y^13 - 5026*x^16*y^12 + 5108*x^16*y^11 + 
    2854*x^16*y^10 + 1494*x^16*y^9 - 2876*x^16*y^8 + 34*x^16*y^7 + 50*x^16*y^6 +
    81*x^16*y^5 - 120*x^15*y^19 - 330*x^15*y^18 + 1350*x^15*y^17 + 678*x^15*y^16
    + 723*x^15*y^15 + 84*x^15*y^14 + 5650*x^15*y^13 - 2108*x^15*y^12 - 
    4637*x^15*y^11 - 6325*x^15*y^10 + 4970*x^15*y^9 + 1985*x^15*y^8 + 
    246*x^15*y^7 - 1023*x^15*y^6 + 159*x^15*y^5 - 20*x^15*y^4 + 5*x^15*y^3 + 
    45*x^14*y^20 + 330*x^14*y^19 - 465*x^14*y^18 - 1620*x^14*y^17 - 
    1102*x^14*y^16 + 105*x^14*y^15 - 1647*x^14*y^14 - 1806*x^14*y^13 + 
    2730*x^14*y^12 + 9615*x^14*y^11 - 939*x^14*y^10 - 6205*x^14*y^9 - 
    2820*x^14*y^8 + 2859*x^14*y^7 + 425*x^14*y^6 - 159*x^14*y^5 - 66*x^14*y^4 + 
    5*x^14*y^3 - 10*x^13*y^21 - 165*x^13*y^20 - 135*x^13*y^19 + 1175*x^13*y^18 +
    1506*x^13*y^17 + 1379*x^13*y^16 - 1829*x^13*y^15 + 1176*x^13*y^14 - 
    146*x^13*y^13 - 4479*x^13*y^12 - 8463*x^13*y^11 + 8466*x^13*y^10 + 
    5371*x^13*y^9 - 319*x^13*y^8 - 3794*x^13*y^7 - 230*x^13*y^6 + 908*x^13*y^5 -
    134*x^13*y^4 + 10*x^13*y^3 - x^13*y^2 + x^12*y^22 + 44*x^12*y^21 + 
    195*x^12*y^20 - 320*x^12*y^19 - 1090*x^12*y^18 - 2157*x^12*y^17 + 
    935*x^12*y^16 + 1783*x^12*y^15 + 1548*x^12*y^14 - 3917*x^12*y^13 + 
    12434*x^12*y^12 - 7683*x^12*y^11 + 3*x^12*y^10 - 10042*x^12*y^9 + 
    7873*x^12*y^8 + 2083*x^12*y^7 - 1256*x^12*y^6 - 725*x^12*y^5 + 190*x^12*y^4 
    + 25*x^12*y^3 - 2*x^12*y^2 - 5*x^11*y^22 - 73*x^11*y^21 - 57*x^11*y^20 + 
    375*x^11*y^19 + 1355*x^11*y^18 + 1203*x^11*y^17 - 1902*x^11*y^16 - 
    3961*x^11*y^15 + 4746*x^11*y^14 - 7589*x^11*y^13 + 8104*x^11*y^12 - 
    10131*x^11*y^11 + 16906*x^11*y^10 - 7130*x^11*y^9 - 1905*x^11*y^8 - 
    2805*x^11*y^7 + 3155*x^11*y^6 + 135*x^11*y^5 - 455*x^11*y^4 + 50*x^11*y^3 - 
    3*x^11*y^2 + 10*x^10*y^22 + 56*x^10*y^21 - 19*x^10*y^20 - 352*x^10*y^19 - 
    1335*x^10*y^18 + 59*x^10*y^17 + 2922*x^10*y^16 + 31*x^10*y^15 + 
    2603*x^10*y^14 - 7955*x^10*y^13 + 9137*x^10*y^12 - 8423*x^10*y^11 + 
    1039*x^10*y^10 - 573*x^10*y^9 + 6595*x^10*y^8 - 3124*x^10*y^7 - 
    1079*x^10*y^6 - 94*x^10*y^5 + 640*x^10*y^4 - 135*x^10*y^3 - 4*x^10*y^2 - 
    10*x^9*y^22 - 24*x^9*y^21 - 5*x^9*y^20 + 441*x^9*y^19 + 638*x^9*y^18 - 
    500*x^9*y^17 - 1875*x^9*y^16 - 1516*x^9*y^15 + 2911*x^9*y^14 + 2718*x^9*y^13
    - 5723*x^9*y^12 + 6944*x^9*y^11 - 4648*x^9*y^10 + 1439*x^9*y^9 - 
    3058*x^9*y^8 + 1604*x^9*y^7 + 2091*x^9*y^6 - 1538*x^9*y^5 - 14*x^9*y^4 + 
    130*x^9*y^3 - 5*x^9*y^2 + 5*x^8*y^22 + 16*x^8*y^21 - 15*x^8*y^20 - 
    280*x^8*y^19 - 304*x^8*y^18 + 567*x^8*y^17 + 1058*x^8*y^16 + 2029*x^8*y^15 -
    8016*x^8*y^14 + 9710*x^8*y^13 - 12848*x^8*y^12 + 16752*x^8*y^11 - 
    15945*x^8*y^10 + 11762*x^8*y^9 - 4722*x^8*y^8 - 297*x^8*y^7 + 258*x^8*y^6 + 
    162*x^8*y^5 + 367*x^8*y^4 - 319*x^8*y^3 + 60*x^8*y^2 - x^7*y^22 - 
    13*x^7*y^21 + 25*x^7*y^20 + 105*x^7*y^19 + 180*x^7*y^18 - 211*x^7*y^17 - 
    1971*x^7*y^16 + 3627*x^7*y^15 - 4958*x^7*y^14 + 11322*x^7*y^13 - 
    17498*x^7*y^12 + 17311*x^7*y^11 - 14209*x^7*y^10 + 9998*x^7*y^9 - 
    5677*x^7*y^8 + 2696*x^7*y^7 - 265*x^7*y^6 - 936*x^7*y^5 + 537*x^7*y^4 - 
    43*x^7*y^3 - 19*x^7*y^2 + 4*x^6*y^21 + 2*x^6*y^20 - 70*x^6*y^19 - 
    75*x^6*y^18 + 322*x^6*y^17 + 21*x^6*y^16 + 868*x^6*y^15 - 3910*x^6*y^14 + 
    5210*x^6*y^13 - 4945*x^6*y^12 + 6395*x^6*y^11 - 6995*x^6*y^10 + 4855*x^6*y^9
    - 2228*x^6*y^8 + 315*x^6*y^7 + 507*x^6*y^6 - 375*x^6*y^5 + 190*x^6*y^4 - 
    152*x^6*y^3 + 73*x^6*y^2 - 12*x^6*y - 6*x^5*y^20 + 22*x^5*y^19 + 65*x^5*y^18
    - 213*x^5*y^17 + 136*x^5*y^16 - 628*x^5*y^15 + 2358*x^5*y^14 - 3465*x^5*y^13
    + 3459*x^5*y^12 - 4401*x^5*y^11 + 5397*x^5*y^10 - 4475*x^5*y^9 + 
    2796*x^5*y^8 - 1672*x^5*y^7 + 958*x^5*y^6 - 513*x^5*y^5 + 255*x^5*y^4 - 
    81*x^5*y^3 + 6*x^5*y^2 + 2*x^5*y + 4*x^4*y^19 - 23*x^4*y^18 - 61*x^4*y^17 + 
    541*x^4*y^16 - 1433*x^4*y^15 + 2777*x^4*y^14 - 5327*x^4*y^13 + 8741*x^4*y^12
    - 10719*x^4*y^11 + 10274*x^4*y^10 - 8543*x^4*y^9 + 6220*x^4*y^8 - 
    3625*x^4*y^7 + 1589*x^4*y^6 - 527*x^4*y^5 + 137*x^4*y^4 - 35*x^4*y^3 + 
    15*x^4*y^2 - 6*x^4*y + x^4 - x^3*y^18 + 7*x^3*y^17 + 63*x^3*y^16 - 
    553*x^3*y^15 + 1837*x^3*y^14 - 3778*x^3*y^13 + 5974*x^3*y^12 - 8100*x^3*y^11
    + 9285*x^3*y^10 - 8477*x^3*y^9 + 5999*x^3*y^8 - 3321*x^3*y^7 + 1447*x^3*y^6 
    - 472*x^3*y^5 + 100*x^3*y^4 - 10*x^3*y^3 - 36*x^2*y^15 + 297*x^2*y^14 - 
    1108*x^2*y^13 + 2508*x^2*y^12 - 3942*x^2*y^11 + 4710*x^2*y^10 - 4536*x^2*y^9
    + 3564*x^2*y^8 - 2208*x^2*y^7 + 1017*x^2*y^6 - 324*x^2*y^5 + 64*x^2*y^4 - 
    6*x^2*y^3 + 9*x*y^14 - 83*x*y^13 + 345*x*y^12 - 855*x*y^11 + 1410*x*y^10 - 
    1638*x*y^9 + 1386*x*y^8 - 870*x*y^7 + 405*x*y^6 - 135*x*y^5 + 29*x*y^4 - 
    3*x*y^3 - y^13 + 10*y^12 - 45*y^11 + 120*y^10 - 210*y^9 + 252*y^8 - 210*y^7 
    + 120*y^6 - 45*y^5 + 10*y^4 - y^3;
f[43-1]:=x^26*y^9 - x^26*y^8 - 15*x^25*y^10 + 14*x^25*y^9 + x^25*y^8 + 105*x^24*y^11 - 
    90*x^24*y^10 - 8*x^24*y^9 - 14*x^24*y^8 + 7*x^24*y^7 + x^23*y^14 - 
    9*x^23*y^13 - 419*x^23*y^12 + 266*x^23*y^11 + 126*x^23*y^10 + 90*x^23*y^9 - 
    40*x^23*y^8 - 15*x^23*y^7 - 10*x^22*y^15 + 85*x^22*y^14 + 1044*x^22*y^13 - 
    196*x^22*y^12 - 776*x^22*y^11 - 441*x^22*y^10 + 175*x^22*y^9 + 77*x^22*y^8 +
    63*x^22*y^7 - 21*x^22*y^6 + 45*x^21*y^16 - 355*x^21*y^15 - 1762*x^21*y^14 - 
    970*x^21*y^13 + 2140*x^21*y^12 + 1975*x^21*y^11 - 290*x^21*y^10 - 
    595*x^21*y^9 - 266*x^21*y^8 + 28*x^21*y^7 + 49*x^21*y^6 - 120*x^20*y^17 + 
    855*x^20*y^16 + 2330*x^20*y^15 + 3267*x^20*y^14 - 2524*x^20*y^13 - 
    5978*x^20*y^12 - 1390*x^20*y^11 + 2820*x^20*y^10 + 988*x^20*y^9 + 
    77*x^20*y^8 - 224*x^20*y^7 - 126*x^20*y^6 + 35*x^20*y^5 + 210*x^19*y^18 - 
    1290*x^19*y^17 - 3060*x^19*y^16 - 4850*x^19*y^15 - 684*x^19*y^14 + 
    11096*x^19*y^13 + 8126*x^19*y^12 - 5618*x^19*y^11 - 4470*x^19*y^10 - 
    1260*x^19*y^9 + 1412*x^19*y^8 + 406*x^19*y^7 + 7*x^19*y^6 - 70*x^19*y^5 - 
    252*x^18*y^19 + 1218*x^18*y^18 + 4233*x^18*y^17 + 4413*x^18*y^16 + 
    6178*x^18*y^15 - 12206*x^18*y^14 - 18638*x^18*y^13 + 1752*x^18*y^12 + 
    11620*x^18*y^11 + 8332*x^18*y^10 - 4833*x^18*y^9 - 1821*x^18*y^8 - 
    261*x^18*y^7 + 287*x^18*y^6 + 133*x^18*y^5 - 35*x^18*y^4 + 210*x^17*y^20 - 
    630*x^17*y^19 - 4963*x^17*y^18 - 3638*x^17*y^17 - 8718*x^17*y^16 + 
    6667*x^17*y^15 + 24875*x^17*y^14 + 11509*x^17*y^13 - 12830*x^17*y^12 - 
    25067*x^17*y^11 + 3669*x^17*y^10 + 8242*x^17*y^9 + 2544*x^17*y^8 - 
    1719*x^17*y^7 - 424*x^17*y^6 + 14*x^17*y^5 + 49*x^17*y^4 - 120*x^16*y^21 + 
    30*x^16*y^20 + 4101*x^16*y^19 + 4228*x^16*y^18 + 6680*x^16*y^17 + 
    1065*x^16*y^16 - 22845*x^16*y^15 - 20839*x^16*y^14 - 2906*x^16*y^13 + 
    39108*x^16*y^12 + 14454*x^16*y^11 - 15513*x^16*y^10 - 12860*x^16*y^9 + 
    2714*x^16*y^8 + 3369*x^16*y^7 - 194*x^16*y^6 - 164*x^16*y^5 - 77*x^16*y^4 + 
    21*x^16*y^3 + 45*x^15*y^22 + 195*x^15*y^21 - 2115*x^15*y^20 - 4746*x^15*y^19
    - 3970*x^15*y^18 - 5494*x^15*y^17 + 17480*x^15*y^16 + 15935*x^15*y^15 + 
    23523*x^15*y^14 - 31710*x^15*y^13 - 38105*x^15*y^12 + 4316*x^15*y^11 + 
    27152*x^15*y^10 + 10144*x^15*y^9 - 12630*x^15*y^8 - 1599*x^15*y^7 + 
    1080*x^15*y^6 + 357*x^15*y^5 - 54*x^15*y^4 - 14*x^15*y^3 - 10*x^14*y^23 - 
    135*x^14*y^22 + 530*x^14*y^21 + 3490*x^14*y^20 + 3012*x^14*y^19 + 
    6075*x^14*y^18 - 11813*x^14*y^17 - 8034*x^14*y^16 - 26235*x^14*y^15 + 
    8962*x^14*y^14 + 38670*x^14*y^13 + 23070*x^14*y^12 - 20667*x^14*y^11 - 
    40151*x^14*y^10 + 15841*x^14*y^9 + 8672*x^14*y^8 + 2516*x^14*y^7 - 
    4388*x^14*y^6 + 696*x^14*y^5 + 2*x^14*y^4 + 24*x^14*y^3 - 7*x^14*y^2 + 
    x^13*y^24 + 41*x^13*y^23 + 36*x^13*y^22 - 1454*x^13*y^21 - 2404*x^13*y^20 - 
    4683*x^13*y^19 + 4736*x^13*y^18 + 7651*x^13*y^17 + 13335*x^13*y^16 + 
    7796*x^13*y^15 - 22718*x^13*y^14 - 28419*x^13*y^13 - 13064*x^13*y^12 + 
    55378*x^13*y^11 + 973*x^13*y^10 - 6941*x^13*y^9 - 22488*x^13*y^8 + 
    12293*x^13*y^7 + 420*x^13*y^6 - 359*x^13*y^5 - 214*x^13*y^4 + 40*x^13*y^3 - 
    x^13*y^2 - 5*x^12*y^24 - 56*x^12*y^23 + 259*x^12*y^22 + 1244*x^12*y^21 + 
    2624*x^12*y^20 + 1100*x^12*y^19 - 7935*x^12*y^18 - 3460*x^12*y^17 - 
    13504*x^12*y^16 + 17166*x^12*y^15 + 3761*x^12*y^14 + 40508*x^12*y^13 - 
    41397*x^12*y^12 - 10021*x^12*y^11 - 20668*x^12*y^10 + 43839*x^12*y^9 - 
    8137*x^12*y^8 - 3982*x^12*y^7 - 3954*x^12*y^6 + 3124*x^12*y^5 - 536*x^12*y^4
    + 44*x^12*y^3 - 5*x^12*y^2 + x^12*y + 10*x^11*y^24 + 18*x^11*y^23 - 
    320*x^11*y^22 - 940*x^11*y^21 - 2390*x^11*y^20 + 3714*x^11*y^19 + 
    1247*x^11*y^18 + 12800*x^11*y^17 - 15895*x^11*y^16 + 11851*x^11*y^15 - 
    39111*x^11*y^14 + 27557*x^11*y^13 - 10786*x^11*y^12 + 47254*x^11*y^11 - 
    34500*x^11*y^10 - 8896*x^11*y^9 - 403*x^11*y^8 + 13887*x^11*y^7 - 
    4429*x^11*y^6 - 899*x^11*y^5 + 149*x^11*y^4 + 91*x^11*y^3 - 11*x^11*y^2 + 
    x^11*y - 10*x^10*y^24 + 18*x^10*y^23 + 172*x^10*y^22 + 1060*x^10*y^21 + 
    5*x^10*y^20 - 756*x^10*y^19 - 7267*x^10*y^18 + 5429*x^10*y^17 - 
    4624*x^10*y^16 + 21096*x^10*y^15 - 17894*x^10*y^14 + 19751*x^10*y^13 - 
    33986*x^10*y^12 + 4688*x^10*y^11 + 15678*x^10*y^10 + 6465*x^10*y^9 - 
    7386*x^10*y^8 - 7308*x^10*y^7 + 4110*x^10*y^6 + 1867*x^10*y^5 - 
    1276*x^10*y^4 + 184*x^10*y^3 - 17*x^10*y^2 + x^10*y + 5*x^9*y^24 - 
    7*x^9*y^23 - 145*x^9*y^22 - 553*x^9*y^21 + 65*x^9*y^20 + 1463*x^9*y^19 + 
    3148*x^9*y^18 - 3031*x^9*y^17 - 3640*x^9*y^16 - 2528*x^9*y^15 + 
    5071*x^9*y^14 - 4688*x^9*y^13 + 21557*x^9*y^12 - 23107*x^9*y^11 + 
    12572*x^9*y^10 - 22352*x^9*y^9 + 23779*x^9*y^8 - 6053*x^9*y^7 - 1756*x^9*y^6
    - 639*x^9*y^5 + 993*x^9*y^4 - 132*x^9*y^3 - 23*x^9*y^2 + x^9*y - x^8*y^24 - 
    8*x^8*y^23 + 122*x^8*y^22 + 110*x^8*y^21 + 447*x^8*y^20 - 2604*x^8*y^19 + 
    2130*x^8*y^18 - 4195*x^8*y^17 + 14810*x^8*y^16 - 21381*x^8*y^15 + 
    27161*x^8*y^14 - 40768*x^8*y^13 + 46115*x^8*y^12 - 46077*x^8*y^11 + 
    47004*x^8*y^10 - 32761*x^8*y^9 + 13928*x^8*y^8 - 9223*x^8*y^7 + 7821*x^8*y^6
    - 2540*x^8*y^5 - 360*x^8*y^4 + 298*x^8*y^3 - 29*x^8*y^2 + x^8*y + 4*x^7*y^23
    - 28*x^7*y^22 - 178*x^7*y^21 + 280*x^7*y^20 - 153*x^7*y^19 + 2868*x^7*y^18 -
    7799*x^7*y^17 + 11450*x^7*y^16 - 20871*x^7*y^15 + 37132*x^7*y^14 - 
    47503*x^7*y^13 + 50801*x^7*y^12 - 48458*x^7*y^11 + 36834*x^7*y^10 - 
    25174*x^7*y^9 + 18902*x^7*y^8 - 11029*x^7*y^7 + 3320*x^7*y^6 - 923*x^7*y^5 +
    915*x^7*y^4 - 461*x^7*y^3 + 70*x^7*y^2 + x^7*y - 6*x^6*y^22 + 102*x^6*y^21 -
    93*x^6*y^20 - 264*x^6*y^19 + 104*x^6*y^18 - 553*x^6*y^17 + 5165*x^6*y^16 - 
    11636*x^6*y^15 + 16058*x^6*y^14 - 21163*x^6*y^13 + 25518*x^6*y^12 - 
    23652*x^6*y^11 + 17982*x^6*y^10 - 12076*x^6*y^9 + 6419*x^6*y^8 - 
    3448*x^6*y^7 + 3084*x^6*y^6 - 2203*x^6*y^5 + 707*x^6*y^4 - 20*x^6*y^3 - 
    26*x^6*y^2 + x^6*y + 4*x^5*y^21 - 148*x^5*y^20 + 565*x^5*y^19 - 926*x^5*y^18
    + 1535*x^5*y^17 - 3578*x^5*y^16 + 5680*x^5*y^15 - 5546*x^5*y^14 + 
    5335*x^5*y^13 - 7017*x^5*y^12 + 7965*x^5*y^11 - 6773*x^5*y^10 + 4679*x^5*y^9
    - 2222*x^5*y^8 + 194*x^5*y^7 + 518*x^5*y^6 - 499*x^5*y^5 + 437*x^5*y^4 - 
    292*x^5*y^3 + 103*x^5*y^2 - 14*x^5*y - x^4*y^20 + 133*x^4*y^19 - 
    819*x^4*y^18 + 2357*x^4*y^17 - 4745*x^4*y^16 + 8692*x^4*y^15 - 
    14705*x^4*y^14 + 20527*x^4*y^13 - 23075*x^4*y^12 + 22036*x^4*y^11 - 
    18506*x^4*y^10 + 13206*x^4*y^9 - 7517*x^4*y^8 + 3134*x^4*y^7 - 667*x^4*y^6 -
    235*x^4*y^5 + 266*x^4*y^4 - 91*x^4*y^3 + 9*x^4*y^2 + x^4*y - 84*x^3*y^18 + 
    672*x^3*y^17 - 2478*x^3*y^16 + 5815*x^3*y^15 - 10310*x^3*y^14 + 
    15307*x^3*y^13 - 19456*x^3*y^12 + 20558*x^3*y^11 - 17584*x^3*y^10 + 
    12110*x^3*y^9 - 6717*x^3*y^8 + 2931*x^3*y^7 - 922*x^3*y^6 + 143*x^3*y^5 + 
    50*x^3*y^4 - 56*x^3*y^3 + 28*x^3*y^2 - 8*x^3*y + x^3 + 36*x^2*y^17 - 
    333*x^2*y^16 + 1412*x^2*y^15 - 3680*x^2*y^14 + 6715*x^2*y^13 - 9312*x^2*y^12
    + 10356*x^2*y^11 - 9444*x^2*y^10 + 6990*x^2*y^9 - 4065*x^2*y^8 + 
    1776*x^2*y^7 - 548*x^2*y^6 + 107*x^2*y^5 - 10*x^2*y^4 - 9*x*y^16 + 92*x*y^15
    - 429*x*y^14 + 1210*x*y^13 - 2310*x*y^12 + 3168*x*y^11 - 3234*x*y^10 + 
    2508*x*y^9 - 1485*x*y^8 + 660*x*y^7 - 209*x*y^6 + 42*x*y^5 - 4*x*y^4 + y^15 
    - 11*y^14 + 55*y^13 - 165*y^12 + 330*y^11 - 462*y^10 + 462*y^9 - 330*y^8 + 
    165*y^7 - 55*y^6 + 11*y^5 - y^4;        
return f;
    
end intrinsic;
intrinsic PhiSet_and_Piset(Mod_As::SeqEnum,k::RngIntElt,l::RngIntElt)->RngIntElt,RngIntElt
{return phi_S:JH(l,index)->A_(f,k),x|-> T_n(x), S=n and pi_S:A_(f,k)->V_(k,l), S=m}
	h:=((l-1)) div GCD(l-1,k-2);
	
	R<x>:=PolynomialRing(GF(l));
	
	tau_2:=GF(l)!Tau_k_p(2,k,l);
	
	f2:=R!MinimalHeckePolynomial(JH(l,h),2);
	g2:=R!MinimalHeckePolynomial(Mod_As[#Mod_As],2);

	tau_3:=GF(l)!Tau_k_p(3,k,l);
	
	f3:=R!MinimalHeckePolynomial(JH(l,h),3);
	g3:=R!MinimalHeckePolynomial(Mod_As[#Mod_As],3);
	
		
	if (f2 mod (x-tau_2)^2) ne 0 then
		return 2,2;
	elif (f3 mod (x-tau_3)^2) ne 0 then	
		return 3,3;
	elif (f2 mod (x-tau_3)) ne 0 and (g3 mod (x-tau_3)^2) ne 0 then
		return 2,3;
	elif (f3 mod (x-tau_2)) ne 0 and (g2 mod (x-tau_2)^2) ne 0 then	
		return 3,2;
	else
		error"decide this case use more Hecke operators";
	end if;
	
end intrinsic;

intrinsic Afkl(k::RngIntElt,ell::RngIntElt)->SeqEnum
{decomposte JH(l,h) and find Afkl which V_k_l lies in}

h:=((ell-1)) div GCD(ell-1,k-2);

As:=Decomposition(JH(ell,h));

Delta_q:=Reductions(Newforms(CuspidalSubspace(ModularForms(Gamma1(1),k)))[1][1],ell)[1][1];

n_k_l:=[];


//recording the newforms of level ell weight 2
M_set:=<>;
for i:=1 to #As do
	Mmodell:=Reductions(Newform(As[i]),ell);
	
	for j:=1 to #Mmodell do
		for k:=1 to #Mmodell[j] do
			Append(~M_set,Mmodell[j][k]);
			
			if Degree(Delta_q) eq Degree(Mmodell[j][k]) then
				tf:=true;
				for z:=1 to 100 do
					if Coefficient(Delta_q,z) ne  Coefficient(Mmodell[j][k],z) then
						tf:=false;
						break;
					end if;
				end for;
				
				if tf then
					Append(~n_k_l,i);
					//"Delta(q)",Delta_q,"=",Mmodell[j][k],"mod",ell;
					//As[i];
					//"f",Newform(As[i]);
					//"Dim A_f_k_l=",Dimension(As[i]);
				end if;				
			end if;
		end for;					
	end for;				
end for;


if #n_k_l ne 1 then error"Delta_q not congruent to any f in S_2(\Gamma1(l)) why!!!";end if;


Mod_As:=[];

for i:=1 to #As do
	if i ne n_k_l[1] then Append(~Mod_As,As[i]);end if;
end for;

Append(~Mod_As,As[n_k_l[1]]);

return Mod_As;

end intrinsic;

intrinsic ComputeRamanujanSubpaceModp(computation_nr::SeqEnum)->BoolElt
{computation_nr=[current task number, total tasks number(fixed during the computation)]}

weight_k:=XHldata()[2][1];

l:=XHldata()[2][2];

index:=(l-1) div GCD(l-1,weight_k-2);

Mod_As:=Afkl(weight_k,l);

"generating CRT primes begin";
tf:=GeneratingCRTprimes();
"generating CRT primes end";

"find cusps correspondences begin";
//CorrOfCusps:=FindCuspsCorr(Mod_As,weight_k,l);
CorrOfCusps:=[[1,12],[4,10],[11,13],[9,8],[2,5],[6,14],[3,7]];
"find cusps correspondences end";

//"replace me";

pis,phis:=PhiSet_and_Piset(Mod_As,weight_k,l);

curr_cpu_nmuber:=computation_nr[1];
number_of_cpus:=computation_nr[2];
"curr_cpu_nmuber",curr_cpu_nmuber;
"number_of_cpus",number_of_cpus;


"WARNING the number of total cpu used must be equal i.e. ";
"the second parameter of computation_nr must be equal";

"distribute the good primes to each cpu begin";
 name1:="allgoodprimes_weight"cat IntegerToString(weight_k) cat "_module" cat IntegerToString(l) cat ".dat";
 filept1:=Open(name1,"r");
 Primes:=[];
 while true do
        prm := Gets(filept1);
      	if IsEof(prm) then       	   
      	   break;
      	end if;         
        Primes:=Append( Primes,StringToInteger(prm) );        		  		        
 end while;
 delete filept1;
      
name2:="goodprimes_weight"cat IntegerToString(weight_k) cat "_module" cat IntegerToString(l) cat "cpu_"cat IntegerToString(curr_cpu_nmuber) cat ".dat";		
filept2:=Open(name2,"w");
k:=0;			
while true do
	p:=Primes[2*(number_of_cpus*k+curr_cpu_nmuber)-1];
	e:=Primes[2*(number_of_cpus*k+curr_cpu_nmuber)];	
	Puts(filept2,IntegerToString(p));
	Puts(filept2,IntegerToString(e));
	k:=k+1;
	if 2*(number_of_cpus*k+curr_cpu_nmuber) gt #Primes then break;end if;	
end while;
		
delete filept2;	

name3:="badprimes_weight" cat IntegerToString(weight_k) cat"_module" cat IntegerToString(l) cat "cpu_"cat IntegerToString(curr_cpu_nmuber) cat ".dat";	
filept3:=Open(name3,"a+");
delete filept3;

name4:="goodprimesused_weight" cat IntegerToString(weight_k) cat"_module" cat IntegerToString(l) cat "cpu_"cat IntegerToString(curr_cpu_nmuber) cat ".dat";	
filept4:=Open(name4,"a+");
delete filept4;

"distribute the good primes to each cpu end";

//the last modular abelian variety is the one where V_l lands inside
	
while true do //biggets loop
      Primes:=[];//primes used
      Badprimes:=[];//bad primes in the file
      eBadprimes:=[];
      name1:="goodprimesused_weight" cat IntegerToString(weight_k) cat"_module" cat IntegerToString(l) cat "cpu_"cat IntegerToString(curr_cpu_nmuber) cat ".dat";
      name2:="badprimes_weight" cat IntegerToString(weight_k) cat"_module" cat IntegerToString(l) cat "cpu_"cat IntegerToString(curr_cpu_nmuber) cat ".dat";
      name3:="goodprimes_weight"cat IntegerToString(weight_k) cat "_module" cat IntegerToString(l) cat "cpu_"cat IntegerToString(curr_cpu_nmuber) cat ".dat";			
      filept:=Open(name1,"r");
      filebadprime:=Open(name2,"r");	
      filegodprime:=Open(name3,"r");

      while true do
        prm := Gets(filept);
      	if IsEof(prm) then       	   
      	   break;
      	end if;         
        Primes:=Append( Primes,StringToInteger(prm) );        		  		        
      end while;
      delete filept;
            
      while true do
         prm:=Gets(filebadprime);
         if IsEof(prm) then break;end if;
         Badprimes:=Append( Badprimes,StringToInteger(prm) );
         
         prm:=Gets(filebadprime);
         if IsEof(prm) then break;end if;
         eBadprimes:=Append( eBadprimes,StringToInteger(prm) );         			
      end while;
      delete filebadprime;
    	"================= BEGIN ============================";	
      "begin reading a good prime from file";
    		
      while true do
         prm:=Gets(filegodprime);
         if IsEof(prm) then error"finish good primes exit";break;end if;
         tmp_p:=StringToInteger(prm);
         
         prm:=Gets(filegodprime);
         if IsEof(prm) then error"finish good primes exit";break;end if;
         tmp_e:=StringToInteger(prm);
         	         		
         if (tmp_p in Badprimes eq false) and (tmp_p in Primes eq false) then// this is the first prime want to perform
         	  p:=tmp_p;
         	  extdg:=tmp_e;         	  		         	  	
         	  break;	
         end if;		         		
      end while;    		
      delete filegodprime;
      
     "good Primes are",Primes;
     "bad primes are",Badprimes; 
      
     time tf:=Jacl(<Mod_As,p,extdg,weight_k,l,index>,<pis,phis>,computation_nr,CorrOfCusps);
     "total time used(above)";  
     "================= END  ============================";  
 end while;
       	
end intrinsic; 



intrinsic NumOfJHl(Mod_As::SeqEnum,p::RngIntElt,l::RngIntElt,e::RngIntElt,h_index::RngIntElt)->RngIntElt,RngIntElt
{input:reduction prime p ,level of modular curve l,extension degree e,
output:#J(F_p^e),genus	}

ZZ:=IntegerRing();

k:=e;
		
R2<T,U>:=PolynomialRing(ZZ,2);
	
fs:=FrobeniusPolynomialAs(Mod_As,l,p,h_index);

fx:=fs[1];
for i:=2 to #fs do
	fx:=fx*fs[i];
end for;


PT:=R2!0;
	
for i:=0 to Degree(fx) do
	  PT:=PT+Coefficient(fx,i)*T^i;
end for;
PTk:= Resultant(PT, T^k-U,T);
NofJOne:=Evaluate(PTk,[1,1]);

"cardinality of JH(",l,",",h_index,")(Fq)=",NofJOne;

dimjh:=0;
for i:=1 to #Mod_As do
	dimjh:=dimjh+Dimension(Mod_As[i]);
end for;
return NofJOne,dimjh;
	
end intrinsic;

intrinsic DChar(FF::ModFrmElt)->SeqEnum
{Given a newform FF return the value of The Dirichlet character chi:ZZ div n ZZ ->C* associated to F
as a sequence [chi(1),chi(2),...,chi(n-1)], use the formula chi(p)=(a_p^2-a_(p^2)) div p 
and chi(mn)=chi(m)*chi(n)
be careful we can not compute chi(l) where l<=n-1 is the character of the base field!
use the equality chi(l)=chi(l+n) instead.
}

	n:=Level(FF);
	
	RR:=BaseField(FF);
	
	ell:=Characteristic(RR);
	
	Chars:=[RR!0: i in [1..n-1]];
	Chars[1]:=1;
		
	p:=2;
	
	while true do
	  if p gt n-1 then break;end if;
	  
	  //except the special point
	  
	  if p ne ell then
	  	//"p",p;
	  	Chars[p]:=(Coefficient(FF,p)^2-Coefficient(FF,p^2))/p;
	  	//"Chars[p]=",Chars[p];
	  end if;
	  
	  p:=NextPrime(p);
	  
	   
	end while;
	//Chars;
	//Type(Chars[2]);
	
	for i:=1 to n-1 do
	  
	  if i eq ell then//special point
	  	facs:=Factorization(i+n);
	  	tmp:=1;
	  	for j:=1 to #facs do
	  		tmp:=tmp*(Chars[facs[j][1]]^(facs[j][1]));
	  	end for;
	  	Chars[i]:=tmp;
	  else
	  
	  	facs:=Factorization(i);
	        //"facs",facs;
	        
	  	tmp:=1;
	  	for j:=1 to #facs do
	  		tmp:=tmp*(Chars[facs[j][1]]^(facs[j][2]));
	  	end for;
	  	Chars[i]:=tmp;
	  
	  end if;
	
	end for;
	
	return Chars;
end intrinsic;

intrinsic FrobeniusPolynomialAs(Mod_As::SeqEnum,ell::RngIntElt,q::RngIntElt,h_index::RngIntElt)->Tup
{JH(l,h_index)=A1*...*Ak compute the Frobenius  polynomial Fq on A1,...,A_k}
    
  As:=Mod_As;
  "As",As;
  Polys:=<>;
  
  for i:=1 to #As do
  	f_i:=Newform(As[i]);
  	chi_i:=DirichletCharacter(As[i]);
  	Kf:=BaseField(f_i);
  	RR<X>:=PolynomialRing(Kf);
  	
  	//very strange we can not use  MinimalHeckePolynomial(37A[12],q) for q greater than 77773 but
  	//MinimalHeckePolynomial(37A[4],q) works for q near 10^6
  	
  	M_chi_i:=CuspidalSubspace(ModularForms(chi_i,2));
	
	if Dimension(M_chi_i) eq Dimension(As[i]) then	
  		M:=M_chi_i;  		
	else
		M:=As[i];
	end if;
	
  	
  	hkfq:=RR!(HeckePolynomial(M,q));
  	rts1:=Roots(hkfq); 
  	//"rts1",rts1;
  	alpha:=rts1[1][1];  	
  	hkfqq:=RR!(HeckePolynomial(M,q^2));
  	rts2:=Roots(hkfqq);//split completely
  	//"rts2",rts2;
  	nu:=0;
  	
  	//"hkfq",hkfq;
  	//"hkfqq",hkfqq;
  	for j:=1 to #rts2 do
  		  taq:=alpha;
  		  taqq:=rts2[j][1];
  		  tchiq:=(taq^2-taqq)/q;
  		  if  tchiq in DChar(f_i) then
  		     aq:=taq;
  		     chiq:=tchiq;
  		     //"aq aqq chiq",aq,chiq;
  		     nu:=nu+1;  	     
  		  end if;
  	end for;
  	
  	
  	if nu lt 1  then 
  		"nu=",nu;
  		error"matched number should >= 1 !!";
  	end if;
  	
  	c_aq:=Conjugates(alpha);
  	c_chiq:=Conjugates(chiq);
  	
  	TT<y>:=PolynomialRing(ComplexField(200000));
  	
  	myfq:=TT!1;
  	
  	for i:=1 to #c_aq do
 		 myfq:=myfq*(y^2-c_aq[i]*y+q*c_chiq[i]);
  	end for;
  	
  	UU<z>:=PolynomialRing(Integers());
  	
  	myfq_i:=UU!0;
  	
  	for i:=0 to Degree(myfq) do
  		myfq_i:=myfq_i+z^i*(Integers()!Round(Coefficient(myfq,i))); 
  	end for;
  	    	
  	Append(~Polys,myfq_i);
  end for;
   
  return Polys;
  
end intrinsic;

intrinsic FactorsJHl(Mod_As::SeqEnum,p_l_e_h_phis:SeqEnum)->RngIntElt,Tup,Tup
{input:reduction prime p ,level of modular curve l,extension degree e,
output:index of component ,<A1,A2,...>,<MinimailPoly(A1,2),...>	}
p:=p_l_e_h_phis[1];
l:=p_l_e_h_phis[2];
e:=p_l_e_h_phis[3];
h_index:=p_l_e_h_phis[4];
phis:=p_l_e_h_phis[5];

ZZ:=IntegerRing();

k:=e;
		
R2<T,U>:=PolynomialRing(ZZ,2);
	
//fx:=FrobeniusPolynomial(JOne(l),p);
fs:=FrobeniusPolynomialAs(Mod_As,l,p,h_index);

fx:=fs[1];
for i:=2 to #fs do
	fx:=fx*fs[i];
end for;


PT:=R2!0;
	
for i:=0 to Degree(fx) do
	  PT:=PT+Coefficient(fx,i)*T^i;
end for;
PTk:= Resultant(PT, T^k-U,T);
NofJOne:=Evaluate(PTk,[1,1]);

"cardinality of JH(l,",h_index,")(Fq)=",NofJOne;

NofallAi:=1;
NofAilist:=<>;	
for i:=1 to #fs do
	PTi:=R2!0;
	fxi:=fs[i];
	for j:=0 to Degree(fxi) do
	  PTi:=PTi+Coefficient(fxi,j)*T^j;
	end for;
	
	PTik:= Resultant(PTi, T^k-U,T);
	NuofAi:=Evaluate(PTik,[1,1]);
	"cardinality of abelian variety A_",i,"(Fq) =",NuofAi;
	NofallAi:=NofallAi*NuofAi;
	Append(~NofAilist,NuofAi);		
end for;		
	
if NofJOne ne NofallAi then 
	error"NofJOne ne NofallAi";
end if; 

//Minimal Hecke 	Polynomails
A:=Mod_As;

HPolylist:=<>;

for i:=1 to #A do
	HkPolyi:=MinimalHeckePolynomial(A[i],phis);
	Append(~HPolylist,HkPolyi);		
end for;
	
return #NofAilist,NofAilist,HPolylist;
	
end intrinsic;

intrinsic AnBnCnen(Afkl::ModAbVar,n::RngIntElt,l::RngIntElt,k::RngIntElt)->RngUPolElt,RngUPolElt,RngUPolElt,RngIntElt
{compute the characteristic poly of  ecke operator T_n acting S_2(Gamma1(l)) An, factor it and 
	return An,Bn,en where An=Bn (X-tau_k(n))^en}

  P<x>:=PolynomialRing(GF(l));
  An:=P!MinimalHeckePolynomial(Afkl,n);	
  
  Cn:=P!(x-Tau_k_p(n,k,l));
  
  en:=OrdPoly(An,Cn);
  	
  if en lt 1 then error"the exponent en should not less than one!";end if;	
  
  Bn:=An div (Cn^en);
  Cn:=P!(x-Tau_k_p(n,k,l));
  		
  return An,Bn,Cn,en;
  			
end intrinsic;

intrinsic Ltorsionpoint(Mod_As::SeqEnum,FxFxyF::Tup,Cusps::SeqEnum,plegkidxphis::SeqEnum,Horbits::SeqEnum)->BoolElt,Tup
{new method to produce a l-torsion point!}
    FunFldx:=FxFxyF[1];
    FunFldxy:=FxFxyF[2];
    F_pe:=FxFxyF[3];		 
    Org:=Cusps[1];	
    O:=Divisor(Org);
    		
    p:=plegkidxphis[1];
    l:=plegkidxphis[2];
    extdg:=plegkidxphis[3];
    gns:=plegkidxphis[4];
    k:=plegkidxphis[5];    			
    h_index:=plegkidxphis[6];
    phis:=plegkidxphis[7];
    				
    indexvl,NofAilist,HPolyList:=FactorsJHl(Mod_As,[p,l,extdg,h_index,phis]);
    "indexvl",indexvl;	
    "NofAilist",NofAilist;
    "HPolyList",HPolyList;	
    
    "generating a random divisor";
    nu_try:=0;
    	
    while true do//loop find l-torsion point
    		nu_try:=nu_try+1;
    		while true do           		   
    		      tf,P:=HasRandomPlace(FunFldxy, 1);//to be precisely 1 should be changed to the a number less or equal to the genus
    		      //"random place degree one P=",P;
    		      flag:=IsFinite(P);
    		            	
    		      if (tf eq true) and (flag eq true) and ((P in  Cusps) eq false) then
    		         break;
    		      end if;	
    		end while;
    		
    		dvr:=<P,O,-1>;
    		
    		//"check",IsPrincipal(NofAilist[1]*NofAilist[2]*(P-O));
    		
    		"construncting a ",l,"-torsion point start";
    		tfbqtqdvr:=true;
 
    		q:=phis;
    		for i:=1 to #HPolyList do
    			if i ne indexvl then
    				HpolAi:=HPolyList[i];	
    				tfbqtqdvr,tp:=BqTqDvr(<FunFldx,FunFldxy,F_pe>,HpolAi,Cusps,dvr,<p,q,l>,Horbits);
    				
    				if tfbqtqdvr eq false then 
    		        		"try a new random divisor,construncting l-torsion point BqTqDvr return false 310";
    		        		break;    		       	 	
    		    end if;
    		    
    		    dvr:=tp;		
					end if;	
    		end for;
    		
    		if tfbqtqdvr then break;end if;
    		if nu_try gt 10 then error"try 10 times still not find l-torsion why?! 327";end if;	
    end while;
    

		"construncting a ",l,"-torsion point end";
		
  NofAindex:=NofAilist[indexvl];
  vlofAi:=Valuation(NofAindex,l);
  "cardinality of #A_{f_l}(Fq) =",NofAindex;
  "valuation of #A_{f_l}(Fq) at l: ord_l(A_{f_l}(Fq)) =",vlofAi;
  if vlofAi lt 2 then error"vlofAi<2 352";end if;
  
  //if 	vlofAi lt 2 then error"nop!";end if;
  
  lvlofAi:=l^vlofAi;
  	
  N_l:=NofAindex div lvlofAi;
  //trivial divisoin	
  factorsofNl,partb:=TrialDivision(N_l,2^25);
  //factorsofNl;
  if #partb ge 1 then 		   
     n2:=partb[1];
     //"n2=",n2;
     ffss:=Factorization(n2:MPQSLimit:=0);
     //ffss;	
     for i:=1 to #ffss	do
     	Append(~factorsofNl,ffss[i]);
     end for;
  end if;
  "factorization of #A_{f_l}(Fq)/l^e=",factorsofNl;
				
	 mulN1:=1;
	 mulN2:=1;	
	 FactsIndex1:=[];
	 FactsIndex2:=[];
	 				
   for i:=1 to #factorsofNl	do//00
  	if (factorsofNl[i][1] ne l)  then//01
  			pp:=factorsofNl[i][1];
  			Append(~FactsIndex1,pp);
  			Append(~FactsIndex2,pp);	
  			c1:=(factorsofNl[i][2]+1) div 2;
  			Append(~FactsIndex1,c1);	
  			c2:=factorsofNl[i][2]-c1;
  			Append(~FactsIndex2,c2);		
  			mulN1:=mulN1*(pp^c1);
  			mulN2:=mulN2*(pp^c2);			
  	end if;	  	    
   end for;//00

  Dtilde:=dvr[1];
  Advr:=dvr[2];
  rdg:=dvr[3];		
     	   
   //new method
   for i:=1 to (#FactsIndex1 div 2) do
   	 "p,e",FactsIndex1[2*i-1],FactsIndex1[2*i];
   	 pp:=FactsIndex1[2*i-1];
   	 ee:=FactsIndex1[2*i];	
   	 /*	
   	 for j:=1 to FactsIndex1[2*i] do
   	 	  "j=",j;
   	 	  time Dtilde,rdg,Advr,aele:=Reduction(pp*(Dtilde+rdg*Advr), O);
   	 end for;
   	 */
   	 //changed by
   	 Dtilde,rdg,Advr,aele:=Reduction((pp^ee)*(Dtilde+rdg*Advr), O);	
   end for;
   	
  if 	IsPrincipal( Dtilde+rdg*Advr ) then
  	error"it is a principal divisor! why 421";
  	return false,[0,0,0];
  end if;
  					
  tf:=IsPrincipal(lvlofAi*(Dtilde+rdg*Advr));
  //"time use in test l^e(dvr) is or not principal";
  if tf then 
     "sqrt(J1(Fq)) * l^e kill the divisor, nice!";	
  else  
  	 "sqrt(J1(Fq)) * l^e can not kill the divisor :(";

     for i:=1 to (#FactsIndex2 div 2) do
     	 "p,e",FactsIndex2[2*i-1],FactsIndex2[2*i];
     	 pp:=FactsIndex2[2*i-1];
     	 for j:=1 to FactsIndex2[2*i] do
     	 	  "j=",j;	
     	 	  time Dtilde,rdg,Advr,aele:=Reduction(pp*(Dtilde+rdg*Advr), O);		
     	 end for;	
     end for;  	
  end if;
   	
  if 	IsPrincipal( Dtilde+rdg*Advr ) then
  	return false,[0,0,0];
  end if;		
	
	for i:=1 to vlofAi do//00
            
      if IsPrincipal((l^i)*(Dtilde+rdg*Advr))  then//01
         Dtilde,rdg,Advr,aele:=Reduction((l^(i-1))*(Dtilde+rdg*Advr), O);       	
         //"rdg=",rdg;	      
         break;
      end if;//01
      
      if i eq vlofAi then 
      	return false,[0,0,0];
      	//error "error occur please check";
      end if;
                               
   end for;//00 
                            
    return true,<Dtilde,O,rdg>;  			    	
end intrinsic;

intrinsic OneEleOfVl(Mod_As::SeqEnum,FxFxyF::Tup,Cusps::SeqEnum,plegkidx::SeqEnum,pisphis::Tup,Horbits::SeqEnum)->BoolElt,Tup
{compute a element of Jl(F_q)[l]}

    FunFldx:=FxFxyF[1];
    FunFldxy:=FxFxyF[2];
    F_pe:=FxFxyF[3];		 
    Org:=Cusps[1];	
    O:=Divisor(Org);		
    p:=plegkidx[1];
    l:=plegkidx[2];
    extdg:=plegkidx[3];
    gns:=plegkidx[4];
    k:=plegkidx[5];
    index:=plegkidx[6];
    			    	
    PP<t>:=PolynomialRing(GF(l));
   
    q:=pisphis[1];    	

    "primes generate the maximal ideal m_{k,l} of Hecke algebra (End(A_f)) as an ideal=<l,",q,">";		
    "------21---";
    //generating an l-torsion point 
    while true do
    	tf,Dvr:=Ltorsionpoint(Mod_As,FxFxyF,Cusps,[p,l,extdg,gns,k,index,pisphis[2]],Horbits);
    	if tf then break;end if;	 
    end while;
    "--------------27--";       
    fqx,Bq,Cq,eC:=AnBnCnen(Mod_As[#Mod_As],q,l,k);//V_k_l in the last one
    
    "action of Bq(Tn)";
    tfbqtqdvr,bqtqdvr:=BqTqDvr(<FunFldx,FunFldxy,F_pe>,Bq,Cusps,Dvr,<p,q,l>,Horbits);
    "end action of Bq(Tn)";
    
    if tfbqtqdvr eq false then
	//drop this prime some trouble encountered            							
        return false,<0,0,0>;             							
     end if;
     	
    //action of Cq(T2)=T2-tau(2) several times
    tmpdvr:=bqtqdvr;
    tnb:=1;
    while true do//00
          tfbqtqdvr,tmpdvr1:=BqTqDvr(<FunFldx,FunFldxy,F_pe>,Cq,Cusps,tmpdvr,<p,q,l>,Horbits);
          tnb:=tnb+1;	
          if tfbqtqdvr eq false then 
          		"try a new random divisor,BqTqDvr retrun false lin 47";
          		return false,[0,0,0];
          		break;
          end if;
          
          if 	(tmpdvr1[1]+tmpdvr1[3]*tmpdvr1[2]) eq (O-O) then          	   
          	   break;
          end if;
          	
          tmpdvr:=tmpdvr1;
          	
          if tnb ge eC then 
          	tfbqtqdvr,tmpdvr1:=BqTqDvr(<FunFldx,FunFldxy,F_pe>,fqx,Cusps,tmpdvr,<p,q,l>,Horbits);
          	tmpdvr1;	
          	error"fqx(dvr)!=0 why";
          end if;		
              			    		
     end while;//00    
     
     Dvr:=tmpdvr[1]+tmpdvr[3]*tmpdvr[2];     
     if IsPrincipal(Dvr) eq true then
     	   "It's a principal divisor useless, bad prime! in OneEleOfVl.m,p=",p;
     	   return false,[0,0,0];
         //error"Vl1 is a principal divisor";
     end if;
     if IsPrincipal(l*Dvr) eq false then
     	   "It's not a l-torsion divisor, error occur, bad prime! in OneEleOfVl.m p=",p;
     	   return false,[0,0,0];	
     	   //error"Vl1 is not of order l";
     end if;
     		      
     return true,tmpdvr;     
end intrinsic;

intrinsic checkV(FxFxyF::Tup,OandE::Tup,p_l::Tup)->BoolElt //Fx::FldFunRat,Fxy::FldFun,F::FldFin
{check the ramanujan subspace Vl,OandE=<O,E1,E2>,sigma^k(Ei) belongs to Vl}
 p:=p_l[1];
 l:=p_l[2];
 
 O:=OandE[1];	
 E1:=OandE[2];
 E2:=OandE[3];		
  	
 Fx:=FxFxyF[1];
 Fxy:=FxFxyF[2];		
 F:=FxFxyF[3];
 N:=#F;
 				
 if IsPrincipal( l*E1 ) eq false  or IsPrincipal( l*E2 ) eq false then 
 	error"problem with ramanujan space!";
 end if;
 	 	
 Dtilde,rdg,Advr,aele:=Reduction(E1, O);				

 Ps,Es:=Support(Dtilde);

 SigmaE:=rdg*O;
 	
 for kk:=1 to #Ps do
    dofplc:=Degree(Ps[kk]);

    u,v:=PlaceToPoint(F,Ps[kk]);
    	
    ptset:=<<u,v>>;
    for ii:=1 to 	dofplc-1 do
    	 Append(~ptset,<u^(N^ii),v^(N^ii)>);
    end for;
		
    if PointSetToPlace(FxFxyF,ptset) ne Ps[kk] then
       	  			error"why it happens?!";
    end if;
    delete ptset;

    ptset:=<<u^p,v^p>>;
    for ii:=1 to 	dofplc-1 do
    	 Append(~ptset,<(u^(N^ii))^p,(v^(N^ii))^p>);
    end for;	
    	
    P:=PointSetToPlace(FxFxyF,ptset); 	
    SigmaE:=SigmaE+Es[kk]*P;

 end for;

 flagbetaafa:=0;	
 for beta:=0 to l-1 do
  		for afa:=0 to l-1 do               				  				
 			  if IsPrincipal(SigmaE-(beta*E1+afa*E2)) eq true then
 			  					flagbetaafa:=1;
 			  					break;	
 			  end if;
 		end for;
 		if	flagbetaafa eq 1 then break;end if;
 end for;	 	
 
 if flagbetaafa eq 0 then error"sigma(E1) doesn't belong to Vl";end if;
 return true;
end intrinsic;

intrinsic Frobp(FxFxyF::Tup,Cusps::SeqEnum,pleg::SeqEnum,Vl1::Tup)->BoolElt,Tup
{compute the Frob_p(Vl1) to get a new base element}

  Fx:=FxFxyF[1];
  Fxy:=FxFxyF[2];
  F:=FxFxyF[3];
  N:=#F;
  p:=pleg[1];
  l:=pleg[2];
  e:=pleg[3];
  gns:=pleg[4];
  O:=1*Cusps[1];
  	
  NoCuspVl1:=Vl1[1];
  CuspVl1:=Vl1[3]*Vl1[2];	
  Vl1:=NoCuspVl1+CuspVl1;
  									
  supps,exps:=Support(NoCuspVl1);
  
  Dvr:=CuspVl1;//cups part invariant under the Frobenius action
  		
  for i:=1 to #supps do 
  	
  	if supps[i] in Cusps then
  		Dvr:=Dvr+exps[i]*supps[i];
  	else  			
  		dofplc:=Degree(supps[i]);
  		
  		tf,u,v:=PlaceToPoint(F,supps[i]);
  					
  		ptset:=<<u^p,v^p>>;
   		for ii:=1 to 	dofplc-1 do
    	 Append(~ptset,<(u^(N^ii))^p,(v^(N^ii))^p>);
    	end for;	
    	
    	sigmaP:=PointSetToPlace(FxFxyF,ptset); 	
    	Dvr:=Dvr+exps[i]*sigmaP;
  	end if;  				
  	
  end for;
  
  if Degree(Dvr) ne 0 then 
  	 error" Dvr is not of degree 0";
  end if;			
  
  Dtilde,rdg,Advr,aele:=Reduction(Dvr, O);
  
  if rdg ne -gns then 
  	"the divisor might be not unique (rdg!=-g), Bad prime! p=",p;
  	return false,<0,0,0>;
  end if;	
  	  	  	  	  	
  //check linearly independence	
  flag:=0;
  for i:=1 to l-1 do 
  	if IsPrincipal((Dtilde+rdg*Advr)-i*Vl1) then
  		flag:=1;		
  		break;
  	end if;	  	
  end for;
  //end of check
  //"Vl1=",Vl1;
  if flag eq 0 then
  	"yes Frob_p(Vl1) is a new base element";
  	return true , <Dtilde,Advr,rdg>;
  else
  	"Vl1 Vl2 does not form a base! bad prime can be fixed";
  	return false,<0,0,0>;
  end if;			

end intrinsic;

intrinsic Jacl(As_p_e_k_l_index::Tup,pisphis::Tup,computation_nr::SeqEnum,Horbits::SeqEnum)->BoolElt
{ compute the case (p,l)}
	Mod_As:=As_p_e_k_l_index[1];
	p:=As_p_e_k_l_index[2];
	extdg:=As_p_e_k_l_index[3];
	weight_k:=As_p_e_k_l_index[4];
	l:=As_p_e_k_l_index[5];
	index:=As_p_e_k_l_index[6];
	
	gns:=&+[Dimension(Mod_As[i]):i in [1..#Mod_As]];
	"p,e,weight,module,gns",p,extdg,weight_k,l,gns;
			 	       	       	
        F_pe<w>:=GF(p,extdg);//definition of Vl,so we consider J1l(F_p^extdg)
        
        FunFldx<x>:=FunctionField(F_pe);
        R<y> := PolynomialRing(FunFldx);
        
        tmp1,tmp2:=CoefficientsAndMonomials(XHldata()[1][1]);

	nx:=0;
	
	for i:=1 to #tmp1 do
		nx:=nx+tmp1[i]*x^(Degree(tmp2[i],Parent(tmp2[i]).1))*y^(Degree(tmp2[i],Parent(tmp2[i]).2));
	end for;
	
        XHl:=nx;
        //XHl;
        	
 	FunFldxy<y>:=FunctionField(XHl);
 	
	Css:=XHldata()[1][4];
        Qcusps:=[];
        
        //FunFldxy;        
        //Genus(FunFldxy);

        for i:=1 to #Css do
        
        
        	tmp1,tmp2:=CoefAndMonsofRatMpol(Css[i][1]);
        	        			
		nx:=0;
		
		for i:=1 to #tmp1[1] do
			nx:=nx+tmp1[1][i]*x^(Degree(tmp1[2][i],Parent(tmp1[2][i]).1))*y^(Degree(tmp1[2][i],Parent(tmp1[2][i]).2));
		end for;
		
		dx:=0;
		
		for i:=1 to #tmp2[1] do
			dx:=dx+tmp2[1][i]*x^(Degree(tmp2[2][i],Parent(tmp2[2][i]).1))*y^(Degree(tmp2[2][i],Parent(tmp2[2][i]).2));
		end for;
		gx:=nx/dx;
		//gx;
		
        	tmp1,tmp2:=CoefAndMonsofRatMpol(Css[i][2]);
        	       			
		nx:=0;
		
		for i:=1 to #tmp1[1] do
			nx:=nx+tmp1[1][i]*x^(Degree(tmp1[2][i],Parent(tmp1[2][i]).1))*y^(Degree(tmp1[2][i],Parent(tmp1[2][i]).2));
		end for;
		
		dx:=0;
		
		for i:=1 to #tmp2[1] do
			dx:=dx+tmp2[1][i]*x^(Degree(tmp2[2][i],Parent(tmp2[2][i]).1))*y^(Degree(tmp2[2][i],Parent(tmp2[2][i]).2));
		end for;
		gy:=nx/dx;
		//gy;		
	        	        	
        	P:=CommonZeros(FunFldxy,[gx,gy])[1];
        	
        	Append(~Qcusps,P);
        end for;
                     									        
        for i:=1 to #Qcusps do
        	 for j:=i+1 to #Qcusps do
        	 	if Degree(Qcusps[i]) ne 1 then 
        	 		
        	 		Qcusps[i];
        	 		error"problem with cusps";
        	 	end if;
        	 	if Qcusps[i] eq Qcusps[j] then 
        	 		
        	 		Qcusps[i];
        	 		Qcusps[j];
        	 		error"problem with cusps";
        	 	end if;
        	 end for;	
        end for;	
        //"rational cusps",Qcusps;
                		 
        Org:=Qcusps[1];	
  	O:=Divisor(Org);                	
		   					   		   	       
      "searching a base for Jacobian of modular curve X1(l) over F_p^extdg"; 
      tfv1,Vl1:=OneEleOfVl(Mod_As,<FunFldx,FunFldxy,F_pe>,Qcusps,[p,l,extdg,gns,weight_k,index],pisphis,Horbits);
      name1:="goodprimesused_weight" cat IntegerToString(weight_k) cat"_module" cat IntegerToString(l) cat "cpu_"cat IntegerToString(computation_nr[1]) cat ".dat";
      name2:="badprimes_weight" cat IntegerToString(weight_k) cat"_module" cat IntegerToString(l) cat "cpu_"cat IntegerToString(computation_nr[1]) cat ".dat";
      	       
       if tfv1 eq false then
       		filept:=Open(name2,"a+");
          	"bad prime p=",p;          	
          	Puts(filept,IntegerToString(p));
          	Puts(filept,IntegerToString(extdg));
          	delete filept;          			
       end if; 
       
       if tfv1 eq true then 	//15      
            //use Frob_p(Vl1) to get a new base element of Vl;
            tfv2,Vl2:=Frobp(<FunFldx,FunFldxy,F_pe>,Qcusps,[p,l,extdg,gns,weight_k,index],Vl1);
            
            if tfv2 eq false then
            		filept:=Open(name2,"a+");
               	"bad prime p=",p;              
               	Puts(filept,IntegerToString(p));
               	Puts(filept,IntegerToString(extdg));
               	delete filept;          			
            end if;	     
             	 
            "end of searching a base for Jacobian of modular curve X1(l) over F_p^extdg"; 
            
            if tfv2 eq true then//13
                "computing the polynomial corresponding to Vl(begin)";
                E1:=Vl1[1]+Vl1[3]*Vl1[2];
                E2:=Vl2[1]+Vl2[3]*Vl2[2];	
                	
                //tf:=ComputePolys(<FunFldx,FunFldxy,F_pe>,[E1,E2],<p,l,gns>,Qcusps);
                tf:=SavePointSet(<FunFldx,FunFldxy,F_pe>,[E1,E2],<p,l,gns>,Qcusps,computation_nr);
                "computing the polynomial corresponding to Vl(end)";
                
                if tf eq false then 
               	    filept:=Open(name2,"a+");
               	   "bad prime p=",p;
               	   Puts(filept,IntegerToString(p));
               	   Puts(filept,IntegerToString(extdg));
               	   delete filept; 
               	else
		   filept:=Open(name1,"a+");              	   
               	   Puts(filept,IntegerToString(p));
               	   
               	   delete filept;               		              	
                end if;//primes which are bad!
                          
           end if;//13
       end if;    //15
       	
       return true;	       	
end  intrinsic;

intrinsic PlaceToPoint(F::FldFin,P::PlcFunElt)->BoolElt,FldFinElt,FldFinElt
{give a place P return one of point in the conjugate set of points representes P}

	Fldplc1:=P;
	//"P",P;  
	DgoFldplc1:=Degree(Fldplc1);
        gen1,gen2:=TwoGenerators(Fldplc1);//type FldFunElt
        elegen1:=ElementToSequence(gen1);//?+?*y+?*y^2+...+?*y^(d-1) ,d=degree of modular curve
        elegen2:=ElementToSequence(gen2);//type is SeqEnum
        	
        polgen1:=Numerator(elegen1[1]);//type RngUPolElt
        
        BsFld:=Parent(Coefficient(polgen1,0));
        //"BsFld",BsFld;
        //"F",F;
        if BsFld ne F then error"the definition field of input place should equal to the base field";end if;	
        //"--------------";
        //BsFld;
        for i:=1 to #elegen1 do	
        	if Denominator(elegen1[i]) ne 1 then 
        		return false,0,0;
        		//error "generator of the place is of uncontroled form drop it!!!!";
        	end if;
        end for;
        
        for i:=1 to #elegen2 do	
        	if Denominator(elegen2[i]) ne 1 then
        		return false,0,0; 
        		//error "generator of the place is of uncontroled form drop it!!!!";
        	end if;
        end for;        
        
        for i:=2 to #elegen1 do
        	if elegen1[i] ne 0 then error"place of x-part shouls be x^...";end if;
        end for;				

        //check the place and calculate some paremeters
        if Degree(polgen1) lt DgoFldplc1	then
        	//in this case degree of y is bigger than one,so we hope x-part to be x+*
        	  if Degree(polgen1) ne 1 then error"why has this case!?";end if;
        end if;
        
        nn0:=0;	
        for i:=0 to #elegen2 do//*y^0+*y^1+...+*y^nn0+0 find nn0
           if elegen2[#elegen2-i] ne 0 then 
           	 nn0:=#elegen2-i;
           	break;
           end if;
        end for;			 
        
        if Degree(polgen1) lt DgoFldplc1	then 
        	if (nn0-1) ne DgoFldplc1 then//in this case degree of y should equal to degree of the place!
        		elegen2;
        		#elegen2;
        		nn0;
        		error"in this case the degree of y should equal to degree of the place";
        	end if;        			
        	//error"becarefull the degree of elegen2 is bigger than 1";
        end if;
        //end of check the place 
        
        rts,_:=RootsInSplittingField(polgen1);
        			
        x_pt1:=rts[1][1];
                                      
        //two possible cases
        if Degree(polgen1) eq DgoFldplc1	then//(x^d+...+*,*y+*)
          fele1:=elegen2[1];
          fele2:=elegen2[2];
          
          //"fele1,fele2",fele1,fele2;
          //"x_pt1",x_pt1;
          if Evaluate(fele2,x_pt1) eq 0 then
            error"deno is zero!";
          end if;	
          y_pt1:=-Evaluate(fele1,x_pt1)/Evaluate(fele2,x_pt1);// only works for *y+?x^2+...
        else//(x+*,*y^d+...)
        	
        	POLYTP<t>:=PolynomialRing(BsFld);
        	fy:=POLYTP!0;		
        	for i:=1 to nn0 do
        			poly2:=Numerator(elegen2[i]);
        			if Denominator(elegen2[i]) ne 1 then error"the poly should be one";end if;
        			/*
        			if Degree(poly2) ne 0 then 
        				"Degree(poly2)",Degree(poly2);
        				"poly2",poly2;
        				error"the degree of poly should be 0";
        			end if;
        			a0:=Coefficient(poly2,0);
        			*/
        			a0:=Evaluate(poly2,x_pt1);
        			
        			fy:=fy+a0*t^(i-1);	        							
        	end for;
        			
        	//"fy",fy;
        	//Type(fy);        	
        	rts,_:=RootsInSplittingField(fy);
        	y_pt1:=rts[1][1];
        	//rts;
        	//y_pt1;			
        	//error"stop";
        end if;
        //"===============";	
        return true,x_pt1,y_pt1;	
end intrinsic;


intrinsic PointSetToPlace(FxFxyF::Tup,points::Tup)->PlcFunElt//Fx::FldFunRat,Fxy::FldFun,F::FldFin
{
	 F is the base finite field 
	Input the point set <<x1,y1>,...,<xn,yn>> which is a Galois conjugate set over F;
 
 copmute the  corresponding place of the function field 
 
}
		    n:=#points;
        	    //"points=",points;
		    /*
		     case degree(minimal(x1)) ge degree(minimal(y1))
		     1 x1 x1^2 ... x1^(n-1) b0    -y1
		     1 x2 x2^2 ... x2^(n-1) b1    -y2 
		     ...................... . 
		     1 xn xn^2 ... xn^(n-1)  bn-1  -yn 
		     represent yi's as linear combination of x^i's
		     
		     case degree(minimal(x1)) lt degree(minimal(y1))
		     1 y1 x1^2 ... y1^(n-1) b0    -x1
		     1 y2 x2^2 ... y2^(n-1) b1    -x2 
		     ...................... . 
		     1 yn yn^2 ... yn^(n-1)  bn-1  -xn 
		     represent xi's as linear combination of y^i's		    
		    */
		    Fx:=FxFxyF[1];
		    Fxy:=FxFxyF[2];
		    F:=FxFxyF[3];
		    			
		    x:=Fx.1;
		    y:=Fxy.1;	
		    
		    
		    Fldofx:=MinimalPolynomial(points[1][1],F);
		    Fldofy:=MinimalPolynomial(points[1][2],F);	
		    
		    
		    Ofld:=MaximalOrderFinite(Fxy);
		    
		    if Degree(Fldofx) ge Degree(Fldofy) then 	
		        K:=Parent(points[1][1]);
		        /*	
		        for i:=1 to n do//case l=17
		        	  yy:=points[i][2];
		        	  xx:=points[i][1];
		        	  		
		        	  fxxyy:=yy^4 + (xx^3 + xx^2 - xx + 2)*yy^3 + (xx^3 - 3*xx + 1)*yy^2 - (xx^4 + 2*xx)*yy + xx^3 + xx^2;
		        		if (fxxyy) ne 0 then
		        		     error "error in input point set. the ",i,"-th point wrong.";
		        		end if;	
		        end for;	
            */
   			    //"n=",n;
            R<X> := PolynomialRing(Parent(points[1][1]));
            
            FX:=R!1;
            
            for i:=1 to n do 
            	FX:=FX*(X-points[i][1]);    	
            end for;	
            
            disf:=Discriminant(FX);
		        //disf;
		        coeseq:=[[ points[j][1]^i : i in [0..n-1] ]:j in [1..n]];	
		        	
		        XM := Matrix(K, n, n, coeseq);
		        	
		        disM:=Determinant(XM)^2;
		        
		        if disM eq 0 then
		        	 "base field=",K;
		        	 "points=",points;
		        	 "XM=",XM;
		        	 error"the matrix is not invertible check the point set!";
		        end if;
		        //XM;	
		        if disf ne disM then error"what happen?";end if;	
		        		
		        invXM:=XM^(-1);
		        coeseq:=[-points[i][2]:i in [1..n]];	
		        YM:=	Matrix(K, n, 1, coeseq);
            B:=invXM*YM;
            
            geny:=y;
            
            for i:=1 to n do
            	
            		coeff:=MinimalPolynomial(B[i][1],F);
            			
            		if Degree(coeff) ne 1 then 
            		  "F=",F;
            		  "coeff=",coeff;	
            			error "error here 186 in pointSetToPlace";            			
            		end if;
            	
            		geny:=geny-Coefficient(coeff,0)*x^(i-1);
            	
            end for;
            //geny;
            		
            genx:=x^n;
            	    
            for i:=0 to n-1 do
            	ai:=Coefficient(FX,i);
            	coeff:=MinimalPolynomial(ai,F);
            	if Degree(coeff) ne 1 then error "error here";end if;
            		
            	genx:=genx-Coefficient(coeff,0)*x^(i);
            		
            end for;
            //"genx",genx;
            //"geny",geny;
            //"Fxy",Fxy;
            
            CSS:=CommonZeros(Fxy,[genx,geny]);
            if #CSS gt 1 then error"not a place"; end if;
            pls:=CSS[1];
         else
	    K:=Parent(points[1][2]);   	   
            R<Y> := PolynomialRing(Parent(points[1][2]));            
            FY:=R!1;
            
            for i:=1 to n do 
            	FY:=FY*(Y-points[i][2]);    	
            end for;	
            
            disf:=Discriminant(FY);
		        //disf;
		        coeseq:=[[ points[j][2]^i : i in [0..n-1] ]:j in [1..n]];	
		        	
		        YM := Matrix(K, n, n, coeseq);
		        	
		        disM:=Determinant(YM)^2;
		        
		        if disM eq 0 then
		        	 //"base field=",K;
		        	 //"points=",points;
		        	 //"YM=",YM;
		        	 error"the matrix is not invertible check the point set!";
		        end if;
		        //XM;	
		        if disf ne disM then
		        	//"base field=",K;
		        	 //"points=",points;
		        	 //"YM=",YM;
		        	 disM;
		        	 disf;
		        	 FY;
		        	  
		        	error"what happen disf should equal to disM";
		        end if;	
		        		
		        invYM:=YM^(-1);
		        	
		        coeseq:=[-points[i][1]:i in [1..n]];	
		        YM:=	Matrix(K, n, 1, coeseq);
            B:=invYM*YM;
            
            genx:=x;
            
            for i:=1 to n do
            	
            		coeff:=MinimalPolynomial(B[i][1],F);
            			
            		if Degree(coeff) ne 1 then error "error here";end if;
            	
            		genx:=genx-Coefficient(coeff,0)*y^(i-1);
            	
            end for;
            //geny;
            		
            geny:=y^n;
            	    
            for i:=0 to n-1 do
            	ai:=Coefficient(FY,i);
            	coeff:=MinimalPolynomial(ai,F);
            	if Degree(coeff) ne 1 then error "error here";end if;
            		
            	geny:=geny-Coefficient(coeff,0)*y^(i);
            		
            end for;
	     CSS:=CommonZeros(Fxy,[genx,geny]);
             if #CSS gt 1 then error"not a place"; end if;
             pls:=CSS[1];                     	
        end if;	    	
        return pls;	
	  
            	
end intrinsic;

intrinsic diamondcusp(Cusps::SeqEnum,Dvr::DivFunElt,n::RngIntElt,d::RngIntElt,Horbits::SeqEnum)->DivFunElt
{diamond operators <d> acting on cusp n is the level}
  	 
     supp,exps:=Support(Dvr);
  	     
     D:=Dvr-Dvr;	
  	 	     
     for i:=1 to #supp do
        cusi:=CuspIndex(supp[i],Cusps);
        //"cusi",cusi;
        ddd:=Horbits[cusi][1];
                
        //Tqn(q,n,l);		
        qn:=Tqn(d,ddd,n);
        for j:=1 to #Horbits do
        	if qn in Horbits[j] then
        		qn:=j;
        		break;
        	end if;	       	
        end for;
        
        //"qn",qn;     
        D:=D+ exps[i]*(Cusps[qn]);  
     end for;

     return D;
		
end intrinsic;


intrinsic dPlace(FxFxyF::Tup,p_q_l::Tup,P::PlcFunElt,d::RngIntElt)->BoolElt,DivFunElt
{<d>P}
	 Fx:=FxFxyF[1];
	 Fxy:=FxFxyF[2];
	 F:=FxFxyF[3];
				      		
	 p:=p_q_l[1];//character
	 q:=p_q_l[2];//T_q 
	 l:=p_q_l[3];//l-torsion
	 
	 num:=#F;
	 	
	 DgoFldplc1:=Degree(P);
	 		
	 tf,X,Y:=PlaceToPoint(F,P);
	 
	 if tf eq false then return false,0;end if;

	 if EvaluteXH(X,Y) eq false then 
	 	P;
	 	X;
	 	Y;	 	
	 	error"XHl!=0 line 389";
	 end if;	 	 	 
	 
	 time rootsxy:=AbovePoint(<X,Y>);//a point on Xone(31) above (u,v)
	 "time AbovePoint";

	 if tf eq false then return false,0;end if;
	 
	 X:=rootsxy[1];
	 Y:=rootsxy[2];	 
	 if EvaluteX1(X,Y) eq false then 
	 	error"fl !=0 line 419";
	 else
	 	//"yes X29 =0 line 423";
	 end if;	 	 
	 
	 u:=rootsxy[1];
	 v:=rootsxy[2];
	 	   	
	 r:=(u^2*v-u*v+v-1)/(u^2*v-u);
	 s:=(u*v-v+1)/(u*v);
	 c:=s*(r-1);
	 b:=r*c;		 		

   
   tf,E:=IsEllipticCurve([1-c,-b,-b,0,0]);
   
   if tf eq false then return false,0;end if;
   
   pt:=E![0,0,1];
   dpt:=d*pt;
   	
   //TateNormalForm(E::CrvEll,usdpt::PtEll,l::RngIntElt) -> CrvEll			
   TateF1:=TateNormalForm(E,dpt,l);
   a1,a2,a3,a4,a6:=Explode(aInvariants(TateF1));
	
   //Y^2+a1*xy+a3*Y=X^3+a2*X^2+a4*X+a6
	
   if (a4 ne 0) or (a6 ne 0) or (a3 ne a2) then 
		error"the result elliptic curve is not in needed form!";
   end if;
   //"-------1---------";			

   	c:=1-a1;
   	b:=-a3;
   	r41:=b/c;
   	s41:=c/(r41-1);
   	X:=(s41-r41)/(r41*s41-2*r41+1);
   	Y:=(r41*s41-2*r41+1)/(s41^2-s41-r41+1);
   if EvaluteX1(X,Y) eq false then error"fl!=0 480";end if;
    //"-------2---------";
 
 	tmp:=UnderPoint(<X,Y>);
       	ixx:=tmp[1];
       	iyy:=tmp[2];
       	 
       	 Rts:=<<ixx,iyy>>; 	 	
	 	
	//add the all the conjugate set of point (degree of the place) 
        tmp:=<>;
        for jj:=1 to #Rts do
        		for ii:=0 to DgoFldplc1-1 do
        		cc:=<(Rts[jj][1])^(num^(ii)),(Rts[jj][2])^(num^(ii))>;	
        	  //"-----------";
        	  Append(~tmp,cc);
        	  //"+++++++++++";
        		end for;
        end for;
        //"-------3---------";        

        nxys:=#tmp;	//number of xy pairs	
        //"-------------------";
	xys:=tmp;	      
	//"------ TqPlace 2----------",Cputime();	
	divori:=P-P;	
	while true do
	            //"xys",xys;
	            //"TqPlace 2 -1",Cputime();
	            
	            minpoly:=Polyofbc(xys[1],F);
		    //"---4----";		      		
		    for i:=0 to Degree(minpoly)-1 do
		    		      		  
		     	  if Tupinornot(<xys[1][1]^(num^i),xys[1][2]^(num^i)>,xys) eq false then 
		     	  	"i=",i,<xys[1][1]^(num^i),xys[1][2]^(num^i)>;
		     	  	error"the input pairs are not complete";
		     	  end if;
		     	
		    end for;
		    //"TqPlace 2 -2",Cputime();
		    ptset:=<>;
                    for jj:=0 to Degree(minpoly)-1 do
                     		//check check
                     		f1:=(xys[1][1])^(num^jj);//==X
                     		f2:=(xys[1][2])^(num^jj);//==Y
 
                 		if EvaluteXH(f1,f2) eq false then error"XHl!=0 531";end if;                                                                              
                    		//end check                   
                        	Append(~ptset,<(xys[1][1])^(num^jj),(xys[1][2])^(num^jj)>);            		
                    end for;
                    //"====================";	
                    //"ptset=",ptset;

                    //"time in point set to place";      	
		    plc:=PointSetToPlace(FxFxyF,ptset);
		    eofplc:=0;
		    //"TqPlace 2 -4",Cputime();	
		    for kk:=1 to #xys do
		    		if xys[1] eq xys[kk] then 
		    			eofplc:=eofplc+1;
		    		end if;
		    end for;
		    //"eofplc=",eofplc;
		    //"~~~~~~~~~~~~~~~~~~";	      		
		    divori:=divori+eofplc*plc;
		    newxys:=<>;
		    //"TqPlace 2 -5",Cputime();  
		    for kk:=1 to #xys do
		    	  if Tupinornot(<xys[kk][1],xys[kk][2]>,ptset) eq false then
		    	    Append(~newxys,xys[kk]);
		    	  end if;	
		    end for;
		    //"TqPlace 2 -6",Cputime();			
		    xys:=newxys;
		    	
		    if #xys eq 0 then break;end if;			      
	end while;       
	// "-------4---------";	      
	//"------ TqPlace 3----------",Cputime();
	      
	      
        if Degree(divori) ne DgoFldplc1 then
        	"Degree(divori)=",Degree(divori);
        	"tmp", tmp;
        	"DgoFldplc1", DgoFldplc1;
        	 "q",q;
        	 
        	error"problem with your program TqPlace() 582";
        end if;
        	
	return true,divori;	 	
	 	
end intrinsic;

intrinsic dDivisor(FxFxyF::Tup,Cusps::SeqEnum,Dvr::Tup,p_q_l::Tup,d::RngIntElt,Horbits::SeqEnum)->BoolElt,Tup
{<d>(dvr)}
  
  O:=Divisor( Cusps[1] );
		
	noncusppart:=1*Dvr[1];
	
	cuspspart:=Dvr[3]*Dvr[2];
			
  //cuspspart,noncusppart:=SeperateCusp(Cusps,Dvr);
  
  Dvr1:=O-O;
  supp1,exps1:=Support(noncusppart);
  for i:=1 to #supp1 do
  	  if  IsFinite(supp1[i]) eq false then
  	  	"infinite place in divisor"; 
  	  	return false,<0,0,0>; 
  	  end if;	
  		tf,dimoadP:=dPlace(FxFxyF,p_q_l,supp1[i],d);
  		Dvr1:=Dvr1+1*dimoadP;	
  end for;
  
  Dvr2:=diamondcusp(Cusps,cuspspart,p_q_l[4],d,Horbits);
  
  D:=Dvr1+Dvr2;
  	
  Dtilde,rdg,Advr,aele:=Reduction(D, O);
  	
  return true,<Dtilde,O,rdg>;				
  
end intrinsic;

intrinsic T2Place(FxFxyF::Tup,p_q_l::Tup,P::PlcFunElt)->BoolElt,DivFunElt
{compute T2(P)}
	Fx:=FxFxyF[1];
	Fxy:=FxFxyF[2];
  	F:=FxFxyF[3];
		    		      		
	p:=p_q_l[1];//character
	q:=p_q_l[2];//T_q
	l:=p_q_l[3];//l-torsion
	
	Rts:=<>;
	      
	num:=#F;
	      	
	DgoFldplc1:=Degree(P);
	//"Place P",P;
	tf,X,Y:=PlaceToPoint(F,P);
        if Degree(Parent(X)) ge Degree(Parent(Y))then
           FFXY:=(Parent(X));
        else
           FFXY:=(Parent(Y));
        end if;
        //"X,Y",X,Y;
	//"Parent(X,Y)",FFXY;
	if Degree(FFXY,F) ne DgoFldplc1 then error"Degree(FFXY,F) ne DgoFldplc1 645";end if;
	//"place to point (X,Y)",X,Y;
	 
	if tf eq false then return false,0;end if;
	
	time rootsxy:=AbovePoint(<X,Y>);
	"time AbovePoint";
			 	
	u:=rootsxy[1];
	v:=rootsxy[2];
	
	//"Parent(u)",Parent(u);
	//"Parent(v)",Parent(v);
	      	
	//coordinate change
	r:=(u^2*v-u*v+v-1)/(u^2*v-u);
	s:=(u*v-v+1)/(u*v);
	c:=s*(r-1);
	b:=r*c;			
	
  	E:=EllipticCurve([1-c,-b,-b,0,0]);//Y^2+(1-c)xy-by=X^3-bx^2
	//E1;
	//Order(E1);

  	if IsSingular(E) eq true then   	
  		"the elliptic curve is singular" ;
  		return false,<0,0>;
  	end if;
  	
  	if IsSupersingular(E) eq true then 
  		"the elliptic curve is supersingular";
  		return false,<0,0>;
  	end if;
    	 
  	K:=BaseRing(E);
	//K;
	f2:=DivisionPolynomial(E,2);
	Num:=#K;
		
	//case irreducible
	if IsIrreducible(f2) then	//000000	
		"case irreducible";
  		L:=ext<K|3>;
  		Eext:=BaseChange(E,L);	
  		//"----1---factoring poly --";		
  		fts:=Factorization(PolynomialRing(L)!f2);
  		ker1:=fts[1][1];//select on kernel
  		
  		//"Eext",Eext;
  		//"ker1",ker1;
  		//"----2---- IsogenyFromKernel -";	
		F1_1,map:=IsogenyFromKernel(Eext,ker1);			
		pt:=Eext![0,0,1];
		imgpt:=map(pt);	
		//error"stop";	
		
    		//"--------------------- 6-1 ---------------------------";
    		//"----3---- TateNormalForm -";   	
    		TateF1:=TateNormalForm(F1_1,imgpt,l);
    		//"Tate normal form:",TateF1;
		//"--------------------- 7 ---------------------------";
		a1,a2,a3,a4,a6:=Explode(aInvariants(TateF1));
			
		//Y^2+a1*xy+a3*Y=X^3+a2*X^2+a4*X+a6
			
		if (a4 ne 0) or (a6 ne 0) or (a3 ne a2) then 
				error"the result elliptic curve is not in needed form!";
		end if;
					
		//using galois theory to deduce the other two elliptic curves
				
        	
   			c:=1-a1;
   			b:=-a3;
   			r29:=b/c;
   			s29:=c/(r29-1);
   			X:=(s29-r29)/(r29*s29-2*r29+1);
   			Y:=(r29*s29-2*r29+1)/(s29^2-s29-r29+1);
					
			if EvaluteX1(X,Y) eq false then error"fl!=0 729";end if;
			        	
		tmp:=UnderPoint(<X,Y>);
		ixx:=tmp[1];
		iyy:=tmp[2];
			      	          
		if Degree(Parent(ixx)) ge Degree(Parent(iyy))then
		   FFixxiyy:=Parent(ixx);
		else
		    FFixxiyy:=Parent(iyy);
		end if;
		
		//"parent(ixx,iyy)",FFixxiyy;
		
		dixx:=MinimalPolynomial(ixx,FFXY);
		diyy:=MinimalPolynomial(iyy,FFXY);
		
		if dixx ge diyy then
		  FFixxiyy:=ext<FFXY | dixx>;
		else
		  FFixxiyy:=ext<FFXY | diyy>;
		end if;
		
		//"exact parent(ixx,iyy)",FFixxiyy;       	          
		
		//"under point (ixx,iyy)",ixx,iyy;
		
		ddi:=Degree(FFixxiyy,FFXY);   
		
		if ddi ne 3 then error"irreducible case, extension degree should be 3 ";end if;
		       	                     	                 	          
		tmpnum:=#FFXY;
		 	      		
		for ii:=0 to ddi-1 do
		      Append(~Rts,<ixx^(tmpnum^ii),iyy^(tmpnum^ii)>);	
		end for;   	  										
			
	
	else//000000 case f2=(X-alph)*g, degree(g) eq 2 irreducible //11111
		//"----1---- Factorization(f2) -";
		ftsss:=Factorization(f2);
			
		if #ftsss eq 2 then//case f2=(X-alph)*g, degree(g) eq 2 irreducible //11111
	    	"case degree two irreducible poly";
	    	//"f2=",f2;
	    	//"Factorization(f2)",Factorization(f2);
	    	//"----1---- Factorization(f2) -";
	    	fts:=ftsss;
	  	if Degree(fts[1][1]) eq 1 then	
	  		pol1:=fts[1][1];
	  		pol2:=fts[2][1];		
	     	else
	  		pol1:=fts[2][1];
	  		pol2:=fts[1][1];	     	
	     	end if;
	     		     	
	     	//first isogeny curve
	     	//"---2-- IsogenyFromKernel";		     
	     	F1_1,map:=IsogenyFromKernel(E,pol1);			
		pt:=E![0,0,1];
		imgpt:=map(pt);	
		//error"stop";	
	     
       		//"--------------------- 6-1 ---------------------------";
       		//"---3---TateNormalForm";   	
       		TateF1:=TateNormalForm(F1_1,imgpt,l);
       		//"Tate normal form:",TateF1;
		//"--------------------- 7 ---------------------------";
		a1,a2,a3,a4,a6:=Explode(aInvariants(TateF1));
		   
		//Y^2+a1*xy+a3*Y=X^3+a2*X^2+a4*X+a6
		   
		if (a4 ne 0) or (a6 ne 0) or (a3 ne a2) then 
		   	error"the result elliptic curve is not in needed form!";
		 end if;	
	     
	
	   		c:=1-a1;
	   		b:=-a3;
	   		r29:=b/c;
	   		s29:=c/(r29-1);
	   		X:=(s29-r29)/(r29*s29-2*r29+1);
	   		Y:=(r29*s29-2*r29+1)/(s29^2-s29-r29+1);
			
			   if EvaluteX1(X,Y) eq false then error"fl!=0 815";end if;
 	          
 	        tmp:=UnderPoint(<X,Y>);
       	        ix:=tmp[1];
       	        iy:=tmp[2];
       	               	                	          
       	        if Degree(Parent(ix)) ge Degree(Parent(iy))then
       	           FFixxiyy:=Parent(ix);
       	        else
       	           FFixxiyy:=Parent(iy);
       	        end if;
       	        
       	        //"parent(ix,iy)",FFixxiyy;

       	        dixx:=MinimalPolynomial(ix,FFXY);
       	        diyy:=MinimalPolynomial(iy,FFXY);

       	        if dixx ge diyy then
       	          FFixxiyy:=ext<FFXY | dixx>;
       	        else
       	          FFixxiyy:=ext<FFXY | diyy>;
       	        end if;
       	        
       	        //"exact parent(ixx,iyy)",FFixxiyy;       	          
       	        
       	        //"under point (ixx,iyy)",ixx,iyy;
       	        
       	        ddi:=Degree(FFixxiyy,FFXY);   
       	        if ddi ne 1 then error"degree 1 * degree 2, first root extension degree should be 1 ";end if;       	                     	                 	          
       	        tmpnum:=#FFXY;
       	         	      		
	        for ii:=0 to ddi-1 do
	              Append(~Rts,<ix^(tmpnum^ii),iy^(tmpnum^ii)>);	
	        end for;	 
	  	
	  	
	  	//two conjugate set->elliptic curves


		L:=ext<K|2>;
  		Eext:=BaseChange(E,L);
  		//"---4--- Factorization";			
  		fts:=Factorization(PolynomialRing(L)!pol2);
  		ker1:=fts[1][1];//select on kernel
  		
  		//"----5---IsogenyFromKernel";	
			F1_1,map:=IsogenyFromKernel(Eext,ker1);			
			pt:=Eext![0,0,1];
			imgpt:=map(pt);	
			//error"stop";	
		
    		//"--------------------- 6-1 ---------------------------";
    		//"----6---TateNormalForm";   	
    		TateF1:=TateNormalForm(F1_1,imgpt,l);
    		//"Tate normal form:",TateF1;
		//"--------------------- 7 ---------------------------";
		a1,a2,a3,a4,a6:=Explode(aInvariants(TateF1));
		
		//Y^2+a1*xy+a3*Y=X^3+a2*X^2+a4*X+a6
		
		if (a4 ne 0) or (a6 ne 0) or (a3 ne a2) then 
			error"the result elliptic curve is not in needed form!";
		end if;
		

   		c:=1-a1;
   		b:=-a3;
   		r29:=b/c;
   		s29:=c/(r29-1);
   		X:=(s29-r29)/(r29*s29-2*r29+1);
   		Y:=(r29*s29-2*r29+1)/(s29^2-s29-r29+1);						
		if EvaluteX1(X,Y) eq false then error"fl!=0 904";end if;

			 
 	        tmp:=UnderPoint(<X,Y>);
       	        ix:=tmp[1];
       	        iy:=tmp[2];
       	        
       	              	          
       	        if Degree(Parent(ix)) ge Degree(Parent(iy))then
       	           FFixxiyy:=Parent(ix);
       	        else
       	            FFixxiyy:=Parent(iy);
       	        end if;
       	        
       	        //"parent(ix,iy)",FFixxiyy;

       	        dixx:=MinimalPolynomial(ix,FFXY);
       	        diyy:=MinimalPolynomial(iy,FFXY);
       	        
       	        if dixx ge diyy then
       	          FFixxiyy:=ext<FFXY | dixx>;
       	        else
       	          FFixxiyy:=ext<FFXY | diyy>;
       	        end if;
       	        
       	        //"exact parent(ix,iy)",FFixxiyy;       	          
       	        
       	        //"under point (ixx,iyy)",ixx,iyy;
       	        
       	        ddi:=Degree(FFixxiyy,FFXY);   
       	        if ddi ne 2 then error"degree 1 * degree 2, second root extension degree should be 2 ";end if;         	                     	                 	          
       	        tmpnum:=#FFXY;
       	         	      		
	        for ii:=0 to ddi-1 do
	              Append(~Rts,<ix^(tmpnum^ii),iy^(tmpnum^ii)>);	
	        end for;
	  	
	  		  					     	
	 else//f2=(X-alpha1)(X-alpha2)(X-alpha3)//11111
	  "factored completely";		  
	  //"---1---,Factorization";	
	  for i:=1 to 3 do
	  	
	  	kerpol:=ftsss[i][1];
	  	//"--2---IsogenyFromKernel";	
	     	F1_1,map:=IsogenyFromKernel(E,kerpol);			
		pt:=E![0,0,1];
		imgpt:=map(pt);	
		//error"stop";	
	     
       		//"--------------------- 6-1 ---------------------------";
       		//"---3---TateNormalForm";   	
       		TateF1:=TateNormalForm(F1_1,imgpt,l);
       		//"Tate normal form:",TateF1;
		//"--------------------- 7 ---------------------------";
		a1,a2,a3,a4,a6:=Explode(aInvariants(TateF1));
		   
		//Y^2+a1*xy+a3*Y=X^3+a2*X^2+a4*X+a6
		   
		if (a4 ne 0) or (a6 ne 0) or (a3 ne a2) then 
		   	error"the result elliptic curve is not in needed form!";
		 end if;	
	     

   		c:=1-a1;
   		b:=-a3;
   		r29:=b/c;
   		s29:=c/(r29-1);
   		X:=(s29-r29)/(r29*s29-2*r29+1);
   		Y:=(r29*s29-2*r29+1)/(s29^2-s29-r29+1);						
		if EvaluteX1(X,Y) eq false then error"fl!=0 964";end if;
			 
 	        tmp:=UnderPoint(<X,Y>);
       	        ix:=tmp[1];
       	        iy:=tmp[2];      	        
       	               	              	          
       	        if Degree(Parent(ix)) ge Degree(Parent(iy))then
       	           FFixxiyy:=Parent(ix);
       	        else
       	            FFixxiyy:=Parent(iy);
       	        end if;
       	        
       	        //"parent(ixx,iyy)",FFixxiyy;

       	        dixx:=MinimalPolynomial(ix,FFXY);
       	        diyy:=MinimalPolynomial(iy,FFXY);
       	        
       	        if dixx ge diyy then
       	          FFixxiyy:=ext<FFXY | dixx>;
       	        else
       	          FFixxiyy:=ext<FFXY | diyy>;
       	        end if;
       	        
       	        ddi:=Degree(FFixxiyy,FFXY);   
       	        if ddi ne 1 then 
       	        	//"degree 1 * degree 1 *degree 1, extension degree should be 1 except special case!!! ";
       	                 	                     	                 	          
       	        	tmpnum:=#FFXY;
       	         	      		
	        	for ii:=0 to ddi-1 do
	              		//check whether <ix^(tmpnum^ii),iy^(tmpnum^ii)> in Rts very special situation!!
	              		//T_2(P)=P1+P2+P3, pair-wise different?
	              		tfgg:=true;
	              		if #Rts ge 1 then	              		
	              			for iii:=1 to #Rts do
	              				if Rts[iii][1] eq ix^(tmpnum^ii) and Rts[iii][2] eq iy^(tmpnum^ii) then
	              					tfgg:=false;
	              					break;
	              				end if;
	              			end for;
	              		end if;
	                	
	              		if tfgg then
	              			Append(~Rts,<ix^(tmpnum^ii),iy^(tmpnum^ii)>);
	              		end if;		
	        	end for;
	        else
	        	//T_2(P)=P1+P2+P3, pair-wise different? no!	        
	        	Append(~Rts,<ix,iy>);  	
	  	end if;
	  	
	  	//"Rts=",Rts;
	  end for;	
		
	end if;//11111
		
end if;//000000		
						
	//add the all the conjugate set of point (degree of the place) 
        tmp:=<>;
        for jj:=1 to #Rts do
        	for ii:=0 to DgoFldplc1-1 do
        		cc:=<(Rts[jj][1])^(num^(ii)),(Rts[jj][2])^(num^(ii))>;	
        	 	 //"-----------";
        	  	Append(~tmp,cc);
        	  	//"+++++++++++";
        	end for;
        end for;
        //"tmp=", tmp;
        //error"stop";
        nxys:=#tmp;	//number of xy pairs	
        //"-------------------";
	      
	xys:=tmp;
	//"first xys",xys;
	//Type(xys);
	
	//"------ TqPlace 2----------",Cputime();	
	divori:=P-P;	
	while true do
	      //"xys",xys;
	      //"time in Polyofbc";
	      minpoly:=Polyofbc(xys[1],F);
		    		      		
		    for i:=0 to Degree(minpoly)-1 do
		    		      		  
		     	  if Tupinornot(<xys[1][1]^(num^i),xys[1][2]^(num^i)>,xys) eq false then 
		     	  	"i=",i,<xys[1][1]^(num^i),xys[1][2]^(num^i)>;
		     	  	error"the input pairs are not complete";
		     	  end if;
		     	
		    end for;
		    //"TqPlace 2 -2",Cputime();
		    ptset:=<>;
        	    for jj:=0 to Degree(minpoly)-1 do
        	        	Append(~ptset,<(xys[1][1])^(num^jj),(xys[1][2])^(num^jj)>);            		
        	    end for;
        	    //"====================";	
        	    //"ptset=",ptset;
        	    //"time in point set to place";      	
		    plc:=PointSetToPlace(FxFxyF,ptset);
		    eofplc:=0;
		    //"TqPlace 2 -4",Cputime();	
		    for kk:=1 to #xys do
		    		if xys[1] eq xys[kk] then 
		    			eofplc:=eofplc+1;
		    		end if;
		    end for;
		    //"eofplc=",eofplc;
		    //"~~~~~~~~~~~~~~~~~~";	      		
		    divori:=divori+eofplc*plc;
		    newxys:=<>;
		    //"TqPlace 2 -5",Cputime();  
		    for kk:=1 to #xys do
		    	  if Tupinornot(<xys[kk][1],xys[kk][2]>,ptset) eq false then
		    	    Append(~newxys,xys[kk]);
		    	  end if;	
		    end for;
		    //"TqPlace 2 -6",Cputime();			
		    xys:=newxys;
		    	
		    if #xys eq 0 then break;end if;			      
	end while;       
	      	      	      
        if Degree(divori) ne (q+1)*DgoFldplc1 then
        	"Degree(divori)=",Degree(divori);
        	"tmp", tmp;
        	"DgoFldplc1", DgoFldplc1;
        	 "q",q;
        	 
        	error"problem with your program TqPlace() 1132";
        end if;
        	
	return true,divori;
							
end 	intrinsic;
	

intrinsic TqCusp(Cusps::SeqEnum,Dvr::DivFunElt,q::RngIntElt,n::RngIntElt,Horbits::SeqEnum)->DivFunElt
{compute the action of T_q on a divisor Q wihch contains only cusps Tq(Cusps)=Cusps+q*<q>Cusps}	
	return (Dvr+q*diamondcusp(Cusps,Dvr,n,q,Horbits));     
end intrinsic;

intrinsic T2Divisor(FxFxyF::Tup,Cusps::SeqEnum,Dvr::Tup,p_q_l::Tup,Horbits::SeqEnum)->BoolElt,Tup
{T2(Dvr),Dvr=[Dtilde,O,rdg]}	
 
	O:=Divisor( Cusps[1] );
		
	noncusppart:=1*Dvr[1];
	
	cuspspart:=Dvr[3]*Dvr[2];
						
	supp1,exps1:=Support(noncusppart);
	//"Dvr supp1",Dvr,supp1;
	
  //"time in support";
  Dvr1:=O-O;
  		
  for i:=1 to #supp1 do
  	//"T2Divisor i,e degree",i,exps1[i],Degree(supp1[i]);
  	 tf:=true;
  	 if supp1[i] in Cusps then 
  	 	//"becarefull!! divisor supp1[i] in Cusps 1235";
  	 	cuspspart:=cuspspart+exps1[i]*supp1[i];  	 	 
  	 else  	 
  	 	tf,QQ:=T2Place(FxFxyF,p_q_l,supp1[i]);
  	 	//"time in one T2Place";
  		if tf eq false then
  			"try another random divisor T2Place return false 1199";
  			return false,<0,0,0>;   		
  		//break;
  		end if;  		  	 	
  	 	Dvr1:=Dvr1+exps1[i]*(QQ);
  	 end if;
  	 	

  	//"degree(QQ)=",Degree(QQ);			  	 		
  end for;
  
  Dvr2:=TqCusp(Cusps,cuspspart,2,p_q_l[3],Horbits);		
  //"time used in TqCusp";
  TqDvr:=Dvr1+Dvr2;
    		  	    	
  Dtilde,rdg,Advr,aele:=Reduction(TqDvr, O);
  
  //"Dtilde",Support(Dtilde);
  "reduction degree",rdg;
  //"time in one reduction";
  // check closed
	 
  if Degree(TqDvr)	ne 0 then error"T2Divisor(divosor) not degre 0";end if;
   
  return true,<Dtilde,O,rdg>; 
   
end 	intrinsic;


intrinsic BqTqDvr(FxFxyF::Tup,Bq::RngUPolElt,Cusps::SeqEnum,Dvr::Tup,p_q_l::Tup,Horbits::SeqEnum)->BoolElt,Tup
{ input a divisor given as Q-g*O,compute (Tq^d+...+a0)(Q-g*O),where T_q^d+...+a0 is the polynomial Bq 
	output is a diviosr given as D-g*O}
  	
  O:=Divisor(Cusps[1]);//arranged as 1,1/2,...,1/n,n=(l-1)/2	
  						  
  nd:=Degree(Bq);
  
  SaveTqDvr:=<Dvr>;
  
  a0:=Integers()!Coefficient(Bq,0);
  	
  FinalDvr:=a0*(Dvr[1]+Dvr[3]*Dvr[2]);
  
  "Bq",Bq;
  "degree(Bq)",nd;
  "compute Bq(Tq)(Dvr)";
  	
  for i:=1 to nd do
  	   	//"q,i",p_q_l[2],i;
       		tmpTqDvr:=SaveTqDvr[i];
       
       		if p_q_l[2] eq 2 then
  		 tf,tmp:=T2Divisor(FxFxyF,Cusps,tmpTqDvr,p_q_l,Horbits);
  		else
  		 error"we have not yet consider the operator of level=",p_q_l[2];
  		end if; 	
  		
  		if tf eq false then
  		    "try another random divisor T2Divisor return fasle";	
  		 	  break;
  		 end if;
  		 		  	   
  	   Append(~SaveTqDvr,tmp);
  	   
  	   ai:=Integers()!Coefficient(Bq,i);
  	   if ai ne 0 then
  	   	   FinalDvr:=FinalDvr+(ai)*(tmp[1]+tmp[3]*tmp[2]);
  	   	   	
  	   	   Dtilde,rdg,Advr,aele:=Reduction(FinalDvr, O);
  	   	   //"time in reduction i=";
  	   	   	
  	   	   FinalDvr:=Dtilde+rdg*O;	
  	   end if;
  	   //"finished q,i",p_q_l[2],i;
  end for;
  //"end of compute Bq(Tq)(Dvr)"; 	
  if tf eq false then return false,<0,0,0>;end if;
  	  	      
  return true,<Dtilde,O,rdg>;

end intrinsic;

/*
  Given Elliptic curve E over F_q and l-isogeny curve's j-invariant jp over F_q
  compute the isogeny curve F1 over F_q such that
  E isogeny to F1 over F_q
  output then isogeny curve's weiestress equation.

  source copy from magma m_isogenies.m
*/
intrinsic IsogenyCurveFromEjpl(E::CrvEll,jp::FldFinElt,l::RngIntElt) -> CrvEll

{
    source copy from magma m_isogenies.m
}

    K := BaseRing(E);
    Kring:=PolynomialRing(K,2);
    Kring;
    p:=l;
    j_p:=jp;
    Phi:=Kring!ClassicalModularEquation(l);
    j:=jInvariant(E);

    error if Characteristic(K) in {2,3}, "Argument 1 must be defined over a field of characteristic other than 2 or 3.";


   E1, m1 := WeierstrassModel(E);
    _, _, _, a4, a6 := Explode(aInvariants(E1));

    E4, E6 := Explode(cInvariants(E));
    error if j eq 0,
	"Domain curve must not have j-invariant 0.";
    error if j eq 12^3,
	"Domain curve must not have j-invariant 12^3.";
    error if j_p eq 0,
	"Codomain curve must not have j-invariant 0.";
    error if j_p eq 12^3,
	"Codomain curve must not have j-invariant 12^3.";
    error if Characteristic(BaseRing(E)) in {2,3},
	"Argument 1 must be defined over a field " *
	"of characteristic different from 2 and 3.";

    P2 := Parent(Phi);
    X := P2.1; Y := P2.2;
    DxPhi := Derivative(Phi, X);

    DxPhiJJ := Evaluate(DxPhi, [j,j_p]);
    DyPhiJJ := Evaluate(DxPhi, [j_p,j]);
    error if DyPhiJJ eq 0,
        "Argument 1 must not be a singularity of curve model.";

    j_prime := -E6*j/E4;
    j_p_prime := -j_prime*DxPhiJJ/(p*DyPhiJJ);

    lambda := -j_p_prime/j_p;
    E4_p := lambda^2*j_p/(j_p-12^3);
    E6_p := lambda*E4_p;

    DxxPhi := Derivative(DxPhi, X);
    DxyPhi := Derivative(DxPhi, Y);

    DxxPhiJJ := Evaluate(DxxPhi, [j,j_p]);
    DxyPhiJJ := Evaluate(DxyPhi, [j,j_p]);
    DyyPhiJJ := Evaluate(DxxPhi, [j_p,j]);

    j_pp := -( j_prime^2*DxxPhiJJ +
               2*p*j_prime*j_p_prime*DxyPhiJJ +
               p^2*j_p_prime^2*DyyPhiJJ ) / (j_prime*DxPhiJJ);
    c2 := 6*j_pp + (3*E4^3 + 4*E6^2)/(E4*E6)
	         - p * (3*E4_p^3 + 4*E6_p^2)/(E4_p*E6_p);

    F1 := EllipticCurve([-p^4*E4_p/48,-p^6*E6_p/864]);

    return F1;
end intrinsic;

intrinsic Isogenymaps(E::CrvEll,psi::RngUPolElt,l::RngIntElt) -> Tup
{ Input origin elliptic curve E,polynomial defining isogeny kerenel psi, and the degree of the isogeny
  ouput maps of the isogeny, phix,omegaxy;
}

	R := BaseRing(E);
	S<x>:=Parent(psi);
	
	T<y>:=PolynomialRing(S);

	if Characteristic(R) eq 2 then error "error occuring! the characteristic of the base field should not equal 2";end if;
	
	if (l mod 2) eq 0 then error "error occuring! the degree of the isogeny should not be even";end if;
	
  a1,a2,a3,a4,a6 := Explode(aInvariants(E)); 
  b2,b4,b6 := Explode(bInvariants(E)); 

	r:=Degree(psi);
	s1:=-Coefficient(psi,r-1);
	dpsi:=Derivative(psi);
	ddpsi:=Derivative(dpsi);

	phix:=(4*x^3+b2*x^2+2*b4*x+b6)*(dpsi^2-ddpsi*psi)-(6*x^2+b2*x+b4)*dpsi*psi+(l*x-2*s1)*psi^2;
	
	psi2:=2*y+a1*x+a3;
	
	dphix:=Derivative(phix);

	omegaxy:=dphix*psi*psi2/2-phix*dpsi*psi2-(a1*phix+a3*psi^2)*psi/2;

	return <phix,omegaxy>;

end intrinsic;

intrinsic VeluTargetCurve(E0::CrvEll,psi0::RngUPolElt) ->CrvEll
{compute the isogeny curve using velu s formulae}
   // Returns codomain E1 of the isogeny of Velu, defined with 
   // respect to the monic kernel polynomial psi0.} 

   R := BaseRing(E0); 
   //F := FunctionField(R);
   a1,a2,a3,a4,a6 := Explode(aInvariants(E0)); 
   b2,b4,b6 := Explode(bInvariants(E0)); 
   Psi0 := psi0;//Numerator(F!Eltseq(psi0)[1]);
   //Psi0;
   //F!Eltseq(psi0);
   S := Parent(Psi0); X := S.1;
   Psi2 := 4*X^3 + b2*X^2 + 2*b4*X + b6; // a polynomial. 
   r := Degree(Psi0); 
   e := Degree(GCD(Psi2,Psi0)); 
   N := 2*r + e + 1;  
   s1 := -Coefficient(Psi0,r-1); 
   s2 := R!0; s3 := R!0; 
   if r ge 3 then 
      s2 := Coefficient(Psi0,r-2);  
      s3 := -Coefficient(Psi0,r-3); 
   elif r ge 2 then  
      s2 := Coefficient(Psi0,r-2);  
   end if; 
   a1,a2,a3,a4,a6 := Explode(aInvariants(E0)); 
   b2,b4,b6,b8 := Explode(bInvariants(E0)); 
   p1 := s1; p2 := s1^2 - 2*s2; p3 := s1^3 - 3*s1*s2 + 3*s3; 
   t0 := 6*p2 + b2*p1 + r*b4; 
   w0 := 10*p3 + 2*b2*p2 + 3*b4*p1 + r*b6; 
   if (N mod 2) eq 1 then 
      E1 := EllipticCurve([a1,a2,a3,a4 - 5*t0,a6 - b2*t0 - 7*w0]); 
   else  
      E1 := EllipticCurve([a1,a2,a3,a4 - 5*t0/2,a6 - b2*t0/2 - 7*w0/2]); 
   end if; 
   	if IsSingular(E1) eq true then error "error occur!" ;end if;
   return E1; 
end intrinsic;

intrinsic PsiKernel(E::CrvEll,l::RngIntElt) -> Tup
{computing defining polynomials of l+1 cyclic sbgps of E[l]}	

	K:=BaseRing(E);

	PRE<x> := PolynomialRing(K);
	//PRE;
	//"K",K;
	//"E",E;
	/*
	NumOfE:=Order(E);
	ord_l:=	Valuation(NumOfE,l);
	//"NumOfE",NumOfE;
	if ord_l lt 2 then
		"NumOfE",NumOfE; 
		"l",l;
		"ord_l=",ord_l; 
		error "the cardinality should be divided by l^2"; 
	end if;
	*/
	//elements of E[l]
	Oinf:=E![0,1,0];
	 //"s1",Cputime();	
	ltorset:=DivisionPoints(Oinf,l);//time cuslting
	 //"s2",Cputime();	
	if 	#ltorset ne l^2 then error"#E[l] is not equal to l^2 !";end if;
		
	i:=1;
	while true do
	    pt0:=ltorset[i];
	    if pt0 ne Oinf then 
	    	break;
	    end if;
	    i:=i+1;		 
	end while;
	
	setpt0:=[i*pt0: i in [0..l-1]];
	
	i:=1;			
	while true do
	  pt1:=ltorset[i];
	  if (pt1 in setpt0) eq false then 
	    	break;
	  end if;
	  i:=i+1;	
	end while;
		
	 //"s3",Cputime();
	//end of finding a base
	
	//"------------- t3-----------------------------";
	//"pt0=",pt0;
	//"pt1",pt1;
	if IsOrder(pt0,l) eq false then error"pt0 is not of order l";end if;
	if IsOrder(pt1,l) eq false then error"pt1 is not of order l";end if;	
	 //Cputime();
	psi:=<x:i in [1..l+1]>;
        //enumerate all l+1 cyclic sbgps of order l
        
  if l eq 2 then
  	  psi[1]:=(x-pt0[1]);
  	  psi[2]:=(x-pt1[1]);
  	  tmp:=pt0+pt1;	
  	  psi[3]:=(x-tmp[1]);		
  else	      
	    for i in [1..l+1] do
	       //"i=",i;  		
	       psi[i]:=x-x+1;
	       if i eq 1 then 
	            for j:=1 to (l-1)div 2  do    
	    	  				tmp:=j*pt0;
          				psi[i]:=psi[i]*(x-tmp[1]);
	    				end for;
	       else
	            for j:=1 to (l-1)div 2  do    
	    	  					tmp:=j*(i*pt0+pt1);
                    psi[i]:=psi[i]*(x-tmp[1]);
	    				end for;		
	       end if;
	    end for;
	end if;
	//end of computing defining polynomials

// "s4",Cputime();
	return psi;

end intrinsic;

/*
  Given elliptic curve E/Fq: y^2+a1*xy+a3*y=x^3+a2*x^2+a4*x+a6 and a rational point pt of order l,
  computing the Tate normal form
  y^2+(1-c)xy-by=x^3-bx^2.

  returun the values b and c as elements in Fq

  (x0,y0) image point of (0,0,1)
  
  step1 change of vairiables x<---x+x0,y<---y+y0,obtains new equation E1

  step3 change of variables  x<- x,y<-y+a4/a3*x,obtains new equation E2
  
  step4 change of varaibles x<-(a2/a3)^(-2)*x,y<-(a2/a3)^(-3)*y, obtain resulting equation E3
  
*/

intrinsic TateNormalForm(E::CrvEll,usdpt::PtEll,l::RngIntElt) -> CrvEll
{ computing Tate normal form }
	
	K:=CoefficientRing(E);
  i:=0;

  if IsOrder(usdpt,l) eq false then error "error occur!";end if;

	x0:=usdpt[1];
	y0:=usdpt[2];

	a1,a2,a3,a4,a6:=Explode(aInvariants(E));	
	aa1:=a1;
	aa3:=2*y0+a3+a1*x0;
	aa2:=3*x0+a2;
	aa4:=3*x0^2+2*x0*a2+a4-a1*y0;
	aa6:=0;
	aaa1:=2*aa4/aa3+aa1;
	aaa3:=aa3;
	aaa2:=aa2-(aa4/aa3)^2-aa1*aa4/aa3;
	aaa4:=0;
	aaa6:=0;
	
	fff:=aaa2^3/aaa3^2;
	ggg:=(aaa1*aaa2-aaa3)/aaa3;
	
	Etate:=EllipticCurve([1+ggg,fff,fff,0,0]);

  return Etate;
end intrinsic;
intrinsic Tau_k_p(p::RngIntElt,k::RngIntElt,ell::RngIntElt)->RngIntElt
{compute tau_k(p) for k in [12,16,18,20,22] }
	if k eq 12 then
		return Delta12(p,ell);
	elif k eq 16 then
		return Delta16(p,ell);
	elif k eq 18 then
		return Delta18(p,ell);
	elif k eq 20 then
		return Delta20(p,ell);
	elif k eq 22 then
		return Delta22(p,ell);
	else
		error"k not in [12,16,18,20,22]";
	end if;		
end intrinsic;

intrinsic OrdPoly(f::RngUPolElt,g::RngUPolElt)->RngIntElt
{return ord_g(f)}
   n:=0;
   while true do
     if (f mod g^n) eq 0 and (f mod g^(n+1)) ne 0 then      	     	
     	 break;
     	end if;
      n:=n+1;
   end while;
  return n;
end intrinsic;

intrinsic CuspIndex(P::PlcFunElt,Cusps::SeqEnum)->RngIntElt
{give a cups P return the position of P in the set of cusps,
as the set is arragned as 1,1/2,.... the return number is the cusps 
represented as 1/? 	
	}
  n:=1;
  while true do
     if P eq Cusps[n] then      	
     	break;
     end if;
     
     n:=n+1;
     			 
  end while;

  if n gt # Cusps then error"input place is not cusp ";end if;
  	
  return n;
  	
end intrinsic;

intrinsic Tqn(q::RngIntElt,n::RngIntElt,l::RngIntElt)->RngIntElt
{ compute q*n=x or -x  mod l where x>0 }

  if (q*n mod l) gt ((l-1)div 2) then 
  	return (l- (q*n mod l));
  else
  	return (q*n mod l);
  end if;	

end intrinsic;

intrinsic SameData(data::SeqEnum)->BoolElt
{if there exists same number in data then return false else return true}
	
	
	for i:=1 to #data do
		 for j:=i+1 to #data do
		 	  if data[i] eq data[j] then
		 	  	 return false;
		 	  end if;	
		 	end for;
	end for;
	return true;	
end intrinsic;

intrinsic Polyofbc(bc::Tup,F::FldFin)->RngUPolElt
{compute the minimal poly. of (b,c)}
          //"Polyofbc MinimalPolynomial";
          charfb:=MinimalPolynomial(bc[1],F);
	      		
	      	charfc:=MinimalPolynomial(bc[2],F);
	      	
	      	db:=Degree(charfb);
	      	dc:=Degree(charfc);	
	      				
	      	if db ge 	dc then
	      		 if (db mod dc) ne 0 then error"dc should be adivisor of db";end if;
	      		 minpoly:=charfb;
	      	else
	      		 if (dc mod db) ne 0 then error"dc should be adivisor of db";end if;
	      		 minpoly:=charfc;	
	      	end if;
		return minpoly;
end intrinsic;

intrinsic Tupinornot(a::Tup,b::Tup)->BoolElt
{a=<*,*,*> in or not b=<<*,*,*>,<*,*,*>...> }

  flag:=1;
  for i:=1 to #b do 
  	
     if a eq b[i] then 
     	flag:=0;   		
     	break;
     end if;
     	 	
  end for;
  
  if flag eq 0 then return true;
  else 
  	//"a",a;
  	//"b",b;
  	return false;
  end if;				
end intrinsic;

intrinsic InTFPosition(a::FldFinElt,S::SeqEnum)->BoolElt,RngIntElt
{check if a is in the sequence S, if it is ture the return true and the position
	otherwise ruturn false and 0
	}	

  tf:=false;
  n:=0;	
	for i:=1 to #S do
    if a eq S[i] then
    	 tf:=true;
    	 	n:=i;
    	 	break;
    end if; 
  end for;
  
  if tf then return true,n;
  else return false,0;
  end if;	
end intrinsic;

intrinsic AbovePoint(XYroots::Tup)->Tup
{given a point P in XH31 return one of the 5 points in Xone31 above P, work with plane curves}
  
  U:=XYroots[1];
  V:=XYroots[2];
  
   if EvaluteXH(U,V) eq false then 
      error"XHl(U,V)!=0";
   end if;
  //check end
  
  
  
FFX:=Parent(U);
FFY:=Parent(V);
if #FFX gt #FFY then
  FF:=FFX;
else
   FF:=FFY;
end if;

  XxXyYxYy:=PolyXxXyYxYy();
  Xx:=PolynomialRing(FF,2)!XxXyYxYy[1];
  Xy:=PolynomialRing(FF,2)!XxXyYxYy[2];
  Yx:=PolynomialRing(FF,2)!XxXyYxYy[3];
  Yy:=PolynomialRing(FF,2)!XxXyYxYy[4];

//U=X V=Y x=a y=b 

POL<x>:=PolynomialRing(FF);
Ux:=POL!UnivariatePolynomial(Evaluate(Xx,Parent(Xx).1,U));
Vx:=POL!UnivariatePolynomial(Evaluate(Yx,Parent(Yx).1,V));

POL<y>:=PolynomialRing(FF);
Uy:=POL!UnivariatePolynomial(Evaluate(Xy,Parent(Xy).1,U));
Vy:=POL!UnivariatePolynomial(Evaluate(Yy,Parent(Yy).1,V));

gcdXH31fxXxY:=Gcd(Ux,Vx);
//gcdXH31fxXxY;

gcdXH31fyXyY:=Gcd(Uy,Vy);
//gcdXH31fyXyY;

rootsx,FFx:=RootsInSplittingField(gcdXH31fxXxY);
rootsy,FFy:=RootsInSplittingField(gcdXH31fyXyY);

/*
find the pair (x,y) in (rootsx,rootsy) which is a root of X31
*/

rootxy:=<>;

for i:=1 to #rootsx do
	flag:=false;
    for j:=1 to #rootsy do
    	 ta:=rootsx[i][1];
    	 	 tb:=rootsy[j][1];                    
        if EvaluteX1(ta,tb) then
          Append(~rootxy,<ta,tb>);                    
        end if;
        
    end for;
    
end for; 

if #rootxy eq 0 then "no solution!!? why",#rootxy;end if;

return  rootxy[1];

end intrinsic;

intrinsic UnderPoint(xyroots::Tup)->Tup
{(x,y)on Xone(l) use the map X(x,y) and Y(x,y) we have a point on XH(l)}

   //check X31(x,y)=0;
   x:=xyroots[1];
   y:=xyroots[2];
   
   if EvaluteX1(x,y) eq false then error"fl(x,y)!=0";end if;
   
   X:=XHldata()[1][2];
   Y:=XHldata()[1][3];
   fls:=EquationsForX1();
   U:=1;
   V:=1;
   
   for i:=1 to #X do   	
   	if X[i] ne 0 then U:=U*(Evaluate(fls[i],[x,y]))^X[i];end if;
   	
   	if Y[i] ne 0 then V:=V*(Evaluate(fls[i],[x,y]))^Y[i];end if;
   end for;		

   if EvaluteXH(U,V) eq false then error"FUV(U,V)!=0 229";end if;
      
   return <U,V>;
   
end intrinsic;

intrinsic EvaluteX1(x::FldFinElt,y::FldFinElt)->BoolElt
{check whether f(x,y)=0 plane equation for X_1(ell)}
   
   l:=XHldata()[2][2];
   
   f:=EquationsForX1()[l-1];
   
   if Evaluate(f,[x,y]) eq 0 then return true;
   else return false;
   end if; 
end intrinsic;

intrinsic EvaluteXH(X::FldFinElt,Y::FldFinElt)->BoolElt
{check whether F(X,Y)=0  plane equation for X_H(ell)}

   XHl:=XHldata()[1][1];
   
   if Evaluate(XHl,[X,Y]) eq 0 then return true;
   else return false;
   end if; 
end intrinsic;

intrinsic CoefAndMonsofRatMpol(f::FldFunRatMElt)->Tup,Tup
{f=f1/f2, f1 and f2 Multivariate Polynomials return CoefficientsAndMonomials(f1) and CoefficientsAndMonomials(f2)}

f1:=Numerator(f);
f2:=Denominator(f);

a,b:=CoefficientsAndMonomials(f1);
c,d:=CoefficientsAndMonomials(f2);

return <a,b>,<c,d>;
end intrinsic;

intrinsic SavePointSet(FxFxyF::Tup,Vl_base::SeqEnum,p_l_g::Tup,Qcusps::SeqEnum,computation_nr::SeqEnum)->BoolElt
{enumerate all the point corresponding to i*Vl1+j*Vl2}

		p:=p_l_g[1];
		l:=p_l_g[2];
		gns:=p_l_g[3];
		F_pe<w>:=FxFxyF[3];
		Nu:=#F_pe;
       		
       		if #Qcusps ge 3 then//use function from V_{k,l} -> F_q 
       			ptA:=Qcusps[2];
       			ptB:=Qcusps[3]; 
			
			POL<T> := PolynomialRing(F_pe);								            			                        
	            
	            	O:=Divisor(Qcusps[1]);
	            	            			 	  		 		             	 						
	           	E1:=Vl_base[1];
	           	E2:=Vl_base[2]; 		
	           
	           	"F_pe",F_pe;			                  	 		
	           	
	           	SE1:=[];// saving 1*E1, 2*E1,... (l-1)*E1
	           	SE2:=[];// saving 1*E2, 2*E2,... (l-1)*E2
	           	           	
	           	SEij:=<>;	//saving (i*Ei+j*E2) i=0,1,...,l-1;j=0,1,...,l-1;
	           	//i=1, <(i-1)*Ei+(j-1)*E2,...>
	           	//<0, E2,    2*E2,...,   (l-1)*E2>	
	           	//<E1,E1+E2,...,      E1+(l-1)*E2>
	           	//......	
	           	//value1:=<>;
	           	//value2:=<>;
	           	//value12:=<>;
	           	E1_line:=<>;						
	           	//compute E1,2*E1,...,(l-1)*E1;E2 2*E2,...,(l-1)*E2 save them to reduce the time
	           	Dvr:=O-O;
	           	
	           	New_Points:=[];
	           	
	           	pt_line:=[];
	           	for ii:=1 to l-1 do
	           		   "ii",ii;
	           		   Dtilde,rdg,Advr,aele:=Reduction(Dvr+E1, O);
	           		   if rdg ne -gns then
	           		   	"i E1=",ii;
	           		   	"Dtilde",Dtilde; 
	           		   	"rdg=",rdg;
	           		   	"gns=",gns;
	           		   	"bad prime! p=",p;
	           		   	return false; 
	           		   	//error"reduction divisor has degree less than genus,which is bad!";
	           		   end if;           		  	
	           		   Dvr:=Dtilde+rdg*O;
	           		   
	           		   //compute the Riemann-Roch space begin
	           		   B_Dvr:=Basis(2*gns*O-Dtilde);
	           		   //A= genx4:=x+1;geny4:=y;
	          
	          		   //B= genx5:=x+1; geny5:=y+1;
	          
	           		   f_A:=Evaluate(B_Dvr[1],ptA);//EvaluateFld(B_Dvr[1],ptA);
	           		   f_B:=Evaluate(B_Dvr[1],ptB);//EvaluateFld(B_Dvr[1],ptB);
	           		              		   
	           		   f_Adivf_B:=f_A/f_B;
	           		   //"f_Adivf_B=",f_Adivf_B;
	           		   Append(~pt_line,f_Adivf_B);
	           		   if #B_Dvr ne 1 then
	           		   	"dim L(DVR) >1 bad!";
	           		   	return false;
	           		   end if; 
	           		   //compute the Riemann-Roch space end           		              		   
	           		   //SE1; 		
	           		  Append(~SE1,Dtilde);
	           		  //SE1;
									//save the value and degree as well, save to file later
	           		  Append(~E1_line,<Degree(MinimalPolynomial(f_Adivf_B,F_pe)),f_Adivf_B>);
	          		                   		             		                  		               		                  		             		  
	           	end for;
	           	
	           	Append(~New_Points,pt_line);
	           	
	           	
	           	 E2_line:=<>;
	           	 pt_line:=[];        
	           	//value2:=<0>;           	           			
	           	Dvr:=O-O;
	           	for ii:=1 to l-1 do
	           		  "ii",ii;
	           		  //"--------2----------";
	           		   Dtilde,rdg,Advr,aele:=Reduction(Dvr+E2, O);
	           		  if rdg ne -gns then
	           		  	"i E1=",ii;
	           		  	"Dtilde",Dtilde; 
	           		  	"rdg=",rdg;
	           		  	"gns=",gns;
	           		  	"bad prime! p=",p;
	           		  	return false; 
	           		  	//error"reduction divisor has degree less than genus,which is bad!";
	           		  end if;           		  	
	           		  Dvr:=Dtilde+rdg*O;
	           		  
	           		   //compute the Riemann-Roch space begin
	           		   B_Dvr:=Basis(2*gns*O-Dtilde);
	           		   //A= genx4:=x+1;geny4:=y;
	          
	          		   //B= genx5:=x+1; geny5:=y+1;
	          
	           		   f_A:=Evaluate(B_Dvr[1],ptA);//EvaluateFld(B_Dvr[1],ptA);
	           		   f_B:=Evaluate(B_Dvr[1],ptB);//EvaluateFld(B_Dvr[1],ptB);
	            		              		   
	           		   f_Adivf_B:=f_A/f_B;
	           		   //"f_Adivf_B=",f_Adivf_B;
	           		    Append(~pt_line,f_Adivf_B);
	           		    if #B_Dvr ne 1 then
	           		   	"dim L(DVR) >1 bad!";
	           		   	return false;
	           		   end if; 
	           		   //compute the Riemann-Roch space end           		  
									
									//SE2; 		
	           		  Append(~SE2,Dtilde);
	           		  
	           		  
	           		  Append(~E2_line,<Degree(MinimalPolynomial(f_Adivf_B,F_pe)),f_Adivf_B>);
	
	           	end for;
	           	Append(~New_Points,pt_line);           	
	 		//Append(~value12,value2);// the first line of value12
	 		E1_jE2_lines:=<>;
	 		
	 						
			for jj:=1 to l-1 do	//00000
			//construct the line <ii*E1,ii*E1+E2,...,ii*E1+(l-1)*E2>
				tmplsit:=<>; 
				pt_line:=[];					             		  
	      		for ii:=1 to l-1 do	//00001
	        		"ii*(E1+jj*E2)=",ii,jj;                						
				Eij:=SE1[ii]-gns*O + SE2[jj*ii mod l]-gns*O;
	        		Dtilde,rdg,Advr,aele:=Reduction(Eij, O); 
	        		if rdg ne -gns then
	        			  "Eij=",Eij;
	     		      		  "Dtilde",Dtilde;
	        			  "rdg=",rdg;
	     		 		  "gns=",gns;
	     		 		  "bad prime! p=",p;
	     		 		  return false;                 		  
	        		end if;
	        		//compute the Riemann-Roch space begin
	        		
	        		B_Dvr:=Basis(2*gns*O-Dtilde);
	        		//B_Dvr[1];
	        		//A= genx4:=x+1;geny4:=y;
	        		
	        		//B= genx5:=x+1; geny5:=y+1;
	        		
	        		f_A:=Evaluate(B_Dvr[1],ptA);//EvaluateFld(B_Dvr[1],ptA);
	        		f_B:=Evaluate(B_Dvr[1],ptB);//EvaluateFld(B_Dvr[1],ptB);
	     			   
	        		f_Adivf_B:=f_A/f_B;
	        		//"f_Adivf_B=",f_Adivf_B;           		   
	        		Append(~pt_line,f_Adivf_B);
	        		if #B_Dvr ne 1 then
	        			"dim L(DVR) >1 bad!";
	        			return false;
	        		end if; 
	        		//compute the Riemann-Roch space end
	        		                		                		                	
	        		 Append(~tmplsit,<Degree(MinimalPolynomial(f_Adivf_B,F_pe)),f_Adivf_B>);           		                   		        
	                        		            		                   		                        		                	
	      		end for;//00001
	      		Append(~New_Points,pt_line);   
	          	Append(~E1_jE2_lines,tmplsit);
	      
	       		end for;//00000     							 
	 	        "computing the point sets finished";
       			
       		else//number of cusps less than three use function on X_H(l)
			POL<T> := PolynomialRing(F_pe);								            			                        
                	
            		O:=Divisor(Qcusps[1]);
            		            			 	  		 		             	 						
           		E1:=Vl_base[1];
           		E2:=Vl_base[2]; 		
                	
           		"F_pe",F_pe;			                  	 		
           		
           		SE1:=[];// saving 1*E1, 2*E1,... (l-1)*E1
           		SE2:=[];// saving 1*E2, 2*E2,... (l-1)*E2
           		           	
           		SEij:=<>;	//saving (i*Ei+j*E2) i=0,1,...,l-1;j=0,1,...,l-1;
           		//i=1, <(i-1)*Ei+(j-1)*E2,...>
           		//<0, E2,    2*E2,...,   (l-1)*E2>	
           		//<E1,E1+E2,...,      E1+(l-1)*E2>
           		//......	
           		//value1:=<>;
           		//value2:=<>;
           		//value12:=<>;
           		E1_line:=<>;						
           		//compute E1,2*E1,...,(l-1)*E1;E2 2*E2,...,(l-1)*E2 save them to reduce the time
           		Dvr:=O-O;
           		
           		New_Points:=[];
           		
           		pt_line:=[];
           		for ii:=1 to l-1 do
           			   "ii",ii;
           			   Dtilde,rdg,Advr,aele:=Reduction(Dvr+E1, O);
           			   if rdg ne -gns then
           			   	"i E1=",ii;
           			   	"Dtilde",Dtilde; 
           			   	"rdg=",rdg;
           			   	"gns=",gns;
           			   	"bad prime! p=",p;
           			   	return false; 
           			   	//error"reduction divisor has degree less than genus,which is bad!";
           			   end if;           		  	
           			   Dvr:=Dtilde+rdg*O;
           			   
           			   tf,xydvr:=DvrtoXYPoits(F_pe,Dtilde,Qcusps,p_l_g);
           			   if tf eq false then return false; end if;
           			   f_Adivf_B:=DvrPointstoQbar(F_pe,xydvr);
           			   Append(~pt_line,f_Adivf_B);
           			   //SE1; 		
           			  Append(~SE1,Dtilde);
           			  //SE1;
									//save the value and degree as well, save to file later
           			  Append(~E1_line,<Degree(MinimalPolynomial(f_Adivf_B,F_pe)),f_Adivf_B>);
          			                   		             		                  		               		                  		             		  
           		end for;
           		
           		Append(~New_Points,pt_line);
           		
           		
           		 E2_line:=<>;
           		 pt_line:=[];        
           		//value2:=<0>;           	           			
           		Dvr:=O-O;
           		for ii:=1 to l-1 do
           			  "ii",ii;
           			  //"--------2----------";
           			   Dtilde,rdg,Advr,aele:=Reduction(Dvr+E2, O);
           			  if rdg ne -gns then
           			  	"i E1=",ii;
           			  	"Dtilde",Dtilde; 
           			  	"rdg=",rdg;
           			  	"gns=",gns;
           			  	"bad prime! p=",p;
           			  	return false; 
           			  	//error"reduction divisor has degree less than genus,which is bad!";
           			  end if;           		  	
           			  Dvr:=Dtilde+rdg*O;
           			  
           			   tf,xydvr:=DvrtoXYPoits(F_pe,Dtilde,Qcusps,p_l_g);
           			   if tf eq false then return false; end if;
           			   f_Adivf_B:=DvrPointstoQbar(F_pe,xydvr);           		  
				   Append(~pt_line,f_Adivf_B);					
									//SE2; 		
           			  Append(~SE2,Dtilde);
           			  
           			  
           			  Append(~E2_line,<Degree(MinimalPolynomial(f_Adivf_B,F_pe)),f_Adivf_B>);
                	
           		end for;
           		Append(~New_Points,pt_line);           	
 			//Append(~value12,value2);// the first line of value12
 			E1_jE2_lines:=<>;
 			
 							
			for jj:=1 to l-1 do	//00000
			//construct the line <ii*E1,ii*E1+E2,...,ii*E1+(l-1)*E2>
				tmplsit:=<>; 
				pt_line:=[];					             		  
      			for ii:=1 to l-1 do	//00001
        			"ii*(E1+jj*E2)=",ii,jj;                						
				Eij:=SE1[ii]-gns*O + SE2[jj*ii mod l]-gns*O;
        			Dtilde,rdg,Advr,aele:=Reduction(Eij, O); 
        			if rdg ne -gns then
        				  "Eij=",Eij;
     			       		   "Dtilde",Dtilde;
        				  "rdg=",rdg;
     			 		  "gns=",gns;
     			 		  "bad prime! p=",p;
     			 		  return false;                 		  
        			end if;
        			        		
        			tf,xydvr:=DvrtoXYPoits(F_pe,Dtilde,Qcusps,p_l_g);
        			if tf eq false then return false; end if;
        			f_Adivf_B:=DvrPointstoQbar(F_pe,xydvr);
        			Append(~pt_line,f_Adivf_B);                		                		                	
        			Append(~tmplsit,<Degree(MinimalPolynomial(f_Adivf_B,F_pe)),f_Adivf_B>);           		                   		        
                	        		            		                   		                        		                	
      			end for;//00001
      			Append(~New_Points,pt_line);   
          		Append(~E1_jE2_lines,tmplsit);
                	
       			end for;//00000     							 
 	        	"computing the point sets finished";       		
       		end if;
       		       			

				
		//projective polynomial
    		projname:="proj_poly" cat IntegerToString(l) cat "_cpu" cat IntegerToString(computation_nr[1]) cat".dat";
    		projnamefilept1:=Open(projname,"a+");
		
		RR<x>:=PolynomialRing(F_pe);
		ZZ<t>:=PolynomialRing(Integers());
		Proj_f:=RR!1;
		for i:=1 to l+1 do
			tmp:=0;
			for j:=1 to l-1 do
				tmp:=tmp+New_Points[i][j];
			end for;
			Proj_f:=Proj_f*(x-tmp);
		end for;
		Proj_f:=ZZ!Proj_f;
           	fprintf projnamefilept1,"%o\n",p;
      		for i:=0 to Degree(Proj_f) do
      		         ai:=IntegerRing()!Coefficient(Proj_f,i);
      		         fprintf projnamefilept1,"%o\n",ai;	
      		end for;
      		delete projnamefilept1;
      		
      				
		//entire polynomial
		faitfulname:="fait_poly" cat IntegerToString(l) cat "_cpu" cat IntegerToString(computation_nr[1]) cat".dat";
		faitfulnamefilept2:=Open(faitfulname,"a+");
		Entire_f:=RR!1;
		for i:=1 to l+1 do
			for j:=1 to l-1 do				
				Entire_f:=Entire_f*(x-New_Points[i][j]);
			end for;
			
		end for;
		Entire_f:=ZZ!Entire_f;
           	fprintf faitfulnamefilept2,"%o\n",p;
      		for i:=0 to Degree(Entire_f) do
      		         ai:=IntegerRing()!Coefficient(Entire_f,i);
      		         fprintf faitfulnamefilept2,"%o\n",ai;	
      		end for;    
    		delete faitfulnamefilept2;
    		
		
		// print to file
		Nameoffile:="Vlmodps_cpu_"cat IntegerToString(computation_nr[1]) cat".dat";
    		filewrite:=Open(Nameoffile,"a+");
		//print Fp-->F_pe
		
		F_p:=GF(p);
		g_tor:=Generator(F_pe,F_p);
		poly_g_tor:=MinimalPolynomial(g_tor,F_p);
		se_qpoly_g_tor:=ElementToSequence(poly_g_tor);
		if #se_qpoly_g_tor ne Degree(F_pe)+1 then
			error"extension degree unexpected! ",#se_qpoly_g_tor,Degree(F_pe)+1;
		end if;
						
		fprintf filewrite, "%o %o ", p, Degree(F_pe);
		
		for k:=1 to #se_qpoly_g_tor do
			fprintf filewrite,"%o ",se_qpoly_g_tor[k];
		end for;
    		fprintf filewrite,"\n";
    		//		
		
		projlines:=<E1_line,E2_line>;
		for i:=1 to l-1 do 
			Append(~projlines,E1_jE2_lines[i]);
		end for;
		//alllines
		for i:=1 to l+1 do//001
		    E1_jE2_oneline:=projlines[i];
		    	
		    for ii:=1 to #E1_jE2_oneline do//002
		    	  dvr_ii:=E1_jE2_oneline[ii];
		    	  text_n:=0;
		    
				    dj:=dvr_ii[1];//degree of the value
				    vj:=dvr_ii[2];//value
				    
				    text_n:=text_n+dj;
				    FFF:=ext<F_pe|dj>;
				    vj:=FFF!vj;
				    				
				    fprintf filewrite,"%o ",dj;
				    
				    //-----v-----//
				    g_tor:=Generator(FFF,F_pe);
				    poly_g_tor:=MinimalPolynomial(g_tor,F_pe);				
				    
				    //recording the polynomial
				    se_qpoly_g_tor:=ElementToSequence(poly_g_tor);
				    
				    if #se_qpoly_g_tor ne dj+1 then
				        error"extension degree unexpected! ",#se_qpoly_g_tor,dj+1;
				    end if;
				    for k:=1 to #se_qpoly_g_tor do
				      tmp:=se_qpoly_g_tor[k];//in F_pe
				    	seqtmp:=ElementToSequence(tmp,F_p);
				    	if #seqtmp ne Degree(F_pe) then 
				    		error"unexpected degree seqtmp,Degree(F_pe)",seqtmp,Degree(F_pe);
				    	end if;
				    	
				    	for kk:=1 to #seqtmp do
				    		fprintf filewrite,"%o ",seqtmp[kk];
				    	end for;
				    	
				    end for;
				
				    //recoring the element seq				
				    seqvj:=ElementToSequence(vj,F_pe);
				    for k:=1 to #seqvj do
				    	tmp:=seqvj[k];//in F_pe
				    	seqtmp:=ElementToSequence(tmp,F_p);
				    	if #seqtmp ne Degree(F_pe) then 
				    		error"unexpected degree seqtmp,Degree(F_pe)",seqtmp,Degree(F_pe);
				    	end if;
				    	
				    	for kk:=1 to #seqtmp do
				    		fprintf filewrite,"%o ",seqtmp[kk];
				    	end for;
				    end for;
				     													         	
		    end for;//002
		    fprintf filewrite,"\n";
		end for;//001				
		delete filewrite;
		
		 		
		return true;		
end intrinsic;

intrinsic DvrtoXYPoits(F_pe::FldFin,dvr::DivFunElt,Qcusps::SeqEnum,p_l_g::Tup)->BoolElt,Tup
{Given a divisor dvr, compute the points (x,y)}
  p:=p_l_g[1];
  l:=p_l_g[2];
  Nu:=#F_pe;		
  Ps,Es:=Support(dvr);
  
  
  XYPoints:=<>;
             							
  for kk:=1 to #Ps do
     if Ps[kk] in Qcusps then//010
  	  	      	"becareful! cusps in reduciotn divisor!,bad prime! p",p;
  	  	      	return false,0; 		
  	  	      	break;	
      end if;                                       	                                       	            										
  end for;		
  
  //compute the points of the corresponding places	
  a_p:=F_pe!0;
  
  for kk:=1 to #Ps do//09
	dofplc:=Degree(Ps[kk]);
	    	
	tf,u,v:=PlaceToPoint(F_pe,Ps[kk]);
	if tf eq false then return false,0;end if;
	//"xy_d",dofplc;
	//"xy_u",ElementToSequence(u);
	//"xy_v",ElementToSequence(v);
        //if tf eq false then return false ,0;end if;
        
        for ll:=1 to Es[kk] do          
            	Append(~XYPoints,<dofplc,u,v>);//save one representative  <degree,x,y>          
        end for;
        
   end for;//09
      
       return true,XYPoints;                
end intrinsic;


intrinsic DvrPointstoQbar(F_pe::FldFin,Dvr::Tup)->FldFinElt
{Given a divisor dvr=<<d_1,x_1,y_1>,...,<d_k,x_k,y_k>>, sum d_i =g compute the map f(dvr)}
  
  a_p:=0;
  Nu:=#F_pe;
  
  for i:=1 to #Dvr do
        d_i:=Dvr[i][1];
    	u:=Dvr[i][2];
    	v:=Dvr[i][3];
				
       	minf:=u; 
       	
       	
       	tmp:=minf-minf;                            
        tmp2:=minf;		
        for nn:=1 to d_i  do
         	tmp2:=tmp2^Nu;
         		
         	tmp:=tmp+tmp2;	
        end for;
        tmp:=F_pe ! tmp;
        
        a_p:=a_p+tmp; 
  end for;
  		
      
  return a_p;                
end intrinsic;

intrinsic qEisensteinSeries(k::RngIntElt,nth::RngIntElt,M::RngIntElt)->SeqEnum
{

E_k(z)=1-(2*k/B_k)*(sum_(n=1)^\infty sigma_(k-1)(n)*q^n  )

return the first nth coefficients of E_k(z) mod M.

if M 0 then return the first nth coefficients of E_k(z).

}

check:=false;

Bk:=BernoulliNumber(k);
ldc:=-2*k/Bk;

qexp:=[];
a0:=1/1;//coefficients may lie in rational field
RM:=Integers(M);

if M eq 0 then
	qexp:=[a0];
	for i:=1 to nth do
		ai:=ldc*DivisorSigma(k-1,i);
		Append(~qexp,ai);
	end for;
	
	//"qexp",qexp;
	//check begin
	if check then
	Ek:=EisensteinSeries(ModularForms(1, k));
	//"Ek",Ek[1];
	for i:=0 to nth do
		if Coefficient(Ek[1],i)/Coefficient(Ek[1],0) ne qexp[i+1] then
			Coefficient(Ek[1],i)/Coefficient(Ek[1],0);
			qexp[i+1];
			error"no!!";
		end if;
		
	end for;
	"function checked! good!";
	//check end
	end if;	
else
	qexp:=[RM!a0];
	for i:=1 to nth do
		ai:=RM!ldc*DivisorSigma(k-1,i);
		Append(~qexp,ai);
	end for;
	//check begin
	if check then
	Ek:=EisensteinSeries(ModularForms(1, k));
	for i:=0 to nth do
		if RM!(Coefficient(Ek[1],i)/Coefficient(Ek[1],0)) ne qexp[i+1] then
			error"no!!";
		end if;
		
	end for;
	"function checked! good!";
	//check end
	end if;	
end if;

return qexp;



end intrinsic;

intrinsic Eis_k(k::RngIntElt,nth::RngIntElt,M::RngIntElt)->RngIntElt
{the nth coefficient of E_k mod M}
	RM:=Integers(M);
	
	Bk:=BernoulliNumber(k);
	ldc:=-2*k/Bk;
	if nth eq 0 then
		ai:=RM!(1);
	else
		ai:=RM!(ldc*DivisorSigma(k-1,nth));
	end if;
	return Integers()!ai;
end intrinsic;

intrinsic Delta12(nth::RngIntElt,M::RngIntElt)->RngIntElt
{nth coefficient of Delta12 Delta12:=(e4*e8-e6^2);}
	RM:=Integers(M);
	
	ldc:=Eis_k(4,0,M)*Eis_k(8,1,M)-Eis_k(6,0,M)*Eis_k(6,1,M)+Eis_k(4,1,M)*Eis_k(8,0,M)-Eis_k(6,1,M)*Eis_k(6,0,M);
	
	ai:=RM!0;
	for i:=0 to nth do
		j:=nth-i;
		ai:=ai+Eis_k(4,i,M)*Eis_k(8,j,M)-Eis_k(6,i,M)*Eis_k(6,j,M);
	end for;
	
	ai:=ai/ldc;
	
	return Integers()!ai;
end intrinsic;
intrinsic Delta16(nth::RngIntElt,M::RngIntElt)->RngIntElt
{nth coefficient of Delta16:=Delta12*e4;}
	RM:=Integers(M);
	
	ldc:=Delta12(0,M)*Eis_k(4,1,M)+Delta12(1,M)*Eis_k(4,0,M);
	
	ai:=RM!0;
	for i:=0 to nth do
		j:=nth-i;
		ai:=ai+Delta12(i,M)*Eis_k(4,j,M);
	end for;
	
	ai:=ai/ldc;
	
	return Integers()!ai;
end intrinsic;
intrinsic Delta18(nth::RngIntElt,M::RngIntElt)->RngIntElt
{nth coefficient of Delta18:=Delta12*e6;}
	RM:=Integers(M);
	
	ldc:=Delta12(0,M)*Eis_k(6,1,M)+Delta12(1,M)*Eis_k(6,0,M);
	
	ai:=RM!0;
	for i:=0 to nth do
		j:=nth-i;
		ai:=ai+Delta12(i,M)*Eis_k(6,j,M);
	end for;
	
	ai:=ai/ldc;
	
	return Integers()!ai;
end intrinsic;
intrinsic Delta20(nth::RngIntElt,M::RngIntElt)->RngIntElt
{nth coefficient of Delta20:=Delta12*e8;}
	RM:=Integers(M);
	
	ldc:=Delta12(0,M)*Eis_k(8,1,M)+Delta12(1,M)*Eis_k(8,0,M);
	
	ai:=RM!0;
	for i:=0 to nth do
		j:=nth-i;
		ai:=ai+Delta12(i,M)*Eis_k(8,j,M);
	end for;
	
	ai:=ai/ldc;
	
	return Integers()!ai;
end intrinsic;
intrinsic Delta22(nth::RngIntElt,M::RngIntElt)->RngIntElt
{nth coefficient of Delta20:=Delta12*e10;}
	RM:=Integers(M);
	
	ldc:=Delta12(0,M)*Eis_k(10,1,M)+Delta12(1,M)*Eis_k(10,0,M);
	
	ai:=RM!0;
	for i:=0 to nth do
		j:=nth-i;
		ai:=ai+Delta12(i,M)*Eis_k(10,j,M);
	end for;
	
	ai:=ai/ldc;
	
	return Integers()!ai;
end intrinsic;

intrinsic RecoverPolys(file_nu::SeqEnum)->BoolElt
{try to recover the polynomial Q_x_weight(k)_level(l) from V_l mod p conputed,
file_nu is the numbers of k of proj_poly_cpu_(k).dat computed}
    
    l:=XHldata()[2][2];

    //file_nu:=[1,2,3,4,5,6,7,8,9,10,11,12];
    		
    //======================== recovering the polynomial corresponding to the projective  rep.
    Primes:=[];
    Cis:=[];
    	
    DegreeofFX:=l+1;
    //read polynomials (projective)
    	
   for k in  file_nu do
    fname1:="proj_poly"cat IntegerToString(l) cat"_cpu" cat IntegerToString(k)cat ".dat";
				    		
    filept1:=Open(fname1,"r");					
			    	
    while true do
            prm := Gets(filept1);
              
    	      if IsEof(prm) then break;end if;
             
            	Append(~Primes,StringToInteger(prm) );
            	
            	ds:=[];	
            	for i:=0 to DegreeofFX do 
            		tmp:=Gets(filept1);
            		
            		Append(~ds,StringToInteger(tmp));	
            		delete tmp;	
            	end for;        	
            	Append(~Cis,ds);
            	delete ds;  		  		  		        
    end while;
		
    delete filept1;
   end for;
    
    //=============================================//
    
    pol<u>:=PolynomialRing(IntegerRing());
    
    //"good Primes in file",Primes;
    //"total number of primes",#Primes;
    
    for i:=1 to #Primes do
    	for j:=i+1 to #Primes do
    		 if Primes[i] eq Primes[j] then
    		 	"i",i,"j",j,"p",Primes[i];
    		 	error"same prime in file!!!";
    		 end if;	 
    	end for;
    end for;
        			           
    crtcs:=[];
    
    for j:=1 to DegreeofFX+1 do//00
    	
    	tmp:=[];
    		
    	for i:=1 to #Cis do
    		Append(~tmp,Cis[i][j]);	
    	end for;
    	
    	Append(~crtcs,tmp);
    	delete tmp;
    	
    end for;//00

    outfname1:="proj_poly"cat IntegerToString(l) cat".txt";
    outfilept1:=Open(outfname1,"w");	
    	    
    //find the shortest vector a_i/b_i = x_i mod p_i
    M:=1;
    for i:=1 to #Primes do
    		M:=M*Primes[i];
    end for;	 
    //"M=",M;
    "Log10(M)=",Log(M)/Log(10);
    "number of primes ",#Primes;
    FFLG:=0;
    
    Mring:=Integers(M);
    Deo:=[];
    Num:=[];
    tfall:=true;			
    for i:=1 to DegreeofFX+1 do
    	 j:=DegreeofFX+1+1-i;
    	 //"crtcs[j]=",crtcs[j];
    	 //"CRT(crtcs[j],Primes)=",CRT(crtcs[j],Primes);	
    	 tf,adivb:=RationalReconstruction(Mring!(CRT(crtcs[j],Primes)));
    	 	
    	 if tf eq false then 
    	 	"j=",j,"need double the precision while recovering the proj poly";
    	 	FFLG:=1;
    	 	tfall:=false;
    	 	break;	
    	 end if;
    	 	Append(~Deo,Denominator(adivb));
    	 	Append(~Num,Numerator(adivb));	
    	 "j",j;
    	 //"a/b",adivb;
    end for;
    
    if tfall then
       totaldeo:=LCM(Deo);
              	       
       Fu:=pol!0;
       for i:=1 to DegreeofFX+1 do
       	tf,adivb:=RationalReconstruction(Mring!(CRT(crtcs[i],Primes)));
       	Fu:=Fu+u^(i-1)*	Numerator(adivb)*(totaldeo div Denominator(adivb) );
       	if i ne DegreeofFX+1 then
       			
       		fprintf outfilept1,"%o\n",Numerator(adivb)*(totaldeo div Denominator(adivb) ),i-1;	       	
       	else
       		fprintf outfilept1,"%o\n",Numerator(adivb)*(totaldeo div Denominator(adivb) ),i-1;	       		
       	end if;	
       	
       end for;
       delete outfilept1;
    end if; 
    if FFLG eq 0 then "projective polynomial recovered!!";end if;
    	
end 	intrinsic; 


intrinsic FindCuspsCorr(Mod_As::SeqEnum,k::RngIntElt,l::RngIntElt)->SeqEnum
{
given Q-rational cusps of X_H(l) represented by prime ideals of function field Q(X_H(l))
Q-rational cusps of X_H(l) can also represented by 1/1,...,1/((l-1) /2)
this function compute the correspondences between these two  representations
}
h_index:=((l-1)) div GCD(l-1,k-2);

dmop:=Integers()!PrimitiveElement(GF(l));//diamond operators

H:=[];

d:=PrimitiveElement(GF(l))^h_index;

for i:=1 to l do
	di:=(Integers()!(GF(l)!d^i)) mod l;
	
	if di gt (l div 2) then di:=l-(di);end if;
	
	if di in H eq false then Append(~H,di);end if;
end for;

"H",H;

Horibts:=[];//ordered as [dmop^0*H,dmop^1*H,...,dmop^(h_index-1)*H]

for i:=0 to h_index-1 do
	Hi:=[];
	for j:=1 to #H do
		tmp:=dmop^i*H[j] mod l;
		if tmp gt (l div 2) then tmp:=l-(tmp);end if;
		Append(~Hi,tmp);
	end for;
	Append(~Horibts,Hi);
end for;

		
//=== begin finding a prime p such that l divides #JH(l)(F_q) ====

 p:=NextPrime(l+133);
 extdg:=2;

 while true do
    "p=",p;
     NuofJac,gns:=NumOfJHl(Mod_As,p,l,extdg,h_index);
     ord_l:=Valuation(NuofJac,l);	
     if ord_l ge 1 then break;end if;
     p:=NextPrime(p);		
 end while;	

"p",p;
//==== finished========================================//

// data of plane model of X1(19)
F_pe<w>:=GF(p,extdg);
FunFldx<x>:=FunctionField(F_pe);
Ringy<y>:=PolynomialRing(FunFldx);
tmp1,tmp2:=CoefficientsAndMonomials(XHldata()[1][1]);

nx:=0;

for i:=1 to #tmp1 do
	nx:=nx+tmp1[i]*x^(Degree(tmp2[i],Parent(tmp2[i]).1))*y^(Degree(tmp2[i],Parent(tmp2[i]).2));
end for;

XHl:=nx;
//XHl;
        
FunFldxy<y>:=FunctionField(XHl);

Css:=XHldata()[1][4];

Qcusps:=[];


for i:=1 to #Css do


	tmp1,tmp2:=CoefAndMonsofRatMpol(Css[i][1]);
	        			
	nx:=0;
	
	for i:=1 to #tmp1[1] do
		nx:=nx+tmp1[1][i]*x^(Degree(tmp1[2][i],Parent(tmp1[2][i]).1))*y^(Degree(tmp1[2][i],Parent(tmp1[2][i]).2));
	end for;
	
	dx:=0;
	
	for i:=1 to #tmp2[1] do
		dx:=dx+tmp2[1][i]*x^(Degree(tmp2[2][i],Parent(tmp2[2][i]).1))*y^(Degree(tmp2[2][i],Parent(tmp2[2][i]).2));
	end for;
	gx:=nx/dx;
	//gx;
	
	tmp1,tmp2:=CoefAndMonsofRatMpol(Css[i][2]);
	       			
	nx:=0;
	
	for i:=1 to #tmp1[1] do
		nx:=nx+tmp1[1][i]*x^(Degree(tmp1[2][i],Parent(tmp1[2][i]).1))*y^(Degree(tmp1[2][i],Parent(tmp1[2][i]).2));
	end for;
	
	dx:=0;
	
	for i:=1 to #tmp2[1] do
		dx:=dx+tmp2[1][i]*x^(Degree(tmp2[2][i],Parent(tmp2[2][i]).1))*y^(Degree(tmp2[2][i],Parent(tmp2[2][i]).2));
	end for;
	gy:=nx/dx;
	//gy;		
        	        	
	P:=CommonZeros(FunFldxy,[gx,gy])[1];
	
	Append(~Qcusps,P);
end for;
             									        
for i:=1 to #Qcusps do
	 for j:=i+1 to #Qcusps do
	 	if Degree(Qcusps[i]) ne 1 then 
	 		
	 		Qcusps[i];
	 		error"problem with cusps";
	 	end if;
	 	if Qcusps[i] eq Qcusps[j] then 
	 		
	 		Qcusps[i];
	 		Qcusps[j];
	 		error"problem with cusps";
	 	end if;
	 end for;	
end for; 
   		   	       	

"the action on cusps ";

" begin finding corresponding of the cusps";

//diamond operator <dmop> acting on  places

Order_num_cusp:=[1];
				
while true do//01
	j:=Order_num_cusp[#Order_num_cusp];
	"j=",j;
      	
	O:=Divisor(Qcusps[j]);      
                        
        for i:=1 to #Qcusps do //02
         	  "i=",i;
        	            	
                  dmopO:=Qcusps[i];//assume <d>O	      
                  
                  nuoftest:=0;//if the assumption pass m tests we claim we have the right answer
                  
                  flagofwhile:=0;
                 
                  m:=1;//number of tested		
                  
                  while nuoftest lt m do//00
                        //check the assumption
                        tf,P1:=HasRandomPlace(FunFldxy, gns);
                        	
                        if tf eq true then//1
                                //generates a torsion divisor
          	            	Dvr:=(NuofJac div l^ord_l)*P1-gns*(NuofJac div l^ord_l)*O;
          	            	tilde,rdg,Advr,aele:=Reduction(Dvr, O);
          	            	Dvr:=tilde+rdg*O;
          	            			
          	            	if IsPrincipal(Dvr)  then//0001    
                         		   //"it's a principal divisor useless";
           	            	else //0001
           	            		 
           	            	      for i:=1 to ord_l do//00
                                      
                                          if IsPrincipal((l^i)*Dvr)  then//01
                                             //"Dvr is of order ",l^i;
                                             Dtilde,rdg,Advr,aele:=Reduction((l^(i-1))*Dvr, O);
                                             //"reduction diviosr Dvr",Dtilde;
                                             //"degree of reduciotn divisor",rdg;                                         
                                             break;
                                          end if;//01
                                          
                                          if i eq ord_l then error " i eq ord_l error occur please check";end if;
                                                  
                                      end for;//00 compute the exact order of Dvr make it be a divisor of order l
                              
                                      Dvr:=Dtilde+rdg*O;
           	            		  
           	            	    if IsPrincipal(l*Dvr)  eq false then error"no!";end if;
           	            		  
           	            			supp, exps := Support(Dtilde);
           	            				
           	            			//"------- diamond operator acting on noncusp part --------------";
           	            			
           	            			Tqsupp:=O-O;
           	            			flagcusp:=0;		
           	            			for k:=1 to #supp do//02
           	            			      if (supp[k] in Qcusps) eq true then//03
          	      					   //"cusps in rdeuction divisor drop it";
                                                           flagcusp:=1;
                                                           break;				 
           	            			      else
           	            			      	   tf,dvr:=dPlace(<FunFldx,FunFldxy,F_pe>,<p,0,l>,supp[k],dmop);
           	            			      	   if tf eq false then 
           	            			      	   	flagcusp:=1;break;
           	            			      	   end if;
           	            			      	   //"---dajdoajdkajdo";		
           	            			      	   Tqsupp:=Tqsupp+exps[k]*(dvr);
           	            			      end if;//03
           	            			end for;//02
           	            			//"-------- 3 -------------";
           	            			
           	            			//compute the divisor using assumption
           	            			if flagcusp eq 0 then
           	            			     TqDvr:=Tqsupp+rdg*dmopO;
           	            			           
           	            		              if Degree(TqDvr) ne 0 then error"no!check the program";end if;
           	            		       	
           	            			      if IsPrincipal(l*TqDvr) then 
           	            			     	//"yes";
           	            			     	nuoftest:=nuoftest+1;
           	            			      else 
           	            			     	//"try another correspondence";
           	            			     	flagofwhile:=1;	
           	            			       end if;
           	            			 end if;  	
                       	            								
           	            	end if;//0001		
                        		
                        end if;//1
                        	
                        if flagofwhile eq 1 then 	
                        	break;
                        end if;
                        		
                  end while;//00
                  
                  if nuoftest gt m-1 then 
                  	//"you find a right correspondence!";
                  	"<",dmop,">:O",j,"->","O",i;                  	

                  	if (#Order_num_cusp lt h_index) and (i in Order_num_cusp) then
                  		error"i should not in Order_num_cusp in this loop";
                  	end if; 
                  	
                  	Append(~Order_num_cusp,i); 
                  	                 	            	            		                  	
                  	break;   
                  end if ;	
                  //end of check the assumption
            
          end for;//02
          
          if nuoftest eq 0 then error"no O_i such that <d>O_j->O_i why!!";end if;

	  if #Order_num_cusp gt h_index then
	  	if Order_num_cusp[1] ne Order_num_cusp[h_index+1] then
	  		error"Order_num_cusp";
	  	else
	  		break;	
	  	end if;
	  end if;
end while;//01

" end of finding correspondences";

ReOrderHorbits:=[];

for i:=1 to h_index do
	for j:=1 to h_index do
		if Order_num_cusp[j] eq i then
			ReOrderHorbits[i]:=Horibts[j];
			break;
		end if;
	end for;
	
end for;


"ReOrderHorbits",ReOrderHorbits;

"check the output using diamnond operators";

  m:=0;//number of tested		
  nu:=#Qcusps;
  while m lt 10 do//00
       m:=m+1;
       
       O:=Divisor(Qcusps[(m mod nu)+1]);
       
       "O",(m mod nu)+1;
       
        //check the assumption
        tf,P1:=HasRandomPlace(FunFldxy, gns);
        flagofwhile:=0;
        	
        if tf eq true then//1
                //generates a torsion divisor
        	//"begin";
            	Dvr:=(NuofJac div l^ord_l)*P1-gns*(NuofJac div l^ord_l)*O;
            	//Dvr:=(NuofJac div tor)*P1-5*(NuofJac div tor)*O;
            	//"time in big reduction ";
            	tilde,rdg,Advr,aele:=Reduction(Dvr, O);
            	Dvr:=tilde+rdg*O;
            			
            	if IsPrincipal(Dvr)  then//0001    
         		   //"it's a principal divisor useless";
            	else //0001
            		 
            	      for i:=1 to ord_l do//00
                      
                          if IsPrincipal((l^i)*Dvr)  then//01
                             //"Dvr is of order ",l^i;
                             Dtilde,rdg,Advr,aele:=Reduction((l^(i-1))*Dvr, O);
                          
                             //"reduction diviosr Dvr",Dtilde;
                             //"degree of reduciotn divisor",rdg;
                          
                             break;
                          end if;//01
                          
                          if i eq ord_l then error " i eq ord_l error occur please check";end if;
                                  
                      end for;//00 compute the exact order of Dvr make it be a divisor of order l
              
                      Dvr:=Dtilde+rdg*O;
            		  
            	    if IsPrincipal(l*Dvr)  eq false then error"no!";end if;
            		  
            			supp, exps := Support(Dtilde);
            				
            			//"------- diamond operator acting on noncusp part --------------";
            			
            			Tqsupp:=O-O;
            			flagcusp:=0;		
            			for k:=1 to #supp do//02
            			      if (supp[k] in Qcusps) eq true then//03
      					   //"cusps in rdeuction divisor drop it";
                                           flagcusp:=1;
                                           break;				 
            			      else

            			      	   tf,dvr:=dPlace(<FunFldx,FunFldxy,F_pe>,<p,0,l>,supp[k],dmop);
            			      	   if tf eq false then 
            			      	   	flagcusp:=1;break;
            			      	   end if;
            			      	   //"---dajdoajdkajdo";		
            			      	   Tqsupp:=Tqsupp+exps[k]*(dvr);
            			      end if;//03
            			end for;//02
            			//"-------- 3 -------------";
            			            			
            			if flagcusp eq 0 then
            			     TqDvr:=Tqsupp+rdg*diamondcusp(Qcusps,O,l,dmop,ReOrderHorbits);
            			           
            		              if Degree(TqDvr) ne 0 then 
            		              	
            		              	error"no!check the program";
            		              
            		              end if;
            		       	
            			      if IsPrincipal(l*TqDvr) then 
            			     	//"yes";
            			     	
            			      else 
            			     	error"no not l-torsion!!! why!!";
            			     	flagofwhile:=1;	
            			       end if;
            			 end if;  	
       	            								
            	end if;//0001		
        		
        end if;//1
        	
        if flagofwhile eq 1 then 	
        	break;
        end if;
        		
  end while;//00

"end of check the output using diamnond operators";


"check the output using Hecke  operator T2";

//check T_q 
  q:=2;
  m:=0;//number of tested		
  nu:=#Qcusps;
  while m lt 110 do//00
       m:=m+1;
       
       O:=Divisor(Qcusps[(m mod nu)+1]);
       
       "----------------O",(m mod nu)+1;
       
        //check the assumption
        tf,P1:=HasRandomPlace(FunFldxy, gns);
        flagofwhile:=0;
        	
        if tf eq true then//1
                //generates a torsion divisor
        	//"begin";
            	Dvr:=(NuofJac div l^ord_l)*P1-gns*(NuofJac div l^ord_l)*O;
            	//Dvr:=(NuofJac div tor)*P1-5*(NuofJac div tor)*O;
            	//"time in big reduction ";
            	tilde,rdg,Advr,aele:=Reduction(Dvr, O);
            	Dvr:=tilde+rdg*O;
            			
            	if IsPrincipal(Dvr)  then//0001    
         		   //"it's a principal divisor useless";
            	else //0001
            		 
            	      for i:=1 to ord_l do//00
                      
                          if IsPrincipal((l^i)*Dvr)  then//01
                             //"Dvr is of order ",l^i;
                             Dtilde,rdg,Advr,aele:=Reduction((l^(i-1))*Dvr, O);
                          
                             //"reduction diviosr Dvr",Dtilde;
                             //"degree of reduciotn divisor",rdg;
                          
                             break;
                          end if;//01
                          
                          if i eq ord_l then error " i eq ord_l error occur please check";end if;
                                  
                      end for;//00 compute the exact order of Dvr make it be a divisor of order l
              
                      Dvr:=Dtilde+rdg*O;
            		  
            	    if IsPrincipal(l*Dvr)  eq false then error"no!";end if;
            		  
            			supp, exps := Support(Dtilde);
            				
            			//"------- diamond operator acting on noncusp part --------------";
            			
            			Tqsupp:=O-O;
            			flagcusp:=0;		
            			for k:=1 to #supp do//02
            			      if (supp[k] in Qcusps) eq true then//03
      					   //"cusps in rdeuction divisor drop it";
                                           flagcusp:=1;
                                           break;				 
            			      else    
            			      	   tf,dvr:=T2Place(<FunFldx,FunFldxy,F_pe>,<p,q,l>,supp[k]);
            			      	   if tf eq false then 
            			      	   	flagcusp:=1;break;
            			      	   end if;
            			      	   //"---dajdoajdkajdo";		
            			      	   Tqsupp:=Tqsupp+exps[k]*(dvr);
            			      end if;//03
            			end for;//02
            			//"-------- 3 -------------";
            			
            			//compute the divisor using assumption
            			if flagcusp eq 0 then
            			     Tqcuspdvr:=TqCusp(Qcusps,O,q,l,ReOrderHorbits);//becareful!!
            			     //Tqcuspdvr;
            			     
            			     TqDvr:=Tqsupp+rdg*Tqcuspdvr;
            			           
            		              if Degree(TqDvr) ne 0 then error"no!check the program";end if;
            		       	
            			      if IsPrincipal(l*TqDvr) then 
            			     	"yes";
            			      else 
            			     	error"no not l-torsion!!! why!!";
            			     	flagofwhile:=1;	
            			       end if;
            			 end if;  	
       	            								
            	end if;//0001		
        		
        end if;//1
        	
        if flagofwhile eq 1 then 	
        	break;
        end if;
        		
  end while;//00

"end of check the output using Hecke  operator T2";


return ReOrderHorbits;

end intrinsic;

intrinsic GeneratingCRTprimes()->BoolElt
{==Deteming defining field of Ramanujan subspce V_(k,l)==

For k in [12,16,18,20,22,26] and l a prime number, generates all the small primes p such that

d_p:=min d>=1 : X^d=1 mod (X^2-tau_k(p)*X+p^(k-1),l )) in Extdg (Extdg contains those d_p allowed) 
}

weight_k:=XHldata()[2][1];

l:=XHldata()[2][2];

Extdg:=[2,3,4,5];//  CRT prime p with d_p in  Extdg used

maximal_p:=10^4;//30*10^5;//upper bound of CRT prime p (if too large, then memory lacking problem may arise during computing J_H(l)(F_q))

RM:=Integers(l);

P<x> := PowerSeriesRing(RM,maximal_p);
	
e4:=P!qEisensteinSeries(4,maximal_p,l);
e6:=P!qEisensteinSeries(6,maximal_p,l);
e8:=P!qEisensteinSeries(8,maximal_p,l);

Delta12:=(e4^3-e6^2);
a1:=1/Coefficient(Delta12,1);
Delta12:=a1*Delta12;

Delta16:=Delta12*e4;
a1:=1/Coefficient(Delta16,1);
Delta16:=a1*Delta16;

Delta18:=Delta12*e6;
a1:=1/Coefficient(Delta18,1);
Delta18:=a1*Delta18;

Delta20:=Delta12*e8;
a1:=1/Coefficient(Delta20,1);
Delta20:=a1*Delta20;

Delta22:=Delta12*e4*e6;
a1:=1/Coefficient(Delta22,1);
Delta22:=a1*Delta22;

Delta26:=Delta22*e4;
a1:=1/Coefficient(Delta26,1);

Delta26:=a1*Delta26;

pande:=[];
M:=1;

for eee in Extdg do
	p:=100;	
	while true do
		p:=NextPrime(p);
		if p gt maximal_p then break;end if;

		if weight_k eq 12 then
			ee:=Extdeg(p,Integers()!Coefficient(Delta12,p),l,weight_k);
		elif weight_k eq 16 then
			ee:=Extdeg(p,Integers()!Coefficient(Delta16,p),l,weight_k);
		elif weight_k eq 18 then
			ee:=Extdeg(p,Integers()!Coefficient(Delta18,p),l,weight_k);
		elif weight_k eq 20 then
			ee:=Extdeg(p,Integers()!Coefficient(Delta20,p),l,weight_k);
		elif weight_k eq 22 then
			ee:=Extdeg(p,Integers()!Coefficient(Delta22,p),l,weight_k);
		elif weight_k eq 26 then
			ee:=Extdeg(p,Integers()!Coefficient(Delta26,p),l,weight_k);
		else
			error"weight_k not in [12,16,18,20,22,26]",weight_k;
		end if;
		
		if (ee eq eee) then
			Append(~pande,p);
			Append(~pande,ee);
			M:=M*p;
		end if;			
	end while;	

end for;
"number of good primes",#pande div 2;
"Log(product of all p)",Log(M)/Log(10); 



name3:="allgoodprimes_weight"cat IntegerToString(weight_k) cat "_module" cat IntegerToString(l) cat ".dat";

"written to file:",name3;

filept1:=Open(name3,"w");

k:=1;
	
while true do
	p:=pande[2*k-1];
	e:=pande[2*k];	
	Puts(filept1,IntegerToString(p));
	Puts(filept1,IntegerToString(e));
	k:=k+1;
	
	if 2*(k+1) gt #pande then break;end if;	
end while;

delete filept1;			

return true;

end intrinsic;

intrinsic Extdeg(p::RngIntElt,taup::RngIntElt,l::RngIntElt,k::RngIntElt)->RngIntElt
{compute the minimal extension degree of Ramanujan subspace V_l, 
	if the characteristic polynomial has equal eigen vales, return 100
	if extension degree > 7 return 100}
 		
		//f:=x^2-a*x+b=x^2-tau_k(p)*x+p^(k-1)			
		
		a:=GF(l)!taup;
		b:=GF(l)!p^(k-1);	
		
		deta:=(a^2-4*b);
			
		if deta ne 0 then
			if a eq 0 and (-b) eq 1 then return 2;
			elif (-b + a^2) eq 0 and (-a*b) eq 1 then return 3;
			elif (-2*a*b + a^3) eq 0 and (b^2 - a^2*b) eq 1 then return 4;
			elif (b^2 - 3*a^2*b + a^4) eq 0 and (2*a*b^2 - a^3*b) eq 1 then return 5;
			elif (3*a*b^2 - 4*a^3*b + a^5) eq 0 and (- b^3 + 3*a^2*b^2 - a^4*b) eq 1 then return 6;
			else return 100;
			end if;
		else
			return 100;			
		end if;								
end intrinsic;
   		