/* K a bnf. Compute kernel \tilde{Cl}_K(ell); return cyclic factors.
* Set *pM to (vtilde_S[i](US[j]))_{i,j} */
static GEN
CL_tilde(GEN K, GEN US, GEN ell, GEN T, GEN Ftilde, GEN *pM, long prec)
{
GEN D, M, ellk, vdegS;
long i, j, imin, vmin, k, lD, l = lg(T), lU = lg(US);
*pM = cgetg(1, t_MAT);
if (l == 2) return cgetg(1, t_VEC); /* p = P^e: \tilde{Cl}(l) = (1) */
vdegS = get_vdegS(Ftilde, ell, prec);
imin = 1; vmin = l; /* upper bound */
for (i = 1; i < l; i++)
{
long v = z_pval(Ftilde[i], ell);
if (v < vmin) { vmin = v; imin = i; }
}
M = cgetg(lU, t_MAT);
for (j = 1; j < lU; j++)
{
GEN c = cgetg(l, t_COL), a = gel(US,j);
for (i = 1; i < l; i++)
gel(c,i) = vtilde(K, a, gel(T,i), gel(vdegS,i), ell, prec);
gel(M,j) = c;
}
k = padicprec(M, ell); ellk = powiu(ell, k);
*pM = M = gmod(M, ellk);
M = rowsplice(M, imin);
l--;
if (l == 1) return cgetg(1, t_VEC);
M = ZM_hnfmodid(M, ellk);
D = matsnf0(M, 4); lD = lg(D);
if (lD > 1 && Z_pval(gel(D,1), ell) >= k) return NULL;
return D;
}
void PDESolver::CrankNicolson(vec *v){
double a,a2,a3; vec A1 = zeros<vec>(Nx), A2 = zeros<vec>(Nx), A3 = zeros<vec>(Nx), vtilde, vnew;
a = dt / dx / dx; a2 = 2 - 2*a; a3 = 2 + 2*a; ofstream myfile;
myfile.open("CrankNicolson_movie.txt");
// Setting the diagonals on of the LHS-matrix.
for (int i=0; i<Nx; i++){
A1(i) = -a; A2(i) = a3; A3(i) = -a;
}
vnew = *v; vtilde = vnew;
for (int j=1; j<Nt; j++){
// Chaning the RHS vector v_old into vtilde.
for (int i=1; i<Nx-1; i++){
vtilde(i) = a*vnew(i-1) + a2*vnew(i) + a*vnew(i+1);
}
vnew = PDESolver::tridiagonal(A1,A2,A3,vtilde);
for (int i=0; i<Nx; i++){myfile << vnew(i) + 1 - i*dx << " ";}; myfile << endl;
}
myfile.close();
for (int i=0; i<Nx; i++){vnew(i) += 1 - i*dx;}
*v = vnew;
}
static GEN
bnflog_i(GEN bnf, GEN ell)
{
long prec0, prec;
GEN nf, US, vdegS, S, T, M, CLp, CLt, Ftilde, vtG, ellk;
GEN D, Ap, cycAp, bnfS;
long i, j, lS, lvAp;
checkbnf(bnf);
nf = checknf(bnf);
S = idealprimedec(nf, ell);
bnfS = bnfsunit0(bnf, S, nf_GENMAT, LOWDEFAULTPREC); /* S-units */
US = leafcopy(gel(bnfS,1));
prec0 = maxss(30, vtilde_prec(nf, US, ell));
US = shallowconcat(bnf_get_fu(bnf), US);
settyp(US, t_COL);
T = padicfact(nf, S, prec0);
lS = lg(S); Ftilde = cgetg(lS, t_VECSMALL);
for (j = 1; j < lS; j++) Ftilde[j] = ftilde(nf, gel(S,j), gel(T,j));
CLp = CL_prime(bnf, ell, S);
cycAp = gel(CLp,1);
Ap = gel(CLp,2);
for(;;)
{
CLt = CL_tilde(nf, US, ell, T, Ftilde, &vtG, prec0);
if (CLt) break;
prec0 <<= 1;
T = padicfact(nf, S, prec0);
}
prec = ellexpo(cycAp, ell) + ellexpo(CLt,ell) + 1;
if (prec == 1) return mkvec3(cgetg(1,t_VEC), cgetg(1,t_VEC), cgetg(1,t_VEC));
vdegS = get_vdegS(Ftilde, ell, prec0);
ellk = powiu(ell, prec);
lvAp = lg(Ap);
if (lvAp > 1)
{
GEN Kcyc = bnf_get_cyc(bnf);
GEN C = zeromatcopy(lvAp-1, lS-1);
GEN Rell = gel(CLp,3), Uell = gel(CLp,4), ordS = gel(CLp,5);
for (i = 1; i < lvAp; i++)
{
GEN a, b, bi, A = gel(Ap,i), d = gel(cycAp,i);
bi = isprincipal(bnf, A);
a = vecmodii(ZC_Z_mul(bi,d), Kcyc);
/* a in subgroup generated by S = Rell; hence b integral */
b = hnf_invimage(Rell, a);
b = vecmodii(ZM_ZC_mul(Uell, ZC_neg(b)), ordS);
A = mkvec2(A, cgetg(1,t_MAT));
A = idealpowred(nf, A, d);
/* find a principal representative of A_i^cycA_i up to elements of S */
a = isprincipalfact(bnf,gel(A,1),S,b,nf_GENMAT|nf_FORCE);
if (!gequal0(gel(a,1))) pari_err_BUG("bnflog");
a = famat_mul_shallow(gel(A,2), gel(a,2)); /* principal part */
if (lg(a) == 1) continue;
for (j = 1; j < lS; j++)
gcoeff(C,i,j) = vtilde(nf, a, gel(T,j), gel(vdegS,j), ell, prec0);
}
C = gmod(gneg(C),ellk);
C = shallowtrans(C);
M = mkmat2(mkcol2(diagonal_shallow(cycAp), C), mkcol2(gen_0, vtG));
M = shallowmatconcat(M); /* relation matrix */
}
else
M = vtG;
M = ZM_hnfmodid(M, ellk);
D = matsnf0(M, 4);
if (lg(D) == 1 || !dvdii(gel(D,1), ellk))
pari_err_BUG("bnflog [missing Z_l component]");
D = vecslice(D,2,lg(D)-1);
return mkvec3(D, CLt, ellsylow(cycAp, ell));
}
