/***************************************************************************************************
          PRINCIPALLY POLARIZED SQUARES OF ELLIPTIC CURVES WITH FIELD OF MODULI EQUAL TO Q
                    ALEXANDRE GÉLIN, EVERETT W. HOWE, AND CHRISTOPHE RITZENTHALER
***************************************************************************************************/

// Here appears the function to get the period matrix thanks to the polarization.
// Reduc() is where is stored the output of the file Reduction.maple.

PerMat:=function(M,w) //find the period matrix given the polarization
    M1:=Matrix(IntegerRing(),2,2,[M[i,j][2]/(1/w)[2] : i,j in [1..2]]);
    M2:=Matrix(IntegerRing(),2,2,[M[i,j][1]-M[i,j][2]*w[1]/w[2] : i,j in [1..2]]);
    M3:=-Transpose(M2);
    M4:=Matrix(IntegerRing(),2,2,[-M[i,j][2]/w[2] : i, j in [1..2]]);
    T:=BlockMatrix(2,2,[M1,M2,M3,M4]);
    J,B:=FrobeniusFormAlternating(T);
    B1:=Submatrix(B,1,1,2,2);
    B2:=Submatrix(B,1,3,2,2);
    B3:=Submatrix(B,3,1,2,2);
    B4:=Submatrix(B,3,3,2,2);
    X:=Matrix(2,2,[w,0,0,w]);
    return (B1*X+B2)*(B3*X+B4)^(-1);
end function;

