static void
bestlift_init(long a, GEN nf, GEN pr, GEN C, nflift_t *L)
{
const long D = 100;
const double alpha = ((double)D-1) / D; /* LLL parameter */
const long d = degpol(nf[1]);
pari_sp av = avma;
GEN prk, PRK, B, GSmin, pk;
pari_timer ti;
TIMERstart(&ti);
if (!a) a = (long)bestlift_bound(C, d, alpha, pr_norm(pr));
for (;; avma = av, a<<=1)
{
if (DEBUGLEVEL>2) fprintferr("exponent: %ld\n",a);
PRK = prk = idealpows(nf, pr, a);
pk = gcoeff(prk,1,1);
/* reduce size first, "scramble" matrix */
PRK = lllintpartial_ip(PRK);
/* now floating point reduction is fast */
PRK = lllint_fp_ip(PRK, 4);
PRK = lllint_i(PRK, D, 0, NULL, NULL, &B);
if (!PRK) { PRK = prk; GSmin = pk; } /* nf = Q */
else
{
pari_sp av2 = avma;
GEN S = invmat( get_R(PRK) ), BB = GS_norms(B, DEFAULTPREC);
GEN smax = gen_0;
long i, j;
for (i=1; i<=d; i++)
{
GEN s = gen_0;
for (j=1; j<=d; j++)
s = gadd(s, gdiv( gsqr(gcoeff(S,i,j)), gel(BB,j)));
if (gcmp(s, smax) > 0) smax = s;
}
GSmin = gerepileupto(av2, ginv(gmul2n(smax, 2)));
}
if (gcmp(GSmin, C) >= 0) break;
}
if (DEBUGLEVEL>2)
fprintferr("for this exponent, GSmin = %Z\nTime reduction: %ld\n",
GSmin, TIMER(&ti));
L->k = a;
L->den = L->pk = pk;
L->prk = PRK;
L->iprk = ZM_inv(PRK, pk);
L->GSmin= GSmin;
L->prkHNF = prk;
init_proj(L, gel(nf,1), gel(pr,1));
}
/* The interface pipe the tildA to realA, m is chanel number */
void EEGrealA(double *tildA, double **realA, double *Ve,int m, int order)
{
double *A1[MAXORDER];
int i,j;
j=order*(order+1)*m*m/2;
for(i=0;i<=order;i++){
A1[i]=tildA+j;
j += m*m;
}
invmat(A1[0],realA[0],m);
matmmatH(realA[0],Ve,m);
for(i=1;i<=order;i++)
matmmat(realA[0],A1[i],realA[i],m);
for(i=0;i<m*m;i++)realA[0][i]=0.;
for(i=0;i<m;i++)realA[0][i*(m+1)]=1.;
return;
}
void iterative_matrix_inverse(double *matptr, double *invmatptr, int n,
_Bool prev, double epsilon, double *work1,
double *work2, int *error,
cublasHandle_t cublas_handle, int *nit_out)
{
INIT_ERROR(error);
mat<double> matr(n, matptr, cublas_handle);
mat<double> invmat(n, invmatptr, cublas_handle);
/* Will allocate and release upon destruction if work1, work2 == NULL */
mat<double> help1(n, work1, cublas_handle);
mat<double> help2(n, work2, cublas_handle);
/*
* - Initialize inverse matrix if previous not used
* The starting invmat has to be small enough so that the iteration
* won't start running to infinity
*/
#if 0
mat<double> dummy(n);
dummy = matr;
printf("dummy.data() = %p\n", dummy.data());
printf("matr.data() = %p\n", matr.data());
printf("dummy.on_host() = %i\n", dummy.on_host(error));
PASS_ERROR(error);
printf("matr.on_host() = %i\n", matr.on_host(error));
PASS_ERROR(error);
printf("sum = %f %f\n", dummy.sum(), matr.sum());
printf("max = %f %f\n", dummy.max(), matr.max());
printf("min = %f %f\n", dummy.min(), matr.min());
printf("amax = %f %f\n", dummy.amax(), matr.amax());
printf("amin = %f %f\n", dummy.amin(), matr.amin());
#endif
if (!prev) {
double smin, smax;
ev_bounds(n, matptr, &smin, &smax, error);
PASS_ERROR(error);
mat_mul_sca(1.0/(n*MAX(fabs(smin), fabs(smax))), matr, invmat, error);
PASS_ERROR(error);
}
/*
* Find inverse via S^-1 = 2 S^1 - S^-1 S S^-1
*/
double sigma = epsilon + 1.0;
int i = 0;
while (sigma > epsilon) {
/*
* help1 = matr.invmat
*/
gemm(OP_N, OP_N, 1.0, matr, invmat, 0.0, help1, error);
PASS_ERROR(error);
help2 = invmat;
/*
* invmat = -help2.help1 + 2*invmat
*/
gemm(OP_N, OP_N, -1.0, help2, help1, 2.0, invmat, error);
PASS_ERROR(error);
mat_mul_sca(1.0, help2, -1.0, invmat, help1, error);
PASS_ERROR(error);
sigma = help1.amax(error);
PASS_ERROR(error);
i = i+1;
if (i % 100 == 0) {
prscrlog("iterative_matrix_inverse: No convergence after %i iterations.",
i);
}
}
if (nit_out) {
*nit_out = i;
}
}
void blochsim(double *b1real, double *b1imag,
double *xgrad, double *ygrad, double *zgrad, double *tsteps,
int ntime, double *e1, double *e2, double df,
double dx, double dy, double dz,
double *mx, double *my, double *mz, int mode)
/* Go through time for one df and one dx,dy,dz. */
{
int tcount;
double gammadx;
double gammady;
double gammadz;
double rotmat[9];
double amat[9], bvec[3]; /* A and B propagation matrix and vector */
double arot[9], brot[3]; /* A and B after rotation step. */
double decmat[9]; /* Decay matrix for each time step. */
double decvec[3]; /* Recovery vector for each time step. */
double rotx,roty,rotz; /* Rotation axis coordinates. */
double imat[9], mvec[3];
double mcurr0[3]; /* Current magnetization before rotation. */
double mcurr1[3]; /* Current magnetization before decay. */
eyemat(amat); /* A is the identity matrix. */
eyemat(imat); /* I is the identity matrix. */
zerovec(bvec);
zerovec(decvec);
zeromat(decmat);
gammadx = dx*GAMMA; /* Convert to Hz/cm */
gammady = dy*GAMMA; /* Convert to Hz/cm */
gammadz = dz*GAMMA; /* Convert to Hz/cm */
mcurr0[0] = *mx; /* Set starting x magnetization */
mcurr0[1] = *my; /* Set starting y magnetization */
mcurr0[2] = *mz; /* Set starting z magnetization */
for (tcount = 0; tcount < ntime; tcount++)
{
/* Rotation */
rotz = -(*xgrad++ * gammadx + *ygrad++ * gammady + *zgrad++ * gammadz +
df*TWOPI ) * *tsteps;
rotx = (- *b1real++ * GAMMA * *tsteps);
roty = (+ *b1imag++ * GAMMA * *tsteps++);
calcrotmat(rotx, roty, rotz, rotmat);
if (mode == 1)
{
multmats(rotmat,amat,arot);
multmatvec(rotmat,bvec,brot);
}
else
multmatvec(rotmat,mcurr0,mcurr1);
/* Decay */
decvec[2]= 1- *e1;
decmat[0]= *e2;
decmat[4]= *e2++;
decmat[8]= *e1++;
if (mode == 1)
{
multmats(decmat,arot,amat);
multmatvec(decmat,brot,bvec);
addvecs(bvec,decvec,bvec);
}
else
{
multmatvec(decmat,mcurr1,mcurr0);
addvecs(mcurr0,decvec,mcurr0);
}
/*
printf("rotmat = [%6.3f %6.3f %6.3f ] \n",rotmat[0],rotmat[3],
rotmat[6]);
printf(" [%6.3f %6.3f %6.3f ] \n",rotmat[1],rotmat[4],
rotmat[7]);
printf(" [%6.3f %6.3f %6.3f ] \n",rotmat[2],rotmat[5],
rotmat[8]);
printf("A = [%6.3f %6.3f %6.3f ] \n",amat[0],amat[3],amat[6]);
printf(" [%6.3f %6.3f %6.3f ] \n",amat[1],amat[4],amat[7]);
printf(" [%6.3f %6.3f %6.3f ] \n",amat[2],amat[5],amat[8]);
printf(" B = <%6.3f,%6.3f,%6.3f> \n",bvec[0],bvec[1],bvec[2]);
printf("<mx,my,mz> = <%6.3f,%6.3f,%6.3f> \n",
amat[6] + bvec[0], amat[7] + bvec[1], amat[8] + bvec[2]);
printf("\n");
*/
if (mode == 2) /* Sample output at times. */
/* Only do this if transient! */
{
*mx = mcurr0[0];
*my = mcurr0[1];
*mz = mcurr0[2];
mx++;
my++;
mz++;
}
}
/* If only recording the endpoint, either store the last
point, or calculate the steady-state endpoint. */
if (mode==0) /* Indicates start at given m, or m0. */
{
*mx = mcurr0[0];
*my = mcurr0[1];
*mz = mcurr0[2];
}
else if (mode==1) /* Indicates to find steady-state magnetization */
{
scalemat(amat,-1.0); /* Negate A matrix */
addmats(amat,imat,amat); /* Now amat = (I-A) */
invmat(amat,imat); /* Reuse imat as inv(I-A) */
multmatvec(imat,bvec,mvec); /* Now M = inv(I-A)*B */
*mx = mvec[0];
*my = mvec[1];
*mz = mvec[2];
}
}
M inv() const {
check_posdef();
M invmat(cholmat);
inv_chol_inplace(invmat, is_upper);
return invmat;
}
static fint getvec( double *xdat ,
fint *xdim ,
double *ydat ,
double *wdat ,
fint *ndat ,
double *fpar ,
double *epar ,
fint *npar ,
fint *fopt )
/*
* getvec calculates the correction vector. The matrix has been built by
* getmat, we only have to rescale it for the current value for labda.
* The matrix is rescaled so that the diagonal gets the value 1 + labda.
* Next we calculate the inverse of the matrix and then the correction
* vector.
*/
{
double dj;
double dy;
double mii;
double mji;
double mjj;
double wn;
fint i;
fint j;
fint n;
fint r;
for (j = 0; j < nfree; j++) { /* loop to modify and ... */
mjj = matrix1[j][j]; /* scale the matrix */
if (mjj <= 0.0) return( -5 ); /* diagonal element wrong! */
mjj = sqrt( mjj );
for (i = 0; i < j; i++) { /* scale it */
mji = matrix1[j][i] / mjj / sqrt( matrix1[i][i] );
matrix2[i][j] = matrix2[j][i] = mji;
}
matrix2[j][j] = 1.0 + labda; /* scaled value on diagonal */
}
if (r = invmat( )) return( r ); /* invert matrix inlace */
for (i = 0; i < (*npar); i++) epar[i] = fpar[i];
for (j = 0; j < nfree; j++) { /* loop to calculate ... */
dj = 0.0; /* correction vector */
mjj = matrix1[j][j];
if (mjj <= 0.0) return( -7 ); /* not allowed! */
mjj = sqrt( mjj );
for (i = 0; i < nfree; i++) {
mii = matrix1[i][i];
if (mii <= 0.0) return( -7 );
mii = sqrt( mii );
dj += vector[i] * matrix2[j][i] / mjj / mii;
}
epar[parptr[j]] += dj; /* new parameters */
}
chi1 = 0.0; /* reset reduced chi-squared */
for (n = 0; n < (*ndat); n++) { /* loop through data points */
wn = wdat[n]; /* get weight */
if (wn > 0.0) { /* legal weight */
dy = ydat[n] - funcd_c( &xdat[(*xdim) * n], epar, npar, fopt );
chi1 += wdat[n] * dy * dy;
}
}
return( 0 );
}
