/*
In: tau (lattice parameter)
Out: g2 -> g[0]
g3 -> g[1]
*/
void compute_invariants(gsl_complex tau, gsl_complex *g)
{
gsl_complex q, q14;
gsl_complex t2,t3,t24,t34;
gsl_complex g3_term1, g3_term2;
gsl_complex g2, g3;
q = gsl_complex_exp(gsl_complex_mul_imag(tau,M_PI));
q14 = gsl_complex_exp(gsl_complex_mul_imag(tau,M_PI_4));
t2=theta20(q,q14);
t3=theta30(q);
t24 = pow4(t2);
t34 = pow4(t3);
g2 = gsl_complex_mul_real(gsl_complex_sub(gsl_complex_add(gsl_complex_mul(t24,t24),gsl_complex_mul(t34,t34)),gsl_complex_mul(t24,t34)),_CONST_43PI4);
g3_term1 = gsl_complex_add(gsl_complex_mul(t24,gsl_complex_mul(t24,t24)),gsl_complex_mul(t34,gsl_complex_mul(t34,t34)));
g3_term2 = gsl_complex_mul(gsl_complex_add(t24,t34),gsl_complex_mul(t24,t34));
g3 = gsl_complex_sub( gsl_complex_mul_real(g3_term1, _CONST_827PI6),
gsl_complex_mul_real(g3_term2, _CONST_49PI6) );
g[0] = g2;
g[1] = g3;
}
/* psi(z) for large |z| in the right half-plane; [Abramowitz + Stegun, 6.3.18] */
static
gsl_complex
psi_complex_asymp(gsl_complex z)
{
/* coefficients in the asymptotic expansion for large z;
* let w = z^(-2) and write the expression in the form
*
* ln(z) - 1/(2z) - 1/12 w (1 + c1 w + c2 w + c3 w + ... )
*/
static const double c1 = -0.1;
static const double c2 = 1.0/21.0;
static const double c3 = -0.05;
gsl_complex zi = gsl_complex_inverse(z);
gsl_complex w = gsl_complex_mul(zi, zi);
gsl_complex cs;
/* Horner method evaluation of term in parentheses */
gsl_complex sum;
sum = gsl_complex_mul_real(w, c3/c2);
sum = gsl_complex_add_real(sum, 1.0);
sum = gsl_complex_mul_real(sum, c2/c1);
sum = gsl_complex_mul(sum, w);
sum = gsl_complex_add_real(sum, 1.0);
sum = gsl_complex_mul_real(sum, c1);
sum = gsl_complex_mul(sum, w);
sum = gsl_complex_add_real(sum, 1.0);
/* correction added to log(z) */
cs = gsl_complex_mul(sum, w);
cs = gsl_complex_mul_real(cs, -1.0/12.0);
cs = gsl_complex_add(cs, gsl_complex_mul_real(zi, -0.5));
return gsl_complex_add(gsl_complex_log(z), cs);
}
void DAESolver::set_jacobian_matrix(Real const a_step_interval)
{
const Real alphah(alpha_ / a_step_interval);
const Real betah(beta_ / a_step_interval);
const Real gammah(gamma_ / a_step_interval);
gsl_complex comp1, comp2;
for (RealVector::size_type i(0); i < the_system_size_; i++)
{
for (RealVector::size_type j(0); j < the_system_size_; j++)
{
const Real a_partial_derivative(the_jacobian_[i][j]);
gsl_matrix_set(the_jacobian_matrix1_, i, j, a_partial_derivative);
GSL_SET_COMPLEX(&comp1, a_partial_derivative, 0);
gsl_matrix_complex_set(the_jacobian_matrix2_, i, j, comp1);
}
}
for (Integer c(0); c < the_function_differential_size_; ++c)
{
const Real a_partial_derivative(
gsl_matrix_get(the_jacobian_matrix1_, c, c));
gsl_matrix_set(the_jacobian_matrix1_, c, c,
gammah + a_partial_derivative);
comp1 = gsl_matrix_complex_get(the_jacobian_matrix2_, c, c);
GSL_SET_COMPLEX(&comp2, alphah, betah);
gsl_matrix_complex_set(the_jacobian_matrix2_, c, c,
gsl_complex_add(comp1, comp2));
}
decomp_jacobian_matrix();
}
gsl_complex vectorc::operator*(const vectorc& vec) const
{
gsl_complex result;
for (int i=0; i<size_m; i++)
gsl_complex_add(result, gsl_complex_mul(gsl_vector_complex_get(v_m, i), gsl_vector_complex_get(vec.v_m, i)));
return result;
}
/* ------------------------------------------------------ */
gsl_complex gsl_complex_arctan2 (gsl_complex a, gsl_complex b)
{
gsl_complex z, p;
if(GSL_REAL(b) != 0.0)
{
z = gsl_complex_arctan(gsl_complex_div(a, b));
if(GSL_REAL(b) < 0.0){
GSL_SET_COMPLEX (&p, M_PI, 0);
if(GSL_REAL(a) >= 0.0)
z = gsl_complex_add(z, p);
else
z = gsl_complex_sub(z, p);
}
}
else
{
if(GSL_REAL(a) >= 0.0)
{
GSL_SET_COMPLEX (&z, M_PI/2.0, 0.0);
}
else
{
GSL_SET_COMPLEX (&z, -M_PI/2.0, 0.0);
}
}
return z;
}
complex_spinor complex_spinor::operator+(const complex_spinor & complex_spinor_param)const{
gsl_complex aux_UP;
gsl_complex aux_DOWN;
GSL_SET_COMPLEX(&aux_UP, 0, 0);
GSL_SET_COMPLEX(&aux_DOWN, 0, 0);
int i;
int nSitios = this->_numSites;
complex_spinor complex_spinor_res(nSitios);
for(i=0; i<nSitios ; i++){
aux_UP = gsl_complex_add(complex_spinor_param.complex_spinor_get(i, UP) , this->complex_spinor_get(i, UP));
aux_DOWN = gsl_complex_add(complex_spinor_param.complex_spinor_get(i, DOWN) , this->complex_spinor_get(i,DOWN));
complex_spinor_res.complex_spinor_set(i, UP, aux_UP);
complex_spinor_res.complex_spinor_set(i, DOWN, aux_DOWN);
}
return complex_spinor_res;
}
/* The Lattes map */
gsl_complex P_doubler(gsl_complex p, const gsl_complex *g)
{
gsl_complex p2, p3;
gsl_complex num;
gsl_complex denom;
gsl_complex term;
p2 = gsl_complex_mul(p,p);
p3 = gsl_complex_mul(p2,p);
/* denom = 4p^3 - g2p - g3 */
denom = gsl_complex_sub(gsl_complex_mul_real(p3,4.0),
gsl_complex_add(gsl_complex_mul(p,g[0]),g[1]));
/* num = (p^2 + g2/4)^2 + 2g3p */
term = gsl_complex_add(p2,gsl_complex_mul_real(g[0],0.25));
num = gsl_complex_add(gsl_complex_mul(p,gsl_complex_mul_real(g[1],2.0)),
gsl_complex_mul(term,term));
return gsl_complex_div(num,denom);
}
void CModel::AllFacetHarmonics(int bw, double r, gsl_complex *coeff){
for(int i=0; i<bw*bw; i++) GSL_SET_COMPLEX(&coeff[i], 0.0, 0.0);
gsl_complex *temp = new gsl_complex[bw*bw];
for(int i=0; i<f_no; i++){
FacetHarmonics(i, bw, r, temp);
for(int j=0; j<bw*bw; j++) coeff[j] = gsl_complex_add(coeff[j],temp[j]);
}
delete [] temp;
}
gsl_complex complex_spinor::operator* (const complex_spinor & complex_spinor_param) const{
gsl_complex aux_UP;
gsl_complex aux_DOWN;
gsl_complex aux;
GSL_SET_COMPLEX(&aux_UP, 0, 0);
GSL_SET_COMPLEX(&aux_DOWN, 0, 0);
GSL_SET_COMPLEX(&aux, 0, 0);
int i;
int nSitios = this->_numSites;
for(i=0; i<nSitios ; i++){
aux_UP = gsl_complex_mul(gsl_complex_conjugate(complex_spinor_param.complex_spinor_get(i,UP)) ,this->complex_spinor_get(i,UP));
aux_DOWN = gsl_complex_mul(gsl_complex_conjugate(complex_spinor_param.complex_spinor_get(i,DOWN)),this->complex_spinor_get(i,DOWN));
aux=gsl_complex_add(aux, gsl_complex_add(aux_UP,aux_DOWN));
}
return aux;
}
double intensita(gsl_complex A, gsl_complex B) {
// PROVVISORIO
//~ double intensita = (gsl_complex_abs2(A) + gsl_complex_abs2(B) )/(2*in.Z_st);
double intensita = gsl_complex_abs(gsl_complex_mul(gsl_complex_add(A,B) , gsl_complex_conjugate(gsl_complex_add(A,B))));
printf("I=%e\n",intensita);
#ifdef DEBUG
printf("|A|=%e\n",gsl_complex_abs(A));
printf("|B|=%e\n",gsl_complex_abs(B));
printf("intensita=%e\n",intensita);
#endif
return intensita;
}
static gsl_complex cop(double r, double theta, double phi,
void *op_params, spwf_func func, void *wf_params)
{
cop_params *params = op_params;
gsl_complex ret = gsl_complex_rect(0,0);
int i;
for(i=0; i < params->n; i++){
ret = gsl_complex_add(ret,
params->funcs[i](r, theta, phi, params->params[i], func, wf_params));
}
return ret;
}
double line_segment_integrand_wrapper(double t, void *data)
{
const LineSegmentParams *params = (const LineSegmentParams *)data;
gsl_complex p = gsl_complex_add(params->p0,
gsl_complex_mul_real(params->k, t));
gsl_complex v = f_envelope(p, params->params);
double v_part = (params->part == REAL) ? GSL_REAL(v) : GSL_IMAG(v);
double damped = exp( - params->damping * t) * v_part;
return damped;
}
/* NOTE: Assumes z is in fundamental parallelogram */
gsl_complex wP(gsl_complex z, gsl_complex tau, const gsl_complex *g)
{
int N = 6;
int i;
gsl_complex z0;
gsl_complex z02;
gsl_complex p;
z = near_origin(z,tau);
z0 = gsl_complex_div_real(z,(double)(1 << N));
z02 = gsl_complex_mul(z0,z0);
/* Laurent expansion: P \approx 1/z^2 + (g2/20)z^2 + (g3/28) z^4 */
p = gsl_complex_add(gsl_complex_inverse(z02),
gsl_complex_add(gsl_complex_mul(z02,gsl_complex_mul_real(g[0],0.05)),
gsl_complex_mul(gsl_complex_mul(z02,z02),gsl_complex_mul_real(g[1],_CONST_1_28))));
for (i=0;i<N;i++) {
p = P_doubler(p,g);
}
return p;
}
int main(int argc, char** argv)
{
gsl_complex a,b;
GSL_SET_COMPLEX(&a,3,4);//a=3+4i
GSL_SET_COMPLEX(&b,6,8);//b=6+8i
gsl_complex c = gsl_complex_add(a,b);
printf("a+b\treal : %f image : %f\n",c.dat[0],c.dat[1]);
c = gsl_complex_sub(a,b);
printf("a-b\treal : %f image : %f\n",c.dat[0],c.dat[1]);
c = gsl_complex_mul(a,b);
printf("a*b\treal : %f image : %f\n",c.dat[0],c.dat[1]);
c = gsl_complex_div(a,b);
printf("a/b\treal : %f image : %f\n",c.dat[0],c.dat[1]);
// system("PAUSE");
return 0;
}
gsl_complex pspace(double x=0.00){
//La funcion de onda en el espacio p
// x aqui es un momento
//heredamos todo de coherentstate
gsl_complex result;
result=gsl_complex_rect(0.00,0.000);
for(int i=0; i<totals; i++){
result=
gsl_complex_add(result,
gsl_complex_mul(componente[i].pspace(x),pesos[i]));
};
return result;
};
gsl_complex theta40(gsl_complex q)
{
int n=0;
gsl_complex accum = gsl_complex_rect(0.5,0.0);
gsl_complex q2 = gsl_complex_mul(q,q);
gsl_complex nextm = gsl_complex_negative(gsl_complex_mul(q,q2));
gsl_complex qpower = gsl_complex_negative(q);
while ((gsl_complex_abs(qpower) > 2.0*GSL_DBL_EPSILON) && (n < THETA_ITER_MAX)) {
accum = gsl_complex_add(accum, qpower);
qpower = gsl_complex_mul(qpower, nextm);
nextm = gsl_complex_mul(nextm, q2);
n++;
}
if (n >= THETA_ITER_MAX)
return(gsl_complex_rect(0.0,0.0));
return gsl_complex_mul_real(accum,2.0);
}
gsl_complex theta20(gsl_complex q, gsl_complex q14)
{
int n=0;
gsl_complex accum = gsl_complex_rect(0.0,0.0);
gsl_complex q2 = gsl_complex_mul(q,q);
gsl_complex nextm = q2;
gsl_complex qpower = gsl_complex_rect(1.0,0.0);
while ((gsl_complex_abs(qpower) > 2.0*GSL_DBL_EPSILON) && (n < THETA_ITER_MAX)) {
accum = gsl_complex_add(accum, qpower);
qpower = gsl_complex_mul(qpower, nextm);
nextm = gsl_complex_mul(nextm, q2);
n++;
}
if (n >= THETA_ITER_MAX)
return(gsl_complex_rect(0.0,0.0));
return gsl_complex_mul_real(gsl_complex_mul(q14,accum),2.0);
}
void MCPMPCoeffs::GeoUpdate(double seconds) {
for (int i=0;i<2*M();i++) {
gsl_complex v = gsl_vector_complex_get(geoVelocities,i); // expressed in deltalon/s,deltalat/s
gsl_complex p = gsl_vector_complex_get(geoPositions,i); // expressed in lon,lat
gsl_complex np = gsl_complex_add(p,gsl_complex_mul_real(v, seconds));
gsl_vector_complex_set(geoPositions,i,np);
// cout << "node " << i << " position = " << GSL_IMAG(np) << ", " << GSL_REAL(np) << endl;
}
}
/* The extended Lattes map (rational function doubling on the elliptic curve) */
void P_and_Pprime_doubler(gsl_complex *p, gsl_complex *pp, const gsl_complex *g)
{
gsl_complex pp3;
gsl_complex ppp, ppp3;
/* p'' */
ppp = gsl_complex_sub(gsl_complex_mul_real(gsl_complex_mul(*p,*p),6.0),
gsl_complex_mul_real(g[0],0.5));
ppp3 = gsl_complex_mul(ppp,gsl_complex_mul(ppp,ppp));
pp3 = gsl_complex_mul(*pp,gsl_complex_mul(*pp,*pp));
*pp = gsl_complex_sub(gsl_complex_add(gsl_complex_mul_real(gsl_complex_div(gsl_complex_mul(*p,ppp),*pp),3.0),
gsl_complex_mul_real(gsl_complex_div(ppp3,pp3),-0.25)),
*pp);
*p = P_doubler(*p,g);
}
gsl_complex integrate_contour(Params *params,
const Contour *contour)
{
gsl_complex result = gsl_complex_rect(0.0, 0.0);
if (contour->npoints < 2)
return result;
for (unsigned i = 0; i < contour->npoints - 1; ++i)
{
if (contour->skip[i])
continue;
result = gsl_complex_add(result,
integrate_line_segment(params, contour->points[i], contour->points[i+1]));
}
return result;
}
gsl_complex theta1(gsl_complex z, gsl_complex q, gsl_complex q14)
{
int n=0;
gsl_complex accum = gsl_complex_rect(0.0,0.0);
gsl_complex q2 = gsl_complex_mul(q,q);
gsl_complex nextm = gsl_complex_negative(q2);
gsl_complex qpower = gsl_complex_rect(1.0,0.0);
gsl_complex term = gsl_complex_rect(1.0,0.0);
while ((gsl_complex_abs(term) > 2.0*GSL_DBL_EPSILON) && (n < THETA_ITER_MAX)) {
term = gsl_complex_mul(qpower, gsl_complex_sin(gsl_complex_mul_real(z,2*n+1)));
accum = gsl_complex_add(accum, term);
qpower = gsl_complex_mul(qpower, nextm);
nextm = gsl_complex_mul(nextm, q2);
n++;
}
if (n >= THETA_ITER_MAX)
return(gsl_complex_rect(0.0,0.0));
return gsl_complex_mul_real(gsl_complex_mul(q14,accum),2.0);
}
gsl_complex theta3(gsl_complex z, gsl_complex q)
{
int n=0;
gsl_complex accum = gsl_complex_rect(0.5,0.0);
gsl_complex q2 = gsl_complex_mul(q,q);
gsl_complex nextm = gsl_complex_mul(q,q2);
gsl_complex qpower = q;
gsl_complex term = gsl_complex_rect(1.0,0.0);
while ((gsl_complex_abs(qpower) > 2.0*GSL_DBL_EPSILON) && (n < THETA_ITER_MAX)) {
term = gsl_complex_mul(qpower, gsl_complex_cos(gsl_complex_mul_real(z,2*(n+1))));
accum = gsl_complex_add(accum, term);
qpower = gsl_complex_mul(qpower, nextm);
nextm = gsl_complex_mul(nextm, q2);
n++;
}
if (n >= THETA_ITER_MAX)
return(gsl_complex_rect(0.0,0.0));
return gsl_complex_mul_real(accum,2.0);
}
/******************************************************************************
* calc_I()
* Calculate the field intensity at an arbitrary point within layer
*
* Parameters
* ---------
*
* Returns
* -------
*
* Notes
* -----
* Note assume that 0 <= z <= d[j] (but we dont check that here)
* except for the base layer (j==0), in that case z <= 0
*
******************************************************************************/
double calc_I(int layer_idx, double z, ref_model *ref, angle_calc *ang_c, layer_calc *lay_c){
double I, k;
gsl_complex Ai, Ar, Ei, Er, g, phase_i, phase_r;
k = ref->k;
GSL_REAL(Ai) = ang_c->Re_Ai[layer_idx];
GSL_IMAG(Ai) = ang_c->Im_Ai[layer_idx];
GSL_REAL(Ar) = ang_c->Re_Ar[layer_idx];
GSL_IMAG(Ar) = ang_c->Im_Ar[layer_idx];
GSL_REAL(g) = ang_c->Re_g[layer_idx];
GSL_IMAG(g) = ang_c->Im_g[layer_idx];
// calculate Ei at z within layer j
// make sure z is neg for base layer
if (layer_idx == 0){
if (z > 0) z = -1.0*z;
} else {
if (z < 0) z = -1.0*z;
}
GSL_REAL(phase_i) = 0.0;
GSL_IMAG(phase_i) = 1.0*k*z;
phase_i = gsl_complex_exp( gsl_complex_mul(phase_i,g));
Ei = gsl_complex_mul(Ai,phase_i);
// calculate Er at z within layer j
if (layer_idx > 0) {
GSL_REAL(phase_r) = 0.0;
GSL_IMAG(phase_r) = -1.0*k*z;
phase_r = gsl_complex_exp( gsl_complex_mul(phase_r,g));
Er = gsl_complex_mul(Ar,phase_r);
} else {
GSL_REAL(phase_r) = 0.0;
GSL_IMAG(phase_r) = 0.0;
GSL_REAL(Er) = 0.0;
GSL_IMAG(Er) = 0.0;
}
I = gsl_complex_abs2(gsl_complex_add(Ei,Er));
return (I);
}
void tabulate(FILE *os,
ComplexFunction fun,
void *params,
gsl_complex z0,
gsl_complex z1,
int n)
{
gsl_complex k = gsl_complex_sub(z1, z0);
for (int i = 0; i < n; ++i)
{
double t = (double)i / (n - 1);
gsl_complex z = gsl_complex_add(z0, gsl_complex_mul_real(k, t));
gsl_complex f = fun(z, params);
double abs = gsl_complex_abs(f);
fprintf(os, "%g %g %g %g %g %g %g\n",
t,
GSL_REAL(z), GSL_IMAG(z),
GSL_REAL(f), GSL_IMAG(f), abs, -abs);
}
}
//go through all sets of Bethe rapidities and calculate g1 for all identical sets. return value is sum of all these terms.
gsl_complex exact_integrationDE(double orteins, double ortzwei, double** kEp_plusminus, int anzahl_sets, double** coeffoverlap)
{
//variables to make loop easily readable, could delete from final version
double c, Energie, Energieprime, normierung, normierungprime;
double k[N];
double kprime[N];//corresponds to primed Bethe rapidity set in papers
gsl_complex overlap, overlapprime, integral;
GSL_SET_COMPLEX(&integral, 0.0, 0.0);//sum of all values, technically no needed but good for quick check of initial shape of g1
int zaehler_integrale = 0;//counter of total sets of integrals
double Nminusone_fak = 1.0;//(N-1) factorial, see definition of integrals on restricted spatial domain
for(int j=1; j<=(N-1); j++)
Nminusone_fak = Nminusone_fak * ((double) j);
for(int zaehler_eigenstate = 0 ; zaehler_eigenstate < anzahl_sets; zaehler_eigenstate++){//loop over all Bethe rapidity sets
c = kEp_plusminus[zaehler_eigenstate][0];//interaction strength
for(int bb=0; bb<N; bb++)
k[bb]=kEp_plusminus[zaehler_eigenstate][bb+1];//Bethe rapidities
Energie = kEp_plusminus[zaehler_eigenstate][N+1];//energy
normierung=kEp_plusminus[zaehler_eigenstate][N+6];//norm
GSL_SET_COMPLEX(&overlap, coeffoverlap[zaehler_eigenstate][0], coeffoverlap[zaehler_eigenstate][1]);//overlap of set with initial state
//calculate g1_DE for this Bethe set
gsl_complex integralwert = integraleigenfunction(k, k, c, normierung, normierung, orteins, ortzwei);
integralwert = gsl_complex_mul_real(integralwert, (Nminusone_fak*Laenge));//integral evaluated in Rp only -> missing factor of (N-1)!. Laenge (=system length): definition of g1 has prefactor of N!/(n*(N-1)!) = Laenge
integral = gsl_complex_add(integral, gsl_complex_mul(gsl_complex_mul(overlap, gsl_complex_conjugate(overlap)), integralwert));
}//end for loop zaehler_eigenstate
return integral;
};
/* NOTE: Assumes z is in fundamental parallelogram */
void wP_and_prime(gsl_complex z, gsl_complex tau, const gsl_complex *g, gsl_complex *p, gsl_complex *pp)
{
int N = 6; /* Enough iterations for good P, not so good P' */
int i;
gsl_complex z0;
gsl_complex z02;
gsl_complex pout, ppout;
gsl_complex ppsolve;
z = near_origin(z,tau);
z0 = gsl_complex_div_real(z,(double)(1 << N));
z02 = gsl_complex_mul(z0,z0);
/* Laurent expansion: P \approx 1/z^2 + (g2/20)z^2 + (g3/28) z^4 */
pout = gsl_complex_add(gsl_complex_inverse(z02),
gsl_complex_add(gsl_complex_mul(z02,gsl_complex_mul_real(g[0],0.05)),
gsl_complex_mul(gsl_complex_mul(z02,z02),gsl_complex_mul_real(g[1],_CONST_1_28))));
/* Laurent expansion: P' \approx -2/z^3 + g2/10z + g3/7 z^3 */
ppout = gsl_complex_add(gsl_complex_mul_real(gsl_complex_inverse(gsl_complex_mul(z0,z02)),-2.0),
gsl_complex_add(gsl_complex_mul(z0,gsl_complex_mul_real(g[0],0.1)),
gsl_complex_mul(gsl_complex_mul(z0,z02),gsl_complex_mul_real(g[1],_CONST_1_7))));
for (i=0;i<N;i++) {
P_and_Pprime_doubler(&pout, &ppout, g);
}
/* At this point ppout is a decent but not great approximation of P'(z) */
/* Instead of using it directly, we use it as a guide for which square root of */
/* (4P^3 - g2 P - g3) should be selected. */
ppsolve = gsl_complex_sqrt(
gsl_complex_sub(
gsl_complex_mul_real(gsl_complex_mul(pout,gsl_complex_mul(pout,pout)),4.0),
gsl_complex_add(gsl_complex_mul(g[0],pout),g[1])
)
);
*p = pout;
if (gsl_complex_abs(gsl_complex_sub(ppsolve,ppout)) < gsl_complex_abs(gsl_complex_add(ppsolve,ppout)))
*pp = ppsolve;
else
*pp = gsl_complex_negative(ppsolve);
}
int
gsl_eigen_hermv (gsl_matrix_complex * A, gsl_vector * eval,
gsl_matrix_complex * evec,
gsl_eigen_hermv_workspace * w)
{
if (A->size1 != A->size2)
{
GSL_ERROR ("matrix must be square to compute eigenvalues", GSL_ENOTSQR);
}
else if (eval->size != A->size1)
{
GSL_ERROR ("eigenvalue vector must match matrix size", GSL_EBADLEN);
}
else if (evec->size1 != A->size1 || evec->size2 != A->size1)
{
GSL_ERROR ("eigenvector matrix must match matrix size", GSL_EBADLEN);
}
else
{
const size_t N = A->size1;
double *const d = w->d;
double *const sd = w->sd;
size_t a, b;
/* handle special case */
if (N == 1)
{
gsl_complex A00 = gsl_matrix_complex_get (A, 0, 0);
gsl_vector_set (eval, 0, GSL_REAL(A00));
gsl_matrix_complex_set (evec, 0, 0, GSL_COMPLEX_ONE);
return GSL_SUCCESS;
}
/* Transform the matrix into a symmetric tridiagonal form */
{
gsl_vector_view d_vec = gsl_vector_view_array (d, N);
gsl_vector_view sd_vec = gsl_vector_view_array (sd, N - 1);
gsl_vector_complex_view tau_vec = gsl_vector_complex_view_array (w->tau, N-1);
gsl_linalg_hermtd_decomp (A, &tau_vec.vector);
gsl_linalg_hermtd_unpack (A, &tau_vec.vector, evec, &d_vec.vector, &sd_vec.vector);
}
/* Make an initial pass through the tridiagonal decomposition
to remove off-diagonal elements which are effectively zero */
chop_small_elements (N, d, sd);
/* Progressively reduce the matrix until it is diagonal */
b = N - 1;
while (b > 0)
{
if (sd[b - 1] == 0.0 || isnan(sd[b - 1]))
{
b--;
continue;
}
/* Find the largest unreduced block (a,b) starting from b
and working backwards */
a = b - 1;
while (a > 0)
{
if (sd[a - 1] == 0.0)
{
break;
}
a--;
}
{
size_t i;
const size_t n_block = b - a + 1;
double *d_block = d + a;
double *sd_block = sd + a;
double * const gc = w->gc;
double * const gs = w->gs;
/* apply QR reduction with implicit deflation to the
unreduced block */
qrstep (n_block, d_block, sd_block, gc, gs);
/* Apply Givens rotation Gij(c,s) to matrix Q, Q <- Q G */
for (i = 0; i < n_block - 1; i++)
{
const double c = gc[i], s = gs[i];
size_t k;
for (k = 0; k < N; k++)
{
gsl_complex qki = gsl_matrix_complex_get (evec, k, a + i);
gsl_complex qkj = gsl_matrix_complex_get (evec, k, a + i + 1);
/* qki <= qki * c - qkj * s */
/* qkj <= qki * s + qkj * c */
gsl_complex x1 = gsl_complex_mul_real(qki, c);
gsl_complex y1 = gsl_complex_mul_real(qkj, -s);
gsl_complex x2 = gsl_complex_mul_real(qki, s);
gsl_complex y2 = gsl_complex_mul_real(qkj, c);
gsl_complex qqki = gsl_complex_add(x1, y1);
gsl_complex qqkj = gsl_complex_add(x2, y2);
gsl_matrix_complex_set (evec, k, a + i, qqki);
gsl_matrix_complex_set (evec, k, a + i + 1, qqkj);
}
}
/* remove any small off-diagonal elements */
chop_small_elements (n_block, d_block, sd_block);
}
}
{
gsl_vector_view d_vec = gsl_vector_view_array (d, N);
gsl_vector_memcpy (eval, &d_vec.vector);
}
return GSL_SUCCESS;
}
}
void MCPMPChan::Run() {
/// fetch data objects
gsl_matrix_complex inmat = min1.GetDataObj();
gsl_matrix_complex cmat = min2.GetDataObj();
// inmat : input signal matrix x(n) (NxM)
// i
// complex sample at time n from Tx number i
// cmat : channel coeffs matrix h(n) (M**2xN)
// ij
// cmat matrix structure
//
// +- -+
// | h(0) . . . . h(n) | |
// | 11 11 | |
// | | | Rx1
// | h(0) . . . . h(n) | |
// | 12 12 | |
// | |
// | h(0) . . . . h(n) | |
// | 21 21 | |
// | | | Rx2
// | h(0) . . . . h(n) | |
// | 22 22 | |
// +- -+
//
// where h(n) represents the channel impulse response
// ij
//
// at time n, from tx i to rx j
// the matrix has MxM rows and N comumns.
// The (i,j) channel is locater at row i*M+j
// with i,j in the range [0,M-1] and rows counting from 0
//
//
gsl_matrix_complex_set_zero(outmat);
for (int rx=0;rx<M();rx++) { //loop through Rx
//
// csubmat creates a view on cmat extracting the MxN submatrix for Rx number u
//
gsl_matrix_complex_const_view csubmat = gsl_matrix_complex_const_submatrix(&cmat,rx*M(),0,M(),N());
//
// cut a slice of outmat
//
gsl_vector_complex_view outvec = gsl_matrix_complex_column(outmat,rx);
for (int tx=0;tx<M();tx++) { // loop through Tx
//
// input signal from tx
//
gsl_vector_complex_view x = gsl_matrix_complex_column(&inmat,tx);
gsl_vector_complex *tmp = gsl_vector_complex_alloc(N());
//
//
// extract the current tx-rx channel matrix
//
//
for (int i=0; i<N(); i++) {
gsl_complex h = gsl_matrix_complex_get(&csubmat.matrix,tx,(N()-i)%N());
for (int j=0; j<N(); j++) {
gsl_matrix_complex_set(user_chan,j,(j+i) % N(),h);
}
}
// cout << "Channel (" << tx << "-" << rx << "):" << endl;
// gsl_matrix_complex_show(user_chan);
//
// compute the signal rx = H tx
//
gsl_blas_zgemv(CblasNoTrans,
gsl_complex_rect(1.0,0),
user_chan,
&x.vector,
gsl_complex_rect(0,0),
tmp);
//
// sum for each tx
//
gsl_vector_complex_add(&outvec.vector,tmp);
gsl_vector_complex_free(tmp);
} // tx loop
for (int i=0; i< N(); i++) {
gsl_complex noisesample = gsl_complex_rect( gsl_ran_gaussian(ran,noisestd),
gsl_ran_gaussian(ran,noisestd));
gsl_complex ctmp = gsl_complex_add(gsl_vector_complex_get(&outvec.vector,i),noisesample);
gsl_vector_complex_set(&outvec.vector,i,ctmp);
}
} // rx loop
// cout << "received signals matrix (" << N() << "x" << M() << ")" << endl;
// gsl_matrix_complex_show(outmat);
//////// production of data
mout1.DeliverDataObj( *outmat );
}
void matrix_acc(gsl_matrix_complex *V,unsigned l, unsigned c, double _Complex a){
gsl_complex T1;
T1=gsl_matrix_complex_get(V,l,c);
gsl_matrix_complex_set(V,l,c,gsl_complex_add(T1,c2g(a)));
}
void vector_acc(gsl_vector_complex *V,unsigned n, double _Complex a){
gsl_complex T1;
T1=gsl_vector_complex_get(V,n);
gsl_vector_complex_set(V,n,gsl_complex_add(T1,c2g(a)));
}