Reduc:=function(Tau) //reduce the period matrix
    QF<u>:=BaseRing(Tau);
    case [Tau[1,1],Tau[2,2],Tau[1,2]]:
    when [ 1/4*(u - 4), 1/6*(u + 4), 1/2 ]:
	B:=[ -1, 1, -2, 0, -1, -2, 0, 2, 1, -2, 2, 1, 0, 1, -1, -1 ];
    when [ 1/10*u, 1/10*u, -1/2 ]:
	B:=[ -1, 0, 0, -1, 0, 1, 1, 0, 0, 2, 1, 0, -2, 0, 0, -1 ];
    when [ 1/14*(u - 48), 1/12*(u + 12), -1/2 ]:
	B:=[ 1, -1, 3, 1, 0, -1, 0, 1, 0, 2, 1, -2, -2, 0, -7, -1 ];
    when [ 1/22*(u - 120), 1/20*(u + 20), -1/2 ]:
	B:=[ -1, 1, -5, -2, 0, 1, 1, -1, 0, 2, 1, -2, -2, 0, -11, -1 ];
    when [ 1/110*(7*u - 260), 1/11*(3*u + 30), 1/11*(u + 10) ]:
	B:=[ 0, 0, 0, -1, -2, 0, -5, 2, 0, 1, -1, -3, 1, 0, 2, -1 ];
    when [ 1/26*u, 1/26*u, -1/2 ]:
	B:=[ 0, -1, 0, 0, 1, 0, 0, 0, -2, 0, 0, -1, 0, 2, 1, 0 ];
    when [ 1/182*(9*u - 611), 1/14*(3*u + 39), 1/14*(u + 13) ]:
	B:=[ -2, 0, -7, 2, 0, 0, 0, -1, 1, 0, 3, -1, 0, 1, -1, -3 ];
    when [ 1/46*(u - 528), 1/44*(u + 44), -1/2 ]:
	B:=[ -1, -1, -12, 0, 0, -1, -1, 1, 0, 2, 1, -2, 2, 0, 23, 1 ];
    when [ 1/619391*(798*u - 1247417), 1/619391*(1992*u - 328922), 1/619391*(985*u - 155804) ]:
	B:=[ 0, 4, 1, 2, -14, 1, -28, -3, -1, 8, 0, 4, 4, 0, 8, 1 ];
    when [ 1/74*u, 1/74*u, -1/2 ]:
	B:=[ 1, 0, 0, 1, 0, -1, -1, 0, 0, -2, -1, 0, 2, 0, 0, 1 ];
    when [ 1/14190326*(951*u - 17772743), 1/28380652*(17621*u - 9617003), 1/14190326*(2198*u - 1184703) ]:
	B:=[ 40, -1, 50, 3, -1, 3, -1, 1, 28, -1, 35, 2, 1, -15, 0, -5 ];
    when [ 1/5513*(31*u - 30784), 1/149*(6*u + 444), 1/149*(u + 74) ]:
	B:=[ -1, -1, -5, 3, -6, -1, -33, 6, 0, 2, -1, -6, 2, 0, 11, -1 ];
    when [ 1/118*(u - 3480), 1/116*(u + 116), -1/2 ]:
	B:=[ -2, -1, -59, 0, 1, -1, 29, 1, -2, 0, -59, -1, 0, 2, 1, -2 ];
    when [ 1/413878394*(20373*u - 828346706), 1/206939197*(21939*u - 32448622), 1/206939197*(10955*u - 15929323) ]:
	B:=[ -54, 1, -108, -4, 0, 13, 1, 2, 13, 0, 26, 1, -1, 26, 0, 4 ];
    when [ 1/36276587*(3026*u - 54502185), 1/36276587*(27166*u - 18514470), 1/36276587*(6777*u - 4541284) ]:
	B:=[ -1, 4, -1, 2, -52, 1, -78, -6, 1, -12, 0, -6, 8, 0, 12, 1 ];
    when [ 1/406*(u - 12934), 1/406*(u - 464), -4/7 ]:
	B:=[ 2, -1, 63, 0, -1, -2, -33, -3, 7, 0, 223, 4, 0, 7, 4, 8 ];
    when [ 1/59681989387*(225803*u - 101777596362), 1/1411489*(7*u + 63336), 1/1411489*(2*u + 18096) ]:
	B:=[ 189, -54, 323, 0, -54, -7, -92, 1, -26, 52, -45, -2, 0, 156, -2, -7 ];
    when [ 1/5442919*(2348*u - 10920803), 1/5442919*(5476*u - 1889670), 1/5442919*(2723*u - 909840) ]:
	B:=[ 0, 6, 1, 2, -20, 1, -40, -3, -1, 12, 0, 4, 6, 0, 12, 1 ];
    when [ 1/33511*(241*u + 400110), 1/1081*(5*u + 900), 1/1081*(-2*u - 360) ]:
	B:=[ 3, 0, -36, 1, -1, -3, 11, 2, 5, 2, -59, 0, 0, 6, 2, -5 ];
    when [ 1/59551*(409*u + 1423650), 1/1921*(5*u + 1200), 1/1921*(-2*u - 480) ]:
	B:=[ 2, 4, -47, -2, -2, 1, 48, -1, 5, 2, -119, 0, 0, -8, -2, 5 ];
    when [ 1/3227518*(547*u - 3639969), 1/8449*(5*u + 2640), 1/8449*(2*u + 1056) ]:
	B:=[ -1, 7, -2, -2, 37, -2, 42, -4, 0, -16, 2, 5, -8, 0, -9, 1 ];
    when [ 1/10021341242*(116101*u - 34860850696), 1/10021341242*(48377*u - 439795128), 1/10021341242*(24616*u - 217880163) ]:
	B:=[ -31, -53, -109, -3, 47, -69, 162, -2, 109, -54, 378, 0, 1, -160, 0, -7 ];
    when [ 1/75512*(u - 169044), 1/624*(u - 2340), -3/8 ]:
	B:=[ 10, -1, 22, 0, 11, 1, 25, 8, 88, 0, 197, 33, 0, -8, -3, -30 ];
    when [ 1/6492975371*(40322*u - 9742081809), 1/6492975371*(338566*u - 1309408230), 1/6492975371*(84609*u - 324733240) ]:
	B:=[ -124, 1, -186, -6, -1, 10, -1, 2, 20, 0, 30, 1, 1, -30, 0, -6 ];
    when [ 1/188772*(u - 1099740), 1/1560*(u - 49140), -7/12 ]:
	B:=[ -11, -5, -67, -164, -54, 1, -314, 0, 0, 12, 7, 378, -132, 0, -769, -77 ];
    when [ 1/41380320340902*(9616537*u - 247973162655122), 1/20690160170451*(746507*u - 155224633070), 1/20690160170451*(375561*u - 77491613095) ]:
	B:=[ 643, -321, 3852, 0, -268, 267, -1605, 1, -53, -640, -320, -5, 1, -1600, 0, -12 ];
    when [ 1/709609818579826*(24220441*u - 965405833995765), 1/130909201*(11*u + 1674420), 1/130909201*(5*u + 761100) ]:
	B:=[ 1, 234, 0, -3, 1226, -10, 1668, -7, 0, 860, -5, -11, -699, 5, -951, 4 ];
    when [ 1/106697681915039*(10330122*u - 853588324409027), 1/106697681915039*(20911044*u - 2604365993030), 1/106697681915039*(10455427*u - 1301201698100) ]:
	B:=[ -1, 656, 0, 16, 746, -4, 5968, 9, 0, -82, -1, -2, -580, 3, -4640, -7 ];
    when [ 1/9*(u - 13), 1/9*(u - 13), 1/18*(u - 13) ]:
	B:=[ -1, 1, -1, 1, 0, -1, -1, -2, 1, 0, 1, 1, 1, 1, 2, 2 ];
    when [ 1/10*(3*u - 13), u + 1, 1/2*(u + 1) ]:
	B:=[ 1, 0, 1, -1, 0, 1, -1, -1, 0, 0, 1, 0, 0, 0, 0, 1 ];
    when [ 1/11*(3*u - 47), u + 1, 1/2*(u + 1) ]:
	B:=[ 1, 0, 4, -1, 0, 1, -1, -1, 0, 0, 1, 0, 0, 0, 0, 1 ];
    when [ 1/66*(u - 419), 1/66*(u - 1), -2/3 ]:
	B:=[ -1, -1, -7, -1, 0, 1, 1, 0, 0, 3, 2, 0, -3, 0, -19, -2 ];
    when [ 1/34*(9*u - 247), u + 1, 1/2*(u + 1) ]:
	B:=[ 1, 0, 7, -1, 0, 1, -1, -1, 0, 0, 1, 0, 0, 0, 0, 1 ];
    when [ 1/102*(u - 1055), 1/102*(u - 1), -2/3 ]:
	B:=[ -1, -1, -11, -1, 0, 1, 1, 0, 0, 3, 2, 0, -3, 0, -31, -2 ];
    when [ 1/646*(9*u - 2117), 1/19*(2*u + 70), 1/38*(u + 35) ]:
	B:=[ 0, 0, 0, -1, -3, 0, -10, 3, 0, 1, -1, -4, 1, 0, 3, -1 ];
    when [ 1/82*(21*u - 1579), u + 1, 1/2*(u + 1) ]:
	B:=[ 1, 0, 19, -1, 0, 1, -1, -1, 0, 0, 1, 0, 0, 0, 0, 1 ];
    when [ 1/246*(u - 6479), 1/246*(u - 1), -2/3 ]:
	B:=[ -1, -1, -27, -1, 0, 1, 1, 0, 0, 3, 2, 0, -3, 0, -79, -2 ];
    when [ 1/3526*(21*u - 32657), 1/43*(2*u + 166), 1/86*(u + 83) ]:
	B:=[ -4, 0, -37, 4, 0, 0, 0, -1, 1, 0, 9, -1, 0, 1, -1, -4 ];
    when [ 1/410*(u - 19599), 1/410*(u - 1), -3/5 ]:
	B:=[ 2, -1, 95, 1, 0, 2, 1, 0, 0, 5, 3, 0, 5, 0, 239, 3 ];
    when [ 1/82*(7*u + 567), 3*u + 3, 1/2*(-u - 1) ]:
	B:=[ 1, 0, -7, 1, 0, 1, 1, -3, 0, 0, 1, 0, 0, 0, 0, 1 ];
    when [ 1/44839*(3*u - 105987), 1/1838399*(3740*u + 7229152), 1/89678*(u - 35329) ]:
	B:=[ 6, -3, 13, 14, -10, -1, -24, 0, -1, 6, 0, -24, -33, 0, -78, -13 ];
    when [ 1/368818*(7*u - 803701), 1/7560769*(13175*u + 36065718), 1/368818*(u - 220191) ]:
	B:=[ -67, 0, -146, -40, 29, -2, 62, 27, -29, -3, -65, -3, 1, -7, -2, 34 ];
    when [ 1/2522665198*(212055*u - 3780021221), 1/1261332599*(535376*u + 1418475698), 1/2522665198*(475181*u + 1259691465) ]:
	B:=[ -1, 3, -3, -3, -118, 7, -180, 51, 2, 8, -1, -10, -2, 0, -3, 1 ];
    when [ 1/382063439*(606*u - 501638492), 1/1910317195*(70839*u - 777747454), 1/3820634390*(21829*u - 238858845) ]:
	B:=[ 141, -2, 185, 8, 1, -37, -1, -15, 125, -2, 164, 7, 1, -5, 1, -2 ];
    when [ 1/6812521*(5*u - 15098025), 1/1355691679*(340636*u + 21931819504), 1/13625042*(u - 3019605) ]:
	B:=[ 19, -5, 41, 85, -73, -1, -162, 0, -1, 10, 0, -162, -185, 0, -410, -41 ];
    when [ 1/634611*(154*u - 11120274), 1/6378*(11*u + 17523), 1/6378*(u + 1593) ]:
	B:=[ 4, 0, 70, -1, 1, -2, 18, 5, 11, -1, 193, 0, 0, 4, -1, -11 ];
    end case;
    B1:=Matrix(2,2,B[\[1,2,5,6]]);
    B2:=Matrix(2,2,B[\[3,4,7,8]]);
    B3:=Matrix(2,2,B[\[9,10,13,14]]);
    B4:=Matrix(2,2,B[\[11,12,15,16]]);
    return (B1*Tau+B2)*(B3*Tau+B4)^(-1);
end function;
