JL_DLLEXPORT struct13 test_13(struct13 a, double b) {
//Unpack a nested ComplexPair{Float64} struct
if (verbose) fprintf(stderr,"%g + %g i & %g\n", creal(a.x), cimag(a.x), b);
a.x += b*1 - (b*2.0*I);
return a;
}
TEST(complex, creal) {
ASSERT_EQ(0.0, creal(0));
}
VrArrayPtrCF32 BlasComplexSingle::scal_minus(VrArrayPtrCF32 A, float complex scal) {
//scal[0]=-scal[0];
//scal[1]=-scal[1];
scal = -creal(scal) - cimag(scal)*I;
return scal_add(VR_GET_NDIMS_CF32(A), A,scal);
}
int testBSplineHAtom() {
PrintTimeStamp(PETSC_COMM_SELF, "H atom", NULL);
MPI_Comm comm = PETSC_COMM_SELF;
BPS bps; BPSCreate(comm, &bps); BPSSetExp(bps, 30.0, 61, 3.0);
int order = 5;
BSS bss; BSSCreate(comm, &bss); BSSSetKnots(bss, order, bps); BSSSetUp(bss);
Mat H; BSSCreateR1Mat(bss, &H);
Mat S; BSSCreateR1Mat(bss, &S);
Mat V; BSSCreateR1Mat(bss, &V);
BSSD2R1Mat(bss, H);
MatScale(H, -0.5);
BSSENR1Mat(bss, 0, 0.0, V);
MatAXPY(H, -1.0, V, DIFFERENT_NONZERO_PATTERN);
BSSSR1Mat(bss, S);
// -- initial space --
Pot psi0; PotCreate(comm, &psi0); PotSetSlater(psi0, 2.0, 1, 1.1);
int n_init_space = 1;
Vec *xs; PetscMalloc1(n_init_space, &xs);
MatCreateVecs(H, &xs[0], NULL);
BSSPotR1Vec(bss, psi0, xs[0]);
EEPS eps; EEPSCreate(comm, &eps);
EEPSSetOperators(eps, H, S);
// EPSSetType(eps->eps, EPSJD);
EPSSetInitialSpace(eps->eps, 1, xs);
EEPSSetTarget(eps, -0.6);
// EPSSetInitialSpace(eps->eps, 1, xs);
EEPSSolve(eps);
int nconv;
PetscScalar kr;
EPSGetConverged(eps->eps, &nconv);
ASSERT_TRUE(nconv > 0);
EPSGetEigenpair(eps->eps, 0, &kr, NULL, NULL, NULL);
ASSERT_DOUBLE_NEAR(-0.5, kr, pow(10.0, -6.0));
Vec cs;
MatCreateVecs(H, &cs, NULL);
EEPSGetEigenvector(eps, 0, cs);
PetscReal x=1.1;
PetscScalar y=0.0;
PetscScalar dy=0.0;
BSSPsiOne(bss, cs, x, &y);
BSSDerivPsiOne(bss, cs, x, &dy);
ASSERT_DOUBLE_NEAR(creal(y), 2.0*x*exp(-x), pow(10.0, -6));
ASSERT_DOUBLE_NEAR(creal(dy), 2.0*exp(-x)-2.0*x*exp(-x), pow(10.0, -6));
VecDestroy(&xs[0]);
PetscFree(xs);
PFDestroy(&psi0);
BSSDestroy(&bss);
MatDestroy(&H);
MatDestroy(&V);
MatDestroy(&S);
EEPSDestroy(&eps);
VecDestroy(&cs);
return 0;
}
double remixmatrixu_(int*id, int*i,int*j){return creal(cMixMatrixU(*id,*i,*j));}
/**
This code computes the integtated autocorrelation time :
It expects a file of length N double precision measurements
Defining c(t) = ( Y(t) - \bar{Y} )
C(T) = \sum_{t=0}^{N} ( c(t) c(t+T) )
R(T) = C(T) / C(0)
Setting a cutoff point "n"
Tau(n) = 0.5 + Nsep * \sum_{T}^{n} R(T)
We estimate the error on Tau(T) by
S_E(n) = n * \sqrt( ( 0.5 + \sum_{t}^{n} R(T) ) / N )
The computation of C(T) is performed by convolution with FFTs
The autocorrelation time is written to the file specified
*/
int
autocorrelation( const struct resampled RAW ,
const int NSEP ,
const char *output )
{
// openmp'd fftws
parallel_ffts( ) ;
if( RAW.restype != RAWDATA ) {
printf( "Resampled data is not RAW ... Cannot compute autocorrelation\n" ) ;
return FAILURE ;
}
// some constants
const int N = RAW.NSAMPLES ;
const int N2 = 2 * N ;
printf( "RAWDATA has %d samples\n" , N ) ;
printf( "Measurement separation %d\n\n" , NSEP ) ;
// allocate memory
double complex *in = calloc( N2 , sizeof( double complex ) ) ;
double complex *out = calloc( N2 , sizeof( double complex ) ) ;
// subtract the average from each data point
int i ;
#pragma omp parallel for private(i)
for( i = 0 ; i < N ; i++ ) {
in[ i ] = ( RAW.resampled[ i ] - RAW.avg ) ;
}
message( "FFT planning" ) ;
// are we doing this using openmp ffts?
#if ( defined OMP_FFTW ) && ( defined HAVE_OMP_H )
if( parallel_ffts( ) == FAILURE ) {
printf( "Parallel FFT setting failed \n" ) ;
return FAILURE ;
}
#endif
// create the plans
const fftw_plan forward = fftw_plan_dft_1d( N2 , in , out ,
FFTW_FORWARD , FFTW_ESTIMATE ) ;
const fftw_plan backward = fftw_plan_dft_1d( N2 , out , in ,
FFTW_BACKWARD , FFTW_ESTIMATE ) ;
fftw_execute( forward ) ;
// convolve
#pragma omp parallel for private(i)
for( i = 0 ; i < N2 ; i++ ) {
out[i] = creal( out[i] ) * creal( out[i] ) +
cimag( out[i] ) * cimag( out[i] ) ;
}
fftw_execute( backward ) ;
// normalise
const double zeropoint = 1.0 / in[ 0 ] ;
#pragma omp parallel for private(i)
for( i = 0 ; i < N2 ; i++ ) {
in[ i ] *= zeropoint ;
}
// summy the lags
message( "Computing tau(n)" ) ;
FILE *output_file = fopen( output , "w" ) ;
printf( "Writing tau(n) to file %s \n" , output ) ;
int n ;
for( n = 0 ; n < 30 ; n++ ) {
register double sum = 0.5 ;
int j ;
for( j = 0 ; j < n ; j++ ) {
sum += NSEP * in[j] ;
}
// simple error estimate
const double err = n * sqrt( ( sum ) / N ) ;
fprintf( output_file , "%d %e %e \n" , n * NSEP , sum , err ) ;
}
fclose( output_file ) ;
// memory free
free( in ) ;
free( out ) ;
fftw_destroy_plan(forward ) ;
fftw_destroy_plan( backward ) ;
#ifdef OMP_FFTW
// parallel
fftw_cleanup_threads( ) ;
#endif
fftw_cleanup( ) ;
return SUCCESS ;
}
//------------------------------------------------------------------------------
//void CKonst(int lmax, double *cma, double *cpa, double *cza,
// double *KmLm, double *KoLo, double *KpLM,
// double *KmlM, double *Kolo, double *Kplm){
// int i=0;
// int l, m;
// for(l=0;l<=lmax;l++){
// for(m=-l;m<=l;m++){
// cma[i]=cm(l,m);
// cza[i]=m;
// cpa[i]=cp(l,m);
// KmLm[i]=Km(l+1,m,m-1);
// KoLo[i]=Ko(l+1,m,m );
// KpLM[i]=Kp(l+1,m,m+1);
// KmlM[i]=Km(l ,m,m+1);
// Kolo[i]=Ko(l ,m,m );
// Kplm[i]=Kp(l ,m,m-1);
// i++;
// }
// }
//}
////------------------------------------------------------------------------------
//// CALCULATION OF CONSTANTS - ONE MORE LOOP - POSITION INDEPENDENT
////------------------------------------------------------------------------------
//// L DEPENDENT
//double CL[LMAX];
//double LL[LMAX];
//// CONSTANTS FOR X
//double CM[LMAX];
//double CZ[LMAX];
//double CP[LMAX];
//// CONSTANTS FOR Y AND V
//KmLm[LMAX];
//KoLo[LMAX];
//KpLM[LMAX];
//KmlM[LMAX];
//Kolo[LMAX];
//Kplm[LMAX];
//// SINGLE LOOP
//for(int l=1;l<=lmax;l++){
// for(int m=-l; m<=l; m++){
// CL[jlm(l,m)]=l;
// LL[jlm(l,m)]=2*l+1;
// CM[jlm(l,m)]=cm(l,m);
// CZ[jlm(l,m)]=m;
// CP[jlm(l,m)]=cp(l,m);
// KmLm[jlm(l,m)]=Km(l+1,m,m-1);
// KoLo[jlm(l,m)]=Ko(l+1,m,m );
// KpLM[jlm(l,m)]=Kp(l+1,m,m+1);
// KmlM[jlm(l,m)]=Km(l ,m,m+1);
// Kolo[jlm(l,m)]=Ko(l ,m,m );
// Kplm[jlm(l,m)]=Kp(l ,m,m-1);
// }
//}
//------------------------------------------------------------------------------
// POSITION DEPENDENT CALCULATIONS - MULTIPLES LOOPS - COMPLETE CALCULATIONS
//------------------------------------------------------------------------------
void VectorSphericalWaveFunctions(double *k,double *x, double *y, double *z,int *lmax,
double complex *GTE, double complex *GTM,
double complex *Em, double complex *Ez, double complex *Ep,
double complex *Hm, double complex *Hz, double complex *Hp
){
// printf("%d\t%E\t%E\t%E\t%E\n",*lmax+1,*k,*x,*y,*z);
int l,m;
int LMAX=*lmax*(*lmax+2);
int LMAXE=(*lmax+1)*(*lmax+3);
double cph;
double sph;
double rho=sqrt(*x*(*x)+*y*(*y));
double r=sqrt(rho*rho+*z*(*z));
double sth=rho/r;
double cth=*z/r;
if((*x==0)&&(*y==0)){
cph=1;
sph=0;
}else{
cph=*x/rho;
sph=*y/rho;
}
// Spherical Bessel Funtions
double JLM[*lmax+2];
// double *JLM=&JLM0[0];
gsl_sf_bessel_jl_steed_array(*lmax+1,*k*r,JLM);
/* CALCULATIONS OK
for(l=0;l<(*lmax+2);l++){
printf("%d\t%f\t%E\n",l,*k*r,JLM[l]);
}
*/
// Qlm - primeiros 4 termos
double Qlm[LMAXE];
Qlm[jlm(0, 0)]=1/sqrt(4*M_PI);
Qlm[jlm(1, 1)]=-gammaQ(1)*sth*Qlm[jlm(0,0)]; // Q11
Qlm[jlm(1, 0)]=sqrt(3.0)*cth*Qlm[jlm(0,0)]; // Q10
Qlm[jlm(1,-1)]=-Qlm[jlm(1,1)]; // Q11*(-1)
// Complex Exponencial for m=-1,0,1
double complex Eim[2*(*lmax)+3];
Eim[*lmax-1]=(cph-I*sph);
Eim[*lmax ]=1+I*0;
Eim[*lmax+1]=(cph+I*sph);
// Ylm - primeiros 4 termos
double complex Ylm[LMAXE];
Ylm[jlm(0, 0)]=Qlm[jlm(0, 0)];
Ylm[jlm(1,-1)]=Qlm[jlm(1,-1)]*Eim[*lmax-1];
Ylm[jlm(1, 0)]=Qlm[jlm(1, 0)];
Ylm[jlm(1, 1)]=Qlm[jlm(1, 1)]*Eim[*lmax+1];
/* OK jl, Qlm, Ylm
for(l=0;l<2;l++){
for(m=-l;m<=l;m++){
printf("%d\t%d\t%d\t%f\t%f\t%f+%fi\n",l,m,jlm(l,m),JLM[jlm(l,m)],Qlm[jlm(l,m)],creal(Ylm[jlm(l,m)]),cimag(Ylm[jlm(l,m)]));
}
}
printf("======================================================================\n");
*/
// VECTOR SPHERICAL HARMONICS
double complex XM; //[LMAX];
double complex XZ; //[LMAX];
double complex XP; //[LMAX];
double complex YM; //[LMAX];
double complex YZ; //[LMAX];
double complex YP; //[LMAX];
double complex VM; //[LMAX];
double complex VZ; //[LMAX];
double complex VP; //[LMAX];
// HANSEN MULTIPOLES
double complex MM; //[LMAX];
double complex MZ; //[LMAX];
double complex MP; //[LMAX];
double complex NM; //[LMAX];
double complex NZ; //[LMAX];
double complex NP; //[LMAX];
// OTHERS
double kl;
// MAIN LOOP
for(l=1;l<=(*lmax);l++){
//------------------------------------------------------------------------------
//Qlm extremos positivos um passo a frente
Qlm[jlm(l+1, l+1)]=-gammaQ(l+1)*sth*Qlm[jlm(l,l)];
Qlm[jlm(l+1, l )]= deltaQ(l+1)*cth*Qlm[jlm(l,l)];
//Qlm extremos negativos um passo a frente
Qlm[jlm(l+1,-l-1)]=pow(-1,l+1)*Qlm[jlm(l+1, l+1)];
Qlm[jlm(l+1,-l )]=pow(-1,l )*Qlm[jlm(l+1, l )];
// Exponenciais um passo a frente
Eim[*lmax+l+1]=Eim[*lmax+l]*(cph+I*sph);
Eim[*lmax-l-1]=Eim[*lmax-l]*(cph-I*sph);
// Harmonicos esfericos extremos um passo a frente
Ylm[jlm(l+1, l+1)]=Qlm[jlm(l+1, l+1)]*Eim[*lmax+l+1];
Ylm[jlm(l+1, l )]=Qlm[jlm(l+1, l )]*Eim[*lmax+l ];
Ylm[jlm(l+1,-l-1)]=Qlm[jlm(l+1,-l-1)]*Eim[*lmax-l-1];
Ylm[jlm(l+1,-l )]=Qlm[jlm(l+1,-l )]*Eim[*lmax-l ];
// others
kl=1/(sqrt(l*(l+1)));
for(m=0; m<l; m++){
// Demais valores de Qlm e Ylm
Qlm[jlm(l+1, m)]=alfaQ(l+1,m)*cth*Qlm[jlm(l,m)]-betaQ(l+1,m)*Qlm[jlm(l-1,m)];
Qlm[jlm(l+1,-m)]=pow(-1,m)*Qlm[jlm(l+1, m)];
Ylm[jlm(l+1, m)]=Qlm[jlm(l+1, m)]*Eim[*lmax+m];
Ylm[jlm(l+1,-m)]=Qlm[jlm(l+1,-m)]*Eim[*lmax-m];
}
//------------------------------------------------------------------------------
// for(m=-(l+1); m<=(l+1); m++){
// Ylm[jlm(l+1,m)]=Qlm[jlm(l+1,m)]*Eim[*lmax+m];
// }
// for(m=-l; m<=l; m++){
// printf("%d\t%d\t%d\t%f\t%f+%fi\t%f+%fi\n",l,m,jlm(l,m)+1,Qlm[jlm(l,m)],creal(Eim[*lmax+m]),cimag(Eim[*lmax+m]),creal(Ylm[jlm(l,m)]),cimag(Ylm[jlm(l,m)]));
// }
//------------------------------------------------------------------------------
for(int m=-l; m<=l; m++){
XM=kl*cm(l,m)*Ylm[jlm(l,m-1)]/sqrt(2);
XZ=kl*m*Ylm[jlm(l,m )];
XP=kl*cp(l,m)*Ylm[jlm(l,m+1)]/sqrt(2);
// printf("--------X--------------------------------\n");
printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(XM),cimag(XM));
// printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(XZ),cimag(XZ));
// printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(XP),cimag(XP));
YM=(-Kp(l,m,m-1)*Ylm[jlm(l,m-1)]+Km(l+1,m,m-1)*Ylm[jlm(l+1,m-1)])/sqrt(2);
YZ= Ko(l,m,m )*Ylm[jlm(l,m )]+Ko(l+1,m,m )*Ylm[jlm(l+1,m )];
YP=( Km(l,m,m+1)*Ylm[jlm(l,m+1)]-Kp(l+1,m,m+1)*Ylm[jlm(l+1,m+1)])/sqrt(2);
// printf("--------Y--------------------------------\n");
// printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(YM),cimag(YM));
// printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(YZ),cimag(YZ));
// printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(YP),cimag(YP));
VM=kl*(-(l+1)*Kp(l,m,m-1)*Ylm[jlm(l,m-1)]-l*Km(l+1,m,m-1)*Ylm[jlm(l+1,m-1)])/sqrt(2);
VZ=kl*( (l+1)*Ko(l,m,m )*Ylm[jlm(l,m )]-l*Ko(l+1,m,m )*Ylm[jlm(l+1,m )]);
VP=kl*( (l+1)*Km(l,m,m+1)*Ylm[jlm(l,m+1)]+l*Kp(l+1,m,m+1)*Ylm[jlm(l+1,m+1)])/sqrt(2);
// printf("--------V--------------------------------\n");
// printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(VM),cimag(VM));
// printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(VZ),cimag(VZ));
// printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(VP),cimag(VP));
// CALCULATION OF HANSEM MULTIPOLES
MM=JLM[l]*XM;
MZ=JLM[l]*XZ;
MP=JLM[l]*XP;
// printf("--------M--------------------------------\n");
// printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(MM),cimag(MM));
// printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(MZ),cimag(MZ));
// printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(MP),cimag(MP));
NM=((l+1)*JLM[l-1]-l*JLM[l+1])*VM/(2*l+1)+sqrt(l*(l+1))*JLM[l]*YM;
NZ=((l+1)*JLM[l-1]-l*JLM[l+1])*VZ/(2*l+1)+sqrt(l*(l+1))*JLM[l]*YZ;
NP=((l+1)*JLM[l-1]-l*JLM[l+1])*VP/(2*l+1)+sqrt(l*(l+1))*JLM[l]*YP;
// printf("--------N--------------------------------\n");
// printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(NM),cimag(NM));
// printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(NZ),cimag(NZ));
// printf("%d\t%d\t%d\t%f+%fi\n",l,m,jlm(l,m),creal(NP),cimag(NP));
// CALCULATION OF THE ELECTROMAGNETIC FIELDS
*Em=*Em+MM*GTE[jlm(l,m)]-NM*GTM[jlm(l,m)];
*Ez=*Ez+MZ*GTE[jlm(l,m)]-NZ*GTM[jlm(l,m)];
*Ep=*Ep+MP*GTE[jlm(l,m)]-NP*GTM[jlm(l,m)];
*Hm=*Hm+MM*GTM[jlm(l,m)]+NM*GTE[jlm(l,m)];
*Hz=*Hz+MZ*GTM[jlm(l,m)]+NZ*GTE[jlm(l,m)];
*Hp=*Hp+MP*GTM[jlm(l,m)]+NP*GTE[jlm(l,m)];
}
}
}
// exponentiate exactly a hermitian matrix "Q" into SU(NC) matrix "U"
void
exponentiate( GLU_complex U[ NCNC ] ,
const GLU_complex Q[ NCNC ] )
{
#if NC == 3
GLU_real *qq = ( GLU_real* )Q ;
const double REQ0 = *( qq + 0 ) ;
const double REQ1 = *( qq + 2 ) ;
const double IMQ1 = *( qq + 3 ) ;
const double REQ2 = *( qq + 4 ) ;
const double IMQ2 = *( qq + 5 ) ;
const double REQ4 = *( qq + 8 ) ;
const double REQ5 = *( qq + 10 ) ;
const double IMQ5 = *( qq + 11 ) ;
const double REQ8 = *( qq + 16 ) ;
// speed this up too (use determinant relation)
const double c1 = ( REQ0 * REQ0 + REQ0 * REQ4 + REQ4 * REQ4 \
+ REQ1 * REQ1 + IMQ1 * IMQ1 \
+ REQ2 * REQ2 + IMQ2 * IMQ2 \
+ REQ5 * REQ5 + IMQ5 * IMQ5 ) * OneO3 ;
//Iff c0_max < ( smallest representable double) the matrix Q is zero and its
//exponential is the identity matrix ..
if( unlikely( c1 < DBL_MIN ) ) {
*( U + 0 ) = 1. ;
*( U + 1 ) = 0. ;
*( U + 2 ) = 0. ;
*( U + 3 ) = 0. ;
*( U + 4 ) = 1. ;
*( U + 5 ) = 0. ;
*( U + 6 ) = 0. ;
*( U + 7 ) = 0. ;
*( U + 8 ) = 1. ;
return ;
}
// will write this out as it can be done cheaper
// 1/3 * tr AAA is just det( A )
// Below is a quickened determinant
double c0 = REQ0 * ( REQ4 * REQ8 \
- REQ5 * REQ5 - IMQ5 * IMQ5 ) ;
// from the middle
c0 -= REQ1 * ( REQ1 * REQ8 \
- REQ5 * REQ2 - IMQ5 * IMQ2 ) ;
c0 += IMQ1 * ( - IMQ1 * REQ8 \
+ REQ5 * IMQ2 - IMQ5 * REQ2 ) ;
// final column
c0 += REQ2 * ( - REQ4 * REQ2 \
+ REQ1 * REQ5 - IMQ1 * IMQ5 ) ;
c0 -= IMQ2 * ( REQ4 * IMQ2 \
- REQ1 * IMQ5 - IMQ1 * REQ5 ) ;
// so if c0 is negative we flip the sign ...
const double flag = c0 < 0 ? -1.0 : 1.0 ;
c0 *= flag ;
// compute the constants c0_max and the root of c1 ...
const double rc1 = sqrt( c1 ) ;
const double c0_max = 2. * rc1 * c1 ;
const double theta = acos( c0 / c0_max ) * OneO3 ;
const double ctheta = cos( theta ) ;
register const double u = rc1 * ctheta ;
register const double w = r3 * rc1 * sin( theta ) ;
const double uu = u * u , ww = w * w , cw = cos( w ) ;
const double denom = 1.0 / ( 9. * uu - ww ) ;
const double cu = cos( u ) ;
const double su = sin( u ) ;
// and I thought double angle formulas were useless!
//double complex one , two ;
const double complex one = cu - I * su ;
double complex two = conj( one ) ; //cu + I * su ;
two *= two ;
// taylor expand if getting toward the numerically unstable end
const double E0 = fabs( w ) < SINTOL ? ( 1 - ww / 6. * ( 1 - ww / 20. * ( 1 - ww / 42. ) ) ) : sin( w ) / w ;
double complex f0 = ( uu - ww ) * two + one * ( 8. * uu * cw + 2. * I * u * ( 3. * uu + ww ) * E0 ) ;
double complex f1 = 2. * u * two - one * ( 2. * u * cw - I * ( 3. * uu - ww ) * E0 ) ;
double complex f2 = two - one * ( cw + 3. * I * u * E0 ) ;
f0 = denom * ( creal( f0 ) + I * cimag( f0 ) * flag ) ;
f1 = denom * ( flag * creal( f1 ) + I * cimag( f1 ) ) ;
f2 = denom * ( creal( f2 ) + I * cimag( f2 ) * flag ) ;
// QQ[0].
const double temp0 = REQ0 * REQ0 + REQ1 * REQ1 + \
IMQ1 * IMQ1 + REQ2 * REQ2 + IMQ2 * IMQ2 ;
// QQ[1]
const double complex temp1 = -REQ1 * ( REQ8 ) + REQ2 * REQ5 + IMQ2 * IMQ5
+ I * ( REQ5 * IMQ2 - REQ2 * IMQ5 - IMQ1 * REQ8 ) ;
// QQ[2]
const double complex temp2 = REQ1 * REQ5 - IMQ1 * IMQ5 - REQ2 * REQ4 +
I * ( IMQ1 * REQ5 + IMQ5 * REQ1 - IMQ2 * REQ4 ) ;
// QQ[4]
const double temp3 = REQ4 * REQ4 + REQ1 * REQ1 \
+ IMQ1 * IMQ1 + REQ5 * REQ5 + IMQ5 * IMQ5 ;
// QQ[5]
const double complex temp4 = REQ1 * REQ2 + IMQ2 * IMQ1 - REQ0 * REQ5 +
I * ( REQ1 * IMQ2 - REQ2 * IMQ1 - REQ0 * IMQ5 ) ;
// QQ[8]
const double temp5 = REQ8 * REQ8 + REQ2 * REQ2 + \
IMQ2 * IMQ2 + REQ5 * REQ5 + IMQ5 * IMQ5 ;
// U = f0I + f1 Q + f2 QQ
*( U + 0 ) = f0 + f1 * REQ0 + f2 * temp0 ;
*( U + 1 ) = f1 * Q[1] + f2 * temp1 ;
*( U + 2 ) = f1 * Q[2] + f2 * temp2 ;
//
*( U + 3 ) = f1 * Q[3] + f2 * conj( temp1 ) ;
*( U + 4 ) = f0 + f1 * REQ4 + f2 * temp3 ;
*( U + 5 ) = f1 * Q[5] + f2 * temp4 ;
//
*( U + 6 ) = f1 * Q[6] + f2 * conj( temp2 ) ;
*( U + 7 ) = f1 * Q[7] + f2 * conj( temp4 ) ;
*( U + 8 ) = f0 + f1 * REQ8 + f2 * temp5 ;
#elif NC == 2
double f0 , f1 ; // f1 is purely imaginary
// eigenvalues are pretty simple +/- sqrt( |a|^2 + |b|^2 ) Only need one
const double z = sqrt( creal( Q[0] ) * creal( Q[0] ) + \
creal( Q[1] ) * creal( Q[1] ) + \
cimag( Q[1] ) * cimag( Q[1] ) ) ;
// have eigenvalues, now for the "fun" bit.
f0 = cos( z ) ;
// taylor expand
f1 = fabs ( z ) < SINTOLSU2 ? ( 1 - z / 6. * ( 1 - z / 20. * ( 1 - z / 42. ) ) ) : sin( z ) / z ;
const double complex f1Q0 = I * f1 * creal( Q[0] ) ;
const double complex f1Q1 = I * f1 * Q[1] ;
*( U + 0 ) = (GLU_complex)( f0 + f1Q0 ) ;
*( U + 1 ) = (GLU_complex)( f1Q1 ) ;
*( U + 2 ) = (GLU_complex)( -conj( f1Q1 ) ) ;
*( U + 3 ) = (GLU_complex)( f0 - f1Q0 ) ;
#else
// hmmm could be a toughy
#if ( defined HAVE_LAPACKE_H || defined HAVE_GSL )
double complex f[ NC ] ;
double z[ NC ] ;
Eigenvalues_hermitian( z , Q ) ;
calculate_effs_VDM_herm( f , z ) ;
// matrix expansion reversing horner's rule
int i , j ;
diag( U , f[ NC - 1 ] ) ;
for( i = NC-1 ; i > 0 ; i-- ) {
multab_atomic_left( U , Q ) ; // left multiply U with Q
for( j = 0 ; j < NC ; j++ ) { U[ j*(NC+1) ] += f[ i-1 ] ; }
}
#else
// exponentiate routine from stephan durr's paper
// Performs the nesting
// U = ( exp{ A / DIV^n ) ) ^ ( DIV * n )
GLU_complex EOLD[ NCNC ] GLUalign , SN[ NCNC ] GLUalign ;
GLU_complex RN_MIN[ NCNC ] GLUalign , RN[ NCNC ] GLUalign ;
// set to zero
zero_mat( EOLD ) ;
// set up the divisor and the minimum
double sum = 0.0 ;
size_t j , n ;
const int nmin = 3 ;
// use precomputed factorials
for( n = nmin ; n < 10 ; n++ ) {
// compute the multiplicative factor ...
const int iter = 2 << ( n - 1 ) ;
const GLU_complex fact = I / (GLU_real)iter ;
// and the rational approximations
#ifdef USE_PADE
for( j = 0 ; j < NCNC ; j++ ) { SN[ j ] = ( Q[j] * fact ) ; }
horners_pade( RN , SN ) ;
for( j = 0 ; j < NCNC ; j++ ) { SN[ j ] *= -1.0 ; }
horners_pade( RN_MIN , SN ) ;
#else
for( j = 0 ; j < NCNC ; j++ ) { SN[ j ] = ( Q[j] * fact ) / 2.0 ; }
horners_exp( RN , SN , 14 ) ;
for( j = 0 ; j < NCNC ; j++ ) { SN[ j ] *= -1.0 ; }
horners_exp( RN_MIN , SN , 14 ) ;
#endif
inverse( SN , RN_MIN ) ; // uses our numerical inverse
multab_atomic_right( RN , SN ) ; // gets the correct rational approx
// and remove the nested scalings ...
matrix_power( U , RN , iter ) ; // uses a fast-power like routine
// for the convergence criteria, I use the absolute difference between
// evaluations
sum = 0.0 ;
for( j = 0 ; j < NCNC ; j++ ) {
sum += (double)cabs( EOLD[j] - U[j] ) ;
EOLD[ j ] = U[ j ] ;
}
sum /= NCNC ;
// convergence ....
if( sum < PREC_TOL ) { break ; }
// warning for non-convergence ..
if( n >= ( MAX_FACTORIAL - 1 ) ) {
printf( "[EXPONENTIAL] not converging .. %zu %e \n" , n , sum ) ;
break ;
}
}
// gramschmidt orthogonalisation just to make sure
// has been seen to help preserve gauge invariance of log smearing
gram_reunit( U ) ;
#endif
#endif
return ;
}
// exactly the same as above , just calculates the f-functions in-step instead of requiring them
// takes a shortened, Hermitian Q and gives back the SU(NC) matrix U
void
exponentiate_short( GLU_complex U[ NCNC ] ,
const GLU_complex Q[ HERMSIZE ] )
{
#if NC == 3
GLU_real *qq = ( GLU_real* )Q ;
const double REQ0 = *( qq + 0 ) ;
const double REQ1 = *( qq + 2 ) ;
const double IMQ1 = *( qq + 3 ) ;
const double REQ2 = *( qq + 4 ) ;
const double IMQ2 = *( qq + 5 ) ;
const double REQ4 = *( qq + 6 ) ;
const double REQ5 = *( qq + 8 ) ;
const double IMQ5 = *( qq + 9 ) ;
const double REQ8 = -( REQ0 + REQ4 ) ;
const double c1 = ( REQ0 * -REQ8 + REQ4 * REQ4 \
+ REQ1 * REQ1 + IMQ1 * IMQ1 \
+ REQ2 * REQ2 + IMQ2 * IMQ2 \
+ REQ5 * REQ5 + IMQ5 * IMQ5 ) * OneO3 ;
// Iff c0_max < ( smallest representable double) the matrix Q is zero and its
// exponential is the identity matrix .
if( unlikely( c1 < DBL_MIN ) ) {
*( U + 0 ) = 1. ;
*( U + 1 ) = 0. ;
*( U + 2 ) = 0. ;
//
*( U + 3 ) = 0. ;
*( U + 4 ) = 1. ;
*( U + 5 ) = 0. ;
//
*( U + 6 ) = 0. ;
*( U + 7 ) = 0. ;
*( U + 8 ) = 1. ;
return ;
}
// 1/3 * tr AAA is just det( A )
// Below is a quickened determinant
double c0 = REQ0 * ( REQ4 * REQ8 \
- REQ5 * REQ5 - IMQ5 * IMQ5 ) ;
// from the middle
c0 -= REQ1 * ( REQ1 * REQ8 \
- REQ5 * REQ2 - IMQ5 * IMQ2 ) ;
c0 += IMQ1 * ( - IMQ1 * REQ8 \
+ REQ5 * IMQ2 - IMQ5 * REQ2 ) ;
// final column
c0 += REQ2 * ( - REQ4 * REQ2 \
+ REQ1 * REQ5 - IMQ1 * IMQ5 ) ;
c0 -= IMQ2 * ( REQ4 * IMQ2 \
- REQ1 * IMQ5 - IMQ1 * REQ5 ) ;
// so if c0 is negative we flip the sign ...
const double flag = c0 < 0 ? -1.0 : 1.0 ;
c0 *= flag ;
// compute the constants c0_max and the root of c1 ...
const double rc1 = sqrt( c1 ) ;
const double c0_max = 2. * rc1 * c1 ;
const double theta = acos( c0 / c0_max ) * OneO3 ;
const double ctheta = cos( theta ) ;
register const double u = rc1 * ctheta ;
register const double w = r3 * rc1 * sin( theta ) ;
const double uu = u * u , ww = w * w , cw = cos( w ) ;
const double denom = 1.0 / ( 9. * uu - ww ) ;
const double cu = cos( u ) ;
const double su = sin( u ) ;
const double complex one = cu - I * su ;
double complex two = conj( one ) ;
two *= two ;
// taylor expand if getting toward the numerically unstable end
const double E0 = fabs( w ) < SINTOL ? ( 1 - ww / 6. * ( 1 - ww / 20. * ( 1 - ww / 42. ) ) ) : sin( w ) / w ;
double complex f0 = ( uu - ww ) * two + one * ( 8 * uu * cw + 2 * I * u * ( 3 * uu + ww ) * E0 ) ;
double complex f1 = 2. * u * two - one * ( 2. * u * cw - I * ( 3 * uu - ww ) * E0 ) ;
double complex f2 = two - one * ( cw + 3 * I * u * E0 ) ;
f0 = ( creal( f0 ) + I * cimag( f0 ) * flag ) ;
f1 = ( flag * creal( f1 ) + I * cimag( f1 ) ) ;
f2 = ( creal( f2 ) + I * cimag( f2 ) * flag ) ;
f0 *= denom ;
f1 *= denom ;
f2 *= denom ;
// QQ[0].
const double temp0 = REQ0 * REQ0 + REQ1 * REQ1 + \
IMQ1 * IMQ1 + REQ2 * REQ2 + IMQ2 * IMQ2 ;
// QQ[1]
const double complex temp1 = -REQ1 * ( REQ8 ) + REQ2 * REQ5 + IMQ2 * IMQ5
+ I * ( REQ5 * IMQ2 - REQ2 * IMQ5 - IMQ1 * REQ8 ) ;
// QQ[2]
const double complex temp2 = REQ1 * REQ5 - IMQ1 * IMQ5 - REQ2 * REQ4 +
I * ( IMQ1 * REQ5 + IMQ5 * REQ1 - IMQ2 * REQ4 ) ;
// QQ[4]
const double temp3 = REQ4 * REQ4 + REQ1 * REQ1 \
+ IMQ1 * IMQ1 + REQ5 * REQ5 + IMQ5 * IMQ5 ;
// QQ[5]
const double complex temp4 = REQ1 * REQ2 + IMQ2 * IMQ1 - REQ0 * REQ5 +
I * ( REQ1 * IMQ2 - REQ2 * IMQ1 - REQ0 * IMQ5 ) ;
// QQ[8]
const double temp5 = REQ8 * REQ8 + REQ2 * REQ2 + \
IMQ2 * IMQ2 + REQ5 * REQ5 + IMQ5 * IMQ5 ;
//can really speed this up
*( U + 0 ) = f0 + f1 * REQ0 + f2 * temp0 ;
*( U + 1 ) = f1 * Q[1] + f2 * temp1 ;
*( U + 2 ) = f1 * Q[2] + f2 * temp2 ;
//
*( U + 3 ) = f1 * conj( Q[1] ) + f2 * conj( temp1 ) ;
*( U + 4 ) = f0 + f1 * REQ4 + f2 * temp3 ;
*( U + 5 ) = f1 * Q[4] + f2 * temp4 ;
//
*( U + 6 ) = f1 * conj( Q[2] ) + f2 * conj( temp2 ) ;
*( U + 7 ) = f1 * conj( Q[4] ) + f2 * conj( temp4 ) ;
*( U + 8 ) = f0 + f1 * REQ8 + f2 * temp5 ;
#elif NC == 2
double f0 , f1 ; // f1 is purely imaginary
// eigenvalues are pretty simple +/- sqrt( |a|^2 + |b|^2 ) Only need one
const double z = sqrt( creal( Q[0] ) * creal( Q[0] ) + \
creal( Q[1] ) * creal( Q[1] ) + \
cimag( Q[1] ) * cimag( Q[1] ) ) ;
// have eigenvalues, now for the "fun" bit.
f0 = cos( z ) ;
// taylor expand
f1 = fabs ( z ) < SINTOLSU2 ? ( 1.0 - z / 6. * ( 1 - z / 20. * ( 1 - z / 42. ) ) ) : sin( z ) / z ;
const double complex f1Q0 = I * f1 * Q[0] ;
const double complex f1Q1 = I * f1 * Q[1] ;
*( U + 0 ) = (GLU_complex)( f0 + f1Q0 ) ;
*( U + 1 ) = (GLU_complex)( f1Q1 ) ;
*( U + 2 ) = (GLU_complex)( -conj( f1Q1 ) ) ;
*( U + 3 ) = (GLU_complex)( f0 - f1Q0 ) ;
#else
// hmmm could be a toughy, wrap to exponentiate
GLU_complex temp[ NCNC ] GLUalign ;
rebuild_hermitian( temp , Q ) ;
exponentiate( U , temp ) ;
#endif
return ;
}
cmplxd cerfc(cmplxd x)
{
static const double pv= 1.27813464856668857e+01;
static const double ph= 6.64067324283344283e+00;
static const double p0= 2.94608570191793668e-01;
static const double p1= 1.81694307871527086e-01;
static const double p2= 6.91087778921425355e-02;
static const double p3= 1.62114197106901582e-02;
static const double p4= 2.34533471539159422e-03;
static const double p5= 2.09259199579049675e-04;
static const double p6= 1.15149016557480535e-05;
static const double p7= 3.90779571296927748e-07;
static const double p8= 8.17898509247247602e-09;
static const double p9= 1.05575446466983499e-10;
static const double p10= 8.40470321453263734e-13;
static const double p11= 4.12646136715431977e-15;
static const double p12= 1.24947948599560084e-17;
static const double q0= 6.04152433382652546e-02;
static const double q1= 5.43737190044387291e-01;
static const double q2= 1.51038108345663136e+00;
static const double q3= 2.96034692357499747e+00;
static const double q4= 4.89363471039948562e+00;
static const double q5= 7.31024444393009580e+00;
static const double q6= 1.02101761241668280e+01;
static const double q7= 1.35934297511096823e+01;
static const double q8= 1.74600053247586586e+01;
static const double q9= 2.18099028451137569e+01;
static const double q10= 2.66431223121749773e+01;
static const double q11= 3.19596637259423197e+01;
static const double q12= 3.77595270864157841e+01;
static const double r0= 1.56478036351085356e-01;
static const double r1= 2.45771407110492625e-01;
static const double r2= 1.19035163906534275e-01;
static const double r3= 3.55561834455977740e-02;
static const double r4= 6.55014550718381002e-03;
static const double r5= 7.44188068433574137e-04;
static const double r6= 5.21447276257559040e-05;
static const double r7= 2.25337799750608244e-06;
static const double r8= 6.00556181041662576e-08;
static const double r9= 9.87118243564461826e-10;
static const double r10= 1.00064645539515792e-11;
static const double r11= 6.25587539334288736e-14;
static const double r12= 2.41207864479170276e-16;
static const double s1= 2.41660973353061018e-01;
static const double s2= 9.66643893412244073e-01;
static const double s3= 2.17494876017754917e+00;
static const double s4= 3.86657557364897629e+00;
static const double s5= 6.04152433382652546e+00;
static const double s6= 8.69979504071019666e+00;
static const double s7= 1.18413876942999899e+01;
static const double s8= 1.54663022945959052e+01;
static const double s9= 1.95745388415979425e+01;
static const double s10= 2.41660973353061018e+01;
static const double s11= 2.92409777757203832e+01;
static const double s12= 3.47991801628407866e+01;
cmplxd y=x*x;
if(cabs(creal(x))+cabs(cimag(x)) < ph) {
const cmplxd z=cexp(pv*x);
if(creal(z) >= 0.) {
y = cexp(-y)*x*(p12/(y+q12)+p11/(y+q11)
+p10/(y+q10)+p9/(y+q9)+p8/(y+q8)+p7/(y+q7)
+p6/(y+q6)+p5/(y+q5)+p4/(y+q4)+p3/(y+q3)
+p2/(y+q2)+p1/(y+q1)+p0/(y+q0))+2./(1.+z);
} else {
y = cexp(-y)*x*(r12/(y+s12)+r11/(y+s11)
+r10/(y+s10)+r9/(y+s9)+r8/(y+s8)+r7/(y+s7)
+r6/(y+s6)+r5/(y+s5)+r4/(y+s4)+r3/(y+s3)
+r2/(y+s2)+r1/(y+s1)+r0/y)+2./(1.-z);
}
} else {
y = cexp(-y)*x*(p12/(y+q12)+p11/(y+q11)
+p10/(y+q10)+p9/(y+q9)+p8/(y+q8)+p7/(y+q7)
+p6/(y+q6)+p5/(y+q5)+p4/(y+q4)+p3/(y+q3)
+p2/(y+q2)+p1/(y+q1)+p0/(y+q0));
if(creal(x) <= 0) y=y+2.;
}
return y;
}
/** Compare two COMPLEX8 vectors using various different comparison metrics
*/
int
XLALCompareCOMPLEX8Vectors ( VectorComparison *result, ///< [out] return comparison results
const COMPLEX8Vector *x, ///< [in] first input vector
const COMPLEX8Vector *y, ///< [in] second input vector
const VectorComparison *tol ///< [in] accepted tolerances on comparisons, or NULL for no check
)
{
XLAL_CHECK ( result != NULL, XLAL_EINVAL );
XLAL_CHECK ( x != NULL, XLAL_EINVAL );
XLAL_CHECK ( y != NULL, XLAL_EINVAL );
XLAL_CHECK ( x->data != NULL, XLAL_EINVAL );
XLAL_CHECK ( y->data != NULL, XLAL_EINVAL );
XLAL_CHECK ( x->length > 0, XLAL_EINVAL );
XLAL_CHECK ( x->length == y->length, XLAL_EINVAL );
REAL8 x_L1 = 0, x_L2 = 0;
REAL8 y_L1 = 0, y_L2 = 0;
REAL8 diff_L1 = 0, diff_L2 = 0;
COMPLEX16 scalar = 0;
REAL8 maxAbsx = 0, maxAbsy = 0;
COMPLEX8 x_atMaxAbsx = 0, y_atMaxAbsx = 0;
COMPLEX8 x_atMaxAbsy = 0, y_atMaxAbsy = 0;
UINT4 numSamples = x->length;
for ( UINT4 i = 0; i < numSamples; i ++ )
{
COMPLEX8 x_i = x->data[i];
COMPLEX8 y_i = y->data[i];
REAL8 xAbs_i = cabs ( x_i );
REAL8 yAbs_i = cabs ( y_i );
XLAL_CHECK ( isfinite ( xAbs_i ), XLAL_EFPINVAL, "non-finite element: x(%d) = %g + I %g\n", i, crealf(x_i), cimagf(x_i) );
XLAL_CHECK ( isfinite ( yAbs_i ), XLAL_EFPINVAL, "non-finite element: y(%d) = %g + I %g\n", i, crealf(y_i), cimagf(y_i) );
REAL8 absdiff = cabs ( x_i - y_i );
diff_L1 += absdiff;
diff_L2 += SQ(absdiff);
x_L1 += xAbs_i;
y_L1 += yAbs_i;
x_L2 += SQ(xAbs_i);
y_L2 += SQ(yAbs_i);
scalar += x_i * conj(y_i);
if ( xAbs_i > maxAbsx ) {
maxAbsx = xAbs_i;
x_atMaxAbsx = x_i;
y_atMaxAbsx = y_i;
}
if ( yAbs_i > maxAbsy ) {
maxAbsy = yAbs_i;
x_atMaxAbsy = x_i;
y_atMaxAbsy = y_i;
}
} // for i < numSamples
// complete L2 norms by taking sqrt
x_L2 = sqrt ( x_L2 );
y_L2 = sqrt ( y_L2 );
diff_L2 = sqrt ( diff_L2 );
// compute and return comparison results
result->relErr_L1 = diff_L1 / ( 0.5 * (x_L1 + y_L1 ) );
result->relErr_L2 = diff_L2 / ( 0.5 * (x_L2 + y_L2 ) );
REAL8 cosTheta = fmin ( 1, creal ( scalar ) / (x_L2 * y_L2) );
result->angleV = acos ( cosTheta );
result->relErr_atMaxAbsx = cRELERR ( x_atMaxAbsx, y_atMaxAbsx );
result->relErr_atMaxAbsy = cRELERR ( x_atMaxAbsy, y_atMaxAbsy );;
XLAL_CHECK ( XLALCheckVectorComparisonTolerances ( result, tol ) == XLAL_SUCCESS, XLAL_EFUNC );
return XLAL_SUCCESS;
} // XLALCompareCOMPLEX8Vectors()
// stationary covariance for Complex eigenvalues
static void simmap_covar_matrix_complex (int *nchar,
double *bt,
Rcomplex *lambda_val,
Rcomplex *S_val,
Rcomplex *S1_val,
double *sigmasq,
int *nterm,
double *V) {
// complex version
double complex *eltj, *elti, *W, *U, *tmp1, *lambda, *S, *S1;
double sij, ti, tj, tmp2;
int n = *nchar, nt = *nterm;
int i, j, k, l, r, s;
// alloc complex vectors
U = Calloc(n*n,double complex);
W = Calloc(n*n,double complex);
tmp1 = Calloc(n*n,double complex);
eltj = Calloc(n,double complex);
elti = Calloc(n,double complex);
S = Calloc(n*n,double complex);
S1 = Calloc(n*n,double complex);
lambda = Calloc(n,double complex);
//zeroing vectors & transform to C complex structure
for(i = 0; i<n; i++){
lambda[i]=comp(lambda_val[i]);
for(j =0; j<n; j++){
S[i+j*n]=comp(S_val[i+j*n]);
S1[i+j*n]=comp(S1_val[i+j*n]);
U[i+j*n] = 0;
W[i+j*n] = 0;
}
}
// computing the P^-1%*%Sigma%*%P^-T
for (i = 0; i < n; i++) {
for (j = 0; j < n; j++) {
for (k = 0; k < n; k++) {
for (l = 0; l < n; l++) {
U[i+j*n] += S1[i+k*n]*sigmasq[k+l*n]*S1[j+l*n];
}
}
}
}
// fill in the covariance
for (i = 0; i < nt; i++) {
for (j = 0; j <= i; j++) {
ti = bt[i+i*nt];
sij = bt[i+j*nt];
tj = bt[j+j*nt];
// complex exponential with time
for (k = 0; k < n; k++) {
elti[k] = cexp(-lambda[k]*(ti-sij));
eltj[k] = cexp(-lambda[k]*(tj-sij));
}
// Integral parts
for (k = 0; k < n; k++) {
for (l = 0; l < n; l++) {
W[k+l*n] = elti[k]*U[k+l*n]*eltj[l]/(lambda[k]+lambda[l]);
}
}
// computing the P%*%Sigma%*%P^T
for (r = 0; r < n; r++) {
for (s = 0; s < n; s++) {
tmp1[r+s*n] = 0;
for (k = 0; k < n; k++) {
for (l = 0; l < n; l++) {
tmp1[r+s*n] += S[r+k*n]*W[k+l*n]*S[s+l*n];
}
}
}
}
for (k = 0; k < n; k++) {
for (l = 0; l < n; l++) {
// Save the real parts
tmp2 = creal(tmp1[k+l*n]);
V[i+nt*(k+n*(j+nt*l))] = tmp2;
if (j != i)
V[j+nt*(l+n*(i+nt*k))] = tmp2;
}
}
// End
}
}
Free(lambda);
Free(S);
Free(S1);
Free(U);
Free(W);
Free(tmp1);
Free(elti);
Free(eltj);
}
JL_DLLEXPORT complex float *cfptest(complex float *a) {
//Unpack a ComplexPair{Float64} struct
if (verbose) fprintf(stderr,"%g + %g i\n", creal(*a), cimag(*a));
*a += 1 - (2.0*I);
return a;
}
JL_DLLEXPORT complex float cftest(complex float a) {
//Unpack a ComplexPair{Float32} struct
if (verbose) fprintf(stderr,"%g + %g i\n", creal(a), cimag(a));
a += 1 - (2.0*I);
return a;
}
Geometry CreateGeometry(int N[3], double h[3], int Npml[3], int Nc, int LowerPML, double *eps, double *epsI, double *fprof, double wa, double y){
int i;
Geometry geo = (Geometry) malloc(sizeof(struct Geometry_s));
geo->Nc = Nc;
geo->LowerPML = LowerPML;
geo->interference = 0.0; // default no interference
for(i=0; i<3; i++){
geo->h[i] = h[i];
geo->Npml[i] = Npml[i];
}
CreateGrid(&geo->gN, N, geo->Nc, 2);
CreateGrid(&geo->gM, N, 1, 1); // 3/3/14: set M = N as per Steven
CreateVec(2*Nxyzc(geo)+2, &geo->vepspml);
int manual_epspml = 0;
PetscOptionsGetInt(PETSC_NULL,PETSC_NULL,"-manual_epspml", &manual_epspml, NULL);
if(manual_epspml == 0){
Vecfun pml;
CreateVecfun(&pml,geo->vepspml);
for(i=pml.ns; i<pml.ne; i++){
Point p;
CreatePoint_i(&p, i, &geo->gN);
project(&p, 3);
dcomp eps_geoal;
eps_geoal = pmlval(xyzc(&p), N, geo->Npml, geo->h, geo->LowerPML, 0);
setr(&pml, i, p.ir? cimag(eps_geoal) : creal(eps_geoal) );
}
DestroyVecfun(&pml);
}
CreateVec(Mxyz(geo), &geo->vMscratch[0]);
for(i=0; i<SCRATCHNUM; i++){
geo->vNhscratch[i] = 0; // allows checking whether vN created or not
if(i>0)VecDuplicate(geo->vMscratch[0], &geo->vMscratch[i]);
}
double *scratch;
int ms, me;
VecGetOwnershipRange(geo->vMscratch[0], &ms, &me);
if( !manual_epspml){
VecGetArray(geo->vMscratch[0], &scratch);
for(i=ms; i<me;i++)
scratch[i-ms] = eps[i-ms];
VecRestoreArray(geo->vMscratch[0], &scratch);
}
CreateVec(2*Nxyzc(geo)+2, &geo->vH);
VecDuplicate(geo->vH, &geo->veps);
VecDuplicate(geo->vH, &geo->vIeps);
for(i=0; i<SCRATCHNUM; i++) VecDuplicate(geo->vH, &geo->vscratch[i]);
VecSet(geo->vH, 1.0);
if( !manual_epspml){
VecShift(geo->vMscratch[0], -1.0); //hack, for background dielectric
InterpolateVec(geo, geo->vMscratch[0], geo->vscratch[1]);
VecShift(geo->vscratch[1], 1.0);
VecPointwiseMult(geo->veps, geo->vscratch[1], geo->vepspml);
if(epsI != NULL){ // imaginary part of passive dielectric
VecGetArray(geo->vMscratch[0], &scratch);
for(i=ms; i<me; i++){
scratch[i-ms] = epsI[i-ms];
}
VecRestoreArray(geo->vMscratch[0], &scratch);
InterpolateVec(geo, geo->vMscratch[0], geo->vscratch[1]);
VecPointwiseMult(geo->vscratch[1], geo->vscratch[1], geo->vepspml);
TimesI(geo, geo->vscratch[1], geo->vscratch[2]);
VecAXPY(geo->veps, 1.0, geo->vscratch[2]);
}
}
if(manual_epspml){
char epsManualfile[PETSC_MAX_PATH_LEN];
PetscOptionsGetString(PETSC_NULL,PETSC_NULL,"-epsManualfile", epsManualfile, PETSC_MAX_PATH_LEN, NULL);
FILE *fp = fopen(epsManualfile, "r");
ReadVectorC(fp, 2*Nxyzc(geo)+2, geo->veps);
// 07/11/15: if manual_epspml, then directly read in the Nxyzcr+2 vector
fclose(fp);
}
TimesI(geo, geo->veps, geo->vIeps);
// vIeps for convenience only, make sure to update it later if eps ever changes!
geo->D = 0.0;
geo->wa = wa;
geo->y = y;
VecDuplicate(geo->veps, &geo->vf);
VecDuplicate(geo->vMscratch[0], &geo->vfM);
VecGetArray(geo->vfM, &scratch);
for(i=ms; i<me;i++)
scratch[i-ms] = fprof[i-ms];
VecRestoreArray(geo->vfM, &scratch);
InterpolateVec(geo, geo->vfM, geo->vf);
return geo;
}
int
main(void)
{
const int n = 1000;
int i;
double _Complex vresult, result, array[n];
bool lvresult, lresult;
for (i = 0; i < n; i++)
array[i] = i;
result = 0;
vresult = 0;
/* '+' reductions. */
#pragma acc parallel vector_length (vl)
#pragma acc loop reduction (+:result)
for (i = 0; i < n; i++)
result += array[i];
/* Verify the reduction. */
for (i = 0; i < n; i++)
vresult += array[i];
if (result != vresult)
abort ();
result = 0;
vresult = 0;
/* Needs support for complex multiplication. */
// /* '*' reductions. */
// #pragma acc parallel vector_length (vl)
// #pragma acc loop reduction (*:result)
// for (i = 0; i < n; i++)
// result *= array[i];
//
// /* Verify the reduction. */
// for (i = 0; i < n; i++)
// vresult *= array[i];
//
// if (fabs(result - vresult) > .0001)
// abort ();
// result = 0;
// vresult = 0;
// /* 'max' reductions. */
// #pragma acc parallel vector_length (vl)
// #pragma acc loop reduction (+:result)
// for (i = 0; i < n; i++)
// result = result > array[i] ? result : array[i];
//
// /* Verify the reduction. */
// for (i = 0; i < n; i++)
// vresult = vresult > array[i] ? vresult : array[i];
//
// printf("%d != %d\n", result, vresult);
// if (result != vresult)
// abort ();
//
// result = 0;
// vresult = 0;
//
// /* 'min' reductions. */
// #pragma acc parallel vector_length (vl)
// #pragma acc loop reduction (+:result)
// for (i = 0; i < n; i++)
// result = result < array[i] ? result : array[i];
//
// /* Verify the reduction. */
// for (i = 0; i < n; i++)
// vresult = vresult < array[i] ? vresult : array[i];
//
// printf("%d != %d\n", result, vresult);
// if (result != vresult)
// abort ();
result = 5;
vresult = 5;
lresult = false;
lvresult = false;
/* '&&' reductions. */
#pragma acc parallel vector_length (vl)
#pragma acc loop reduction (&&:lresult)
for (i = 0; i < n; i++)
lresult = lresult && (creal(result) > creal(array[i]));
/* Verify the reduction. */
for (i = 0; i < n; i++)
lvresult = lresult && (creal(result) > creal(array[i]));
if (lresult != lvresult)
abort ();
result = 5;
vresult = 5;
lresult = false;
lvresult = false;
/* '||' reductions. */
#pragma acc parallel vector_length (vl)
#pragma acc loop reduction (||:lresult)
for (i = 0; i < n; i++)
lresult = lresult || (creal(result) > creal(array[i]));
/* Verify the reduction. */
for (i = 0; i < n; i++)
lvresult = lresult || (creal(result) > creal(array[i]));
if (lresult != lvresult)
abort ();
return 0;
}
static void
fftMeasure (int nframes, int overlap, float *indata)
{
#ifdef USE_FFTW
int i, stepSize = fftSize/overlap;
double freqPerBin = rate/(double)fftSize,
phaseDifference = 2.*M_PI*(double)stepSize/(double)fftSize;
if (!fftSample) fftSample = fftSampleBuffer + (fftSize-stepSize);
// bzero(fftGraphData.db, GRAPH_MAX_FREQ);
for (i=0; i<nframes; i++) {
*fftSample++ = indata[i];
if (fftSample-fftSampleBuffer >= fftSize) {
int k;
Peak peaks[MAX_PEAKS];
for (k=0; k<MAX_PEAKS; k++) {
peaks[k].db = -200.;
peaks[k].freq = 0.;
}
fftSample = fftSampleBuffer + (fftSize-stepSize);
for (k=0; k<fftSize; k++) {
double window = -.5*cos(2.*M_PI*(double)k/(double)fftSize)+.5;
fftIn[k] = fftSampleBuffer[k] * window;
}
fftwf_execute(fftPlan);
for (k=0; k<=fftSize/2; k++) {
long qpd;
float
real = creal(fftOut[k]),
imag = cimag(fftOut[k]),
magnitude = 20.*log10(2.*sqrt(real*real + imag*imag)/fftSize),
phase = atan2(imag, real),
tmp, freq;
/* compute phase difference */
tmp = phase - fftLastPhase[k];
fftLastPhase[k] = phase;
/* subtract expected phase difference */
tmp -= (double)k*phaseDifference;
/* map delta phase into +/- Pi interval */
qpd = tmp / M_PI;
if (qpd >= 0) qpd += qpd&1;
else qpd -= qpd&1;
tmp -= M_PI*(double)qpd;
/* get deviation from bin frequency from the +/- Pi interval */
tmp = overlap*tmp/(2.*M_PI);
/* compute the k-th partials' true frequency */
freq = (double)k*freqPerBin + tmp*freqPerBin;
#ifdef USE_GRAPH
int fi = (int)round(freq);
if (fi < GRAPH_MAX_FREQ) {
fftGraphData.db[fi] = magnitude;
if (magnitude > fftGraphData.dbMax)
fftGraphData.dbMax = magnitude;
if (magnitude < fftGraphData.dbMin)
fftGraphData.dbMin = magnitude;
}
/*
printf("%+8.3f % .5f %i\n", freq, fftGraphData.scale_freq,
(int)round(freq * fftGraphData.scale_freq));
*/
#endif
if (freq > 0.0 && magnitude > peaks[0].db) {
memmove(peaks+1, peaks, sizeof(Peak)*(MAX_PEAKS-1));
peaks[0].freq = freq;
peaks[0].db = magnitude;
}
}
fftFrameCount++;
if (fftFrameCount > 0 && fftFrameCount % overlap == 0) {
int l, maxharm = 0;
k = 0;
for (l=1; l<MAX_PEAKS && peaks[l].freq > 0.0; l++) {
int harmonic;
for (harmonic=5; harmonic>1; harmonic--) {
if (peaks[0].freq / peaks[l].freq < harmonic+.02 &&
peaks[0].freq / peaks[l].freq > harmonic-.02) {
if (harmonic > maxharm &&
peaks[0].db < peaks[l].db/2) {
maxharm = harmonic;
k = l;
}
}
}
//displayFrequency(&peaks[l], lblFreq[l]);
}
displayFrequency(&peaks[k]);
}
memmove(fftSampleBuffer, fftSampleBuffer+stepSize,
(fftSize-stepSize)*sizeof(float));
}
}
#endif
#ifdef USE_DJBFFT
float sample = *indata;
fftr4_4(&sample);
printf("f % 8.3f\n", sample);
#endif
}
int main(int argc, char* argv[])
{
createinfo(argc, argv);
/* enough arguments ? */
if (argc < 3) {
fprintf(stderr, "\nusage: %s [OPTIONS] PROJPARA INTERACTION NUCSFILE"
"\n -h hermitize matrix elements"
"\n -d diagonal matrix elements only\n",
argv[0]);
exit(-1);
}
int hermit=0;
int diagonal=0;
int odd;
char c;
/* manage command-line options */
while ((c = getopt(argc, argv, "dh")) != -1)
switch (c) {
case 'd':
diagonal=1;
break;
case 'h':
hermit=1;
break;
}
char* projpar = argv[optind];
char* interactionfile = argv[optind+1];
char* nucsfile = argv[optind+2];
char* mbfile[MAXSTATES];
int n;
if (readstringsfromfile(nucsfile, &n, mbfile))
return -1;
SlaterDet Q[n];
Symmetry S[n];
int i;
for (i=0; i<n; i++) {
extractSymmetryfromString(&mbfile[i], &S[i]);
if (readSlaterDetfromFile(&Q[i], mbfile[i]))
exit(-1);;
}
Interaction Int;
if (readInteractionfromFile(&Int, interactionfile))
exit(-1);
Int.cm = 1;
// odd numer of nucleons ?
odd = Q[0].A % 2;
// Projection parameters
Projection P;
initProjection(&P, odd, projpar);
// check that no cm-projection was used
if (P.cm != CMNone) {
fprintf(stderr, "You have to use cm-none! for Projection\n");
exit(-1);
}
initOpObservables(&Int);
int a,b;
// calculate norms of Slater determinants
SlaterDetAux X;
double norm[n];
initSlaterDetAux(&Q[0], &X);
for (i=0; i<n; i++) {
calcSlaterDetAuxod(&Q[i], &Q[i], &X);
norm[i] = sqrt(creal(X.ovlap));
}
/*
// calculate cm factor
double tcm[n];
for (i=0; i<n; i++) {
calcSlaterDetAux(&Q[i], &X);
calcTCM(&Q[i], &X, &tcm[i]);
}
double meantcm = 0.0;
for (i=0; i<n; i++)
meantcm += tcm[i]/n;
double alpha = 0.25/0.75*(meantcm*(mproton*Q[0].Z+mneutron*Q[0].N));
double cmfactor = 0.125*pow(M_PI*alpha,-1.5);
*/
// initialize space for matrix elements
Observablesod** obsme[n*n];
for (b=0; b<n; b++)
for (a=0; a<n; a++)
obsme[a+b*n] = initprojectedMBME(&P, &OpObservables);
// read or calculate matrix elements
for (b=0; b<n; b++)
for (a=diagonal ? b : 0; a<n; a += diagonal ? n : 1)
if (readprojectedMBMEfromFile(mbfile[a], mbfile[b], &P, &OpObservables,
S[a], S[b], obsme[a+b*n])) {
fprintf(stderr, "Matrix elements between %s and %s missing\n",
mbfile[a], mbfile[b]);
exit(-1);
}
if (hermit)
hermitizeprojectedMBME(&P, &OpObservables, obsme, n);
int pi, j;
for (pi=0; pi<=1; pi++)
for (j=odd; j<P.jmax; j=j+2)
extractmatrices(nucsfile, &P, S, &Int, obsme, norm, 1.0, n, diagonal, j, pi);
}
int main(int argc, char *argv[]){
int n,m,n_recv;
int s,ss;
struct sockaddr_in addr; // addres information for bin
struct sockaddr_in client_addr;
if(argc==2){
// server
ss = socket(PF_INET, SOCK_STREAM, 0);
addr.sin_family = AF_INET; // IPv4
addr.sin_port = htons(atoi(argv[1])); // port number to wait on
addr.sin_addr.s_addr = INADDR_ANY; // any IP address can be connected
if(bind(ss, (struct sockaddr *)&addr, sizeof(addr)) == -1){
die("bind");
}
if(listen(ss,10) == -1){
die("listen");
}
socklen_t len = sizeof(struct sockaddr_in);
s = accept(ss, (struct sockaddr *)&client_addr, &len);
if(s==-1){
die("accept");
}
if(close(ss)==-1){
die("close");
}
}else if(argc==3){
// client
s = socket(PF_INET, SOCK_STREAM, 0);
addr.sin_family = AF_INET; // IPv4
addr.sin_addr.s_addr = inet_addr(argv[1]); // IP address
addr.sin_port = htons(atoi(argv[2])); // port number
int ret = connect(s, (struct sockaddr *)&addr, sizeof(addr));
if(ret == -1){ //connect
die("connect");
}
}
FILE *fp_rec;
FILE *fp_play;
if ( (fp_rec=popen("rec -q -t raw -b 16 -c 1 -e s -r 44100 - 2> /dev/null","r")) ==NULL) {
die("popen:rec");
}
if ( (fp_play=popen("play -t raw -b 16 -c 1 -e s -r 44100 - 2> /dev/null ","w")) ==NULL) {
die("popen:play");
}
// sample_t *rec_data, *play_data;
int cut_low=300, cut_high=5000;
int send_len = (cut_high-cut_low)*N/SAMPLING_FREQEUENCY;
sample_t * rec_data = malloc(sizeof(sample_t)*N);
double * send_data = malloc(sizeof(double)*send_len*2);
double * recv_data = malloc(sizeof(double)*send_len*2);
sample_t * play_data = malloc(sizeof(sample_t)*N);
complex double * X = calloc(sizeof(complex double), N);
complex double * Y = calloc(sizeof(complex double), N);
complex double * Z = calloc(sizeof(complex double), N);
complex double * W = calloc(sizeof(complex double), N);
int re=0, r;
while(1){
// ssize_t m = fread_n(*fp_rec, n * sizeof(sample_t), rec_data);
// 必ずNバイト読む
re = 0;
while(re<N){
r=fread(rec_data+re,sizeof(sample_t),N/sizeof(sample_t)-re,fp_rec);
if(r==-1) die("fread");
if(r==0) break;
re += r;
}
// n=fread(rec_data,sizeof(sample_t),N/sizeof(sample_t),fp_rec);
// re = 0;
// re = fread(rec_data,sizeof(sample_t), N-re, fp_rec);
memset(rec_data+re,0,N-re);
// 複素数の配列に変換
sample_to_complex(rec_data, X, N);
// /* FFT -> Y */
fft(X, Y, N);
// Yの一部を送る
int i;
for(i=cut_low*N/SAMPLING_FREQEUENCY;i<cut_low*N/SAMPLING_FREQEUENCY+send_len;i++){
send_data[2*i]=creal(Y[i]);
send_data[2*i+1]=cimag(Y[i]);
}
// if(send_all(s,(char *)send_data,sizeof(long)*send_len*2)==-1){
// die("send");
// }
memset(W,0+0*I,N*sizeof(complex double));
memset(Z,0+0*I,N*sizeof(complex double));
// memset(play_data,0,sizeof(long)*send_len*2);
// if(recv_all(s,(char *)recv_data,sizeof(long)*send_len*2)==-1){
// die("recv");
// }
for(i=cut_low*N/SAMPLING_FREQEUENCY;i<cut_low*N/SAMPLING_FREQEUENCY+send_len;i++){
W[i]=(double)send_data[2*i]+(double)send_data[2*i+1]*I;
}
// /* IFFT -> Z */
ifft(W, Z, N);
// // 標本の配列に変換
complex_to_sample(Z, play_data, N);
// /* 標準出力へ出力 */
// write_n(1, N, send_data);
write_n(1, N, play_data);
// fwrite(play_data,sizeof(sample_t),N/sizeof(sample_t),fp_play);
// write(1,recv_data,n_recv);
}
close(s);
}
void hessian(int nshots, int SHOTINC, float *** green_vy, float *** greeni_vy, float *** green_syy, float *** greeni_syy,
float *** green_sxy, float *** greeni_sxy, float ** prho, float ** pu, int iter){
extern float DT,DH,TIME;
extern float FC_HESSIAN;
extern int NX, NY, IDX, IDY, DTINV, INVMAT1, MYID, POS[4], FDORDER;
extern char JACOBIAN[STRING_SIZE];
/* local variables */
int i, j, k, l, ns_hess, ishot, irec, nd, NSRC_HESSIAN, NREC_HESSIAN, RECINC;
double trig1,trig2;
double t=0.0;
const double pi=4.0*atan(1.0);
char jac[STRING_SIZE];
float complex uttx, utty, exx, eyy, eyx, Gxx, Gyx, Gxy, Gyy, Gxxx, Gyxx, Gxyy, Gyyy, Gxyx, Gyyx;
float complex tmp_jac_lam, tmp_jac_mu, tmp_jac_rho, tmp_jac_vp, tmp_jac_vs, tmp_fft_fsignal;
float ** abs_green, omega, mulamratio, lamss, muss, HESS_SCALE;
float ** hessian, ** hessian_u, ** hessian_rho, ** hessian_lam, ** hessian_mu;
float hvxx, hvxxi, hvyy, hvyyi, hvxy, hvxyi, hvyx, hvyxi;
float **exx_shot, **exxi_shot, **eyy_shot, **eyyi_shot, **eyx_shot, **eyxi_shot, **uttx_shot, **uttxi_shot, **utty_shot, **uttyi_shot;
float *psource_hess=NULL, *Hess_for_real=NULL, *Hess_for_complex=NULL;
FILE *FP4;
HESS_SCALE = 1.0;
RECINC = 1;
NSRC_HESSIAN=1;
NREC_HESSIAN=24;
nd = FDORDER/2 + 1;
abs_green = matrix(-nd+1,NY+nd,-nd+1,NX+nd);
/* Diagonal elements of the Hessian*/
hessian_u = matrix(-nd+1,NY+nd,-nd+1,NX+nd);
hessian_mu = matrix(-nd+1,NY+nd,-nd+1,NX+nd);
hessian_rho = matrix(-nd+1,NY+nd,-nd+1,NX+nd);
eyy_shot = matrix(-nd+1,NY+nd,-nd+1,NX+nd);
eyyi_shot = matrix(-nd+1,NY+nd,-nd+1,NX+nd);
eyx_shot = matrix(-nd+1,NY+nd,-nd+1,NX+nd);
eyxi_shot = matrix(-nd+1,NY+nd,-nd+1,NX+nd);
utty_shot = matrix(-nd+1,NY+nd,-nd+1,NX+nd);
uttyi_shot = matrix(-nd+1,NY+nd,-nd+1,NX+nd);
Hess_for_real = vector(1,1);
Hess_for_complex = vector(1,1);
for (i=1;i<=NX;i=i+IDX){
for (j=1;j<=NY;j=j+IDY){
hessian_u[j][i]=0.0;
hessian_mu[j][i]=0.0;
hessian_rho[j][i]=0.0;
}
}
/* assemble Hessian */
/* ----------------------------------------------------------------- */
/* Circular frequency of the Hessian */
omega = 2.0*M_PI*FC_HESSIAN;
/* calculate absolute values of impulse responses */
for (ishot=1;ishot<=nshots;ishot=ishot+SHOTINC){
for (i=1;i<=NX;i=i+IDX){
for (j=1;j<=NY;j=j+IDY){
/*green_x = green_vx[j][i][ishot] + greeni_vx[j][i][ishot] * I;
green_y = green_vy[j][i][ishot] + greeni_vy[j][i][ishot] * I;*/
abs_green[j][i] = 1.0;
}
}
}
/*printf("omega = %e \n",omega);
printf("NSRC = %d \n",NSRC_HESSIAN);*/
/*psource_hess=rd_sour(&ns_hess,fopen(SIGNAL_FILE,"r"));
FFT_data(psource_hess,Hess_for_real,Hess_for_complex,NT);
MPI_Barrier(MPI_COMM_WORLD);
tmp_fft_fsignal = Hess_for_real[1] + Hess_for_complex[1] * I;*/
tmp_fft_fsignal = 1.0;
for (ishot=1;ishot<=nshots;ishot=ishot+SHOTINC){
/* calculate spatial and temporal derivatives of the forward wavefield */
for (i=1;i<=NX;i=i+IDX){
for (j=1;j<=NY;j=j+IDY){
hvyy = (green_vy[j+1][i][ishot]-green_vy[j][i][ishot])/DH;
hvyyi = (greeni_vy[j+1][i][ishot]-greeni_vy[j][i][ishot])/DH;
hvyx = (green_vy[j][i+1][ishot]-green_vy[j][i][ishot])/DH;
hvyxi = (greeni_vy[j][i+1][ishot]-greeni_vy[j][i][ishot])/DH;
/* calculate strain tensors and integrate FD-wavefield */
eyy_shot[j][i] = hvyy;
eyyi_shot[j][i] = hvyyi;
eyxi_shot[j][i] = hvyxi;
eyx_shot[j][i] = hvyx;
utty_shot[j][i] = -hvyyi*omega;
uttyi_shot[j][i] = hvyy*omega;
}
}
for (irec=1;irec<=1;irec=irec+RECINC){
/* construct Hessian for different material parameters */
for (i=1;i<=NX;i=i+IDX){
for (j=1;j<=NY;j=j+IDY){
/* assemble complex wavefields */
utty = (utty_shot[j][i] + uttyi_shot[j][i] * I);
eyy = (eyy_shot[j][i] + eyyi_shot[j][i] * I);
eyx = (eyx_shot[j][i] + eyxi_shot[j][i] * I);
if(INVMAT1==1){
muss = prho[j][i] * pu[j][i] * pu[j][i];
}
if(INVMAT1=3){
muss = pu[j][i];
}
/* Hessian */
tmp_jac_rho = (conj(utty)*utty);
tmp_jac_mu = (conj(eyx)*abs_green[j][i]*eyx) + (conj(eyy)*abs_green[j][i]*eyy);
/* calculate Hessian for lambda, mu and rho by autocorrelation of Frechet derivatives */
/*if(INVMAT1==3){*/
hessian_u[j][i] += HESS_SCALE * creal(tmp_jac_mu);
hessian_rho[j][i] += HESS_SCALE * creal(tmp_jac_rho);
/*}*/
/* Assemble Hessian for Vp, Vs and rho by autocorrelation of Frechet derivatives*/
/*if(INVMAT1==1){
tmp_jac_vp = 2.0 * ppi[j][i] * prho[j][i] * tmp_jac_lam;
tmp_jac_vs = (- 4.0 * prho[j][i] * pu[j][i] * tmp_jac_lam) + (2.0 * prho[j][i] * pu[j][i] * tmp_jac_mu);
tmp_jac_rho += (((ppi[j][i] * ppi[j][i])-(2.0 * pu[j][i] * pu[j][i])) * tmp_jac_lam) + (pu[j][i] * pu[j][i] * tmp_jac_mu);
hessian[j][i] += HESS_SCALE * creal(tmp_jac_vp*conj(tmp_jac_vp));
hessian_u[j][i] += HESS_SCALE * creal(tmp_jac_vs*conj(tmp_jac_vs));
hessian_rho[j][i] += HESS_SCALE * creal(tmp_jac_rho*conj(tmp_jac_rho));
}*/
}
}
}
}
/* apply wavenumber damping for Vp-, Vs- and density Hessian */
/*if(SPATFILTER==1){
wavenumber(hessian_u);
wavenumber(hessian_rho);
}*/
/* save HESSIAN for mu */
/* ----------------------- */
sprintf(jac,"%s_hessian_u_%d.%i%i",JACOBIAN,iter,POS[1],POS[2]);
FP4=fopen(jac,"wb");
/* output of the gradient */
for (i=1;i<=NX;i=i+IDX){
for (j=1;j<=NY;j=j+IDY){
fwrite(&hessian_u[j][i],sizeof(float),1,FP4);
}
}
fclose(FP4);
MPI_Barrier(MPI_COMM_WORLD);
/* merge gradient file */
sprintf(jac,"%s_hessian_u_%d",JACOBIAN,iter);
if (MYID==0) mergemod(jac,3);
/* save HESSIAN for rho */
/* ----------------------- */
sprintf(jac,"%s_hessian_rho_%d.%i%i",JACOBIAN,iter,POS[1],POS[2]);
FP4=fopen(jac,"wb");
/* output of the gradient */
for (i=1;i<=NX;i=i+IDX){
for (j=1;j<=NY;j=j+IDY){
fwrite(&hessian_rho[j][i],sizeof(float),1,FP4);
}
}
fclose(FP4);
MPI_Barrier(MPI_COMM_WORLD);
/* merge gradient file */
sprintf(jac,"%s_hessian_rho_%d",JACOBIAN,iter);
if (MYID==0) mergemod(jac,3);
free_matrix(hessian_u,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(hessian_mu,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(hessian_rho,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(eyy_shot,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(eyx_shot,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(utty_shot,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(eyyi_shot,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(eyxi_shot,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(uttyi_shot,-nd+1,NY+nd,-nd+1,NX+nd);
}
void printcomp(double complex integ)
{
printf("abs %.2f %+.2fi\n", creal(integ), cimag(integ));
while(!getch());
}
static MagickBooleanType ForwardFourierTransform(FourierInfo *fourier_info,
const Image *image,double *magnitude,double *phase,ExceptionInfo *exception)
{
CacheView
*image_view;
double
n,
*source;
fftw_complex
*fourier;
fftw_plan
fftw_r2c_plan;
long
y;
register const IndexPacket
*indexes;
register const PixelPacket
*p;
register long
i,
x;
/*
Generate the forward Fourier transform.
*/
source=(double *) AcquireQuantumMemory((size_t) fourier_info->height,
fourier_info->width*sizeof(*source));
if (source == (double *) NULL)
{
(void) ThrowMagickException(exception,GetMagickModule(),
ResourceLimitError,"MemoryAllocationFailed","`%s'",image->filename);
return(MagickFalse);
}
ResetMagickMemory(source,0,fourier_info->width*fourier_info->height*
sizeof(*source));
i=0L;
image_view=AcquireCacheView(image);
for (y=0L; y < (long) fourier_info->height; y++)
{
p=GetCacheViewVirtualPixels(image_view,0L,y,fourier_info->width,1UL,
exception);
if (p == (const PixelPacket *) NULL)
break;
indexes=GetCacheViewVirtualIndexQueue(image_view);
for (x=0L; x < (long) fourier_info->width; x++)
{
switch (fourier_info->channel)
{
case RedChannel:
default:
{
source[i]=QuantumScale*GetRedPixelComponent(p);
break;
}
case GreenChannel:
{
source[i]=QuantumScale*GetGreenPixelComponent(p);
break;
}
case BlueChannel:
{
source[i]=QuantumScale*GetBluePixelComponent(p);
break;
}
case OpacityChannel:
{
source[i]=QuantumScale*GetOpacityPixelComponent(p);
break;
}
case IndexChannel:
{
source[i]=QuantumScale*indexes[x];
break;
}
case GrayChannels:
{
source[i]=QuantumScale*GetRedPixelComponent(p);
break;
}
}
i++;
p++;
}
}
image_view=DestroyCacheView(image_view);
fourier=(fftw_complex *) AcquireAlignedMemory((size_t) fourier_info->height,
fourier_info->center*sizeof(*fourier));
if (fourier == (fftw_complex *) NULL)
{
(void) ThrowMagickException(exception,GetMagickModule(),
ResourceLimitError,"MemoryAllocationFailed","`%s'",image->filename);
source=(double *) RelinquishMagickMemory(source);
return(MagickFalse);
}
#if defined(MAGICKCORE_OPENMP_SUPPORT)
#pragma omp critical (MagickCore_ForwardFourierTransform)
#endif
fftw_r2c_plan=fftw_plan_dft_r2c_2d(fourier_info->width,fourier_info->width,
source,fourier,FFTW_ESTIMATE);
fftw_execute(fftw_r2c_plan);
fftw_destroy_plan(fftw_r2c_plan);
source=(double *) RelinquishMagickMemory(source);
/*
Normalize Fourier transform.
*/
n=(double) fourier_info->width*(double) fourier_info->width;
i=0L;
for (y=0L; y < (long) fourier_info->height; y++)
for (x=0L; x < (long) fourier_info->center; x++)
fourier[i++]/=n;
/*
Generate magnitude and phase (or real and imaginary).
*/
i=0L;
if (fourier_info->modulus != MagickFalse)
for (y=0L; y < (long) fourier_info->height; y++)
for (x=0L; x < (long) fourier_info->center; x++)
{
magnitude[i]=cabs(fourier[i]);
phase[i]=carg(fourier[i]);
i++;
}
else
for (y=0L; y < (long) fourier_info->height; y++)
for (x=0L; x < (long) fourier_info->center; x++)
{
magnitude[i]=creal(fourier[i]);
phase[i]=cimag(fourier[i]);
i++;
}
fourier=(fftw_complex *) RelinquishAlignedMemory(fourier);
return(MagickTrue);
}
// solve linear system of equations using conjugate gradient method
// _A : symmetric positive definite matrix [size: _n x _n]
// _n : system dimension
// _b : equality [size: _n x 1]
// _x : solution estimate [size: _n x 1]
// _opts : options (ignored for now)
void MATRIX(_cgsolve)(T * _A,
unsigned int _n,
T * _b,
T * _x,
void * _opts)
{
// validate input
if (_n == 0) {
fprintf(stderr,"error: matrix_cgsolve(), system dimension cannot be zero\n");
exit(1);
}
// options
unsigned int max_iterations = 4*_n; // maximum number of iterations
double tol = 1e-6; // error tolerance
unsigned int j;
// TODO : check options
// 1. set initial _x0
// 2. max number of iterations
// 3. residual tolerance
// allocate memory for arrays
T x0[_n], x1[_n]; // iterative vector x (solution estimate)
T d0[_n], d1[_n]; // iterative vector d
T r0[_n], r1[_n]; // iterative vector r (step direction)
T q[_n]; // A * d0
T Ax1[_n]; // A * x1
// scalars
T delta_init; // b^T * b0
T delta0; // r0^T * r0
T delta1; // r1^T * r1
T gamma; // d0^T * q
T alpha;
T beta;
double res; // residual
double res_opt=0.0; // residual of best solution
// initialize x0 to {0, 0, ... 0}
for (j=0; j<_n; j++)
x0[j] = 0.0;
// d0 = b - A*x0 (assume x0 = {0, 0, 0, ...0})
for (j=0; j<_n; j++)
d0[j] = _b[j];
// r0 = d0
memmove(r0, d0, _n*sizeof(T));
// delta_init = b^T * b
MATRIX(_transpose_mul)(_b, _n, 1, &delta_init);
// delta0 = r0^T * r0
MATRIX(_transpose_mul)(r0, _n, 1, &delta0);
// save best solution
memmove(_x, x0, _n*sizeof(T));
unsigned int i=0; // iteration counter
while ( (i < max_iterations) && (creal(delta0) > tol*tol*creal(delta_init)) ) {
#if DEBUG_CGSOLVE
printf("*********** %4u / %4u (max) **************\n", i, max_iterations);
printf(" comparing %12.4e > %12.4e\n", creal(delta0), tol*tol*creal(delta_init));
#endif
// q = A*d0
MATRIX(_mul)(_A, _n, _n,
d0, _n, 1,
q, _n, 1);
// gamma = d0^T * q
gamma = 0.0;
for (j=0; j<_n; j++)
gamma += conj(d0[j]) * q[j];
// step size: alpha = (r0^T * r0) / (d0^T * A * d0)
// = delta0 / gamma
alpha = delta0 / gamma;
#if DEBUG_CGSOLVE
printf(" alpha = %12.8f\n", crealf(alpha));
printf(" delta0 = %12.8f\n", crealf(delta0));
#endif
// update x
for (j=0; j<_n; j++)
x1[j] = x0[j] + alpha*d0[j];
#if DEBUG_CGSOLVE
printf(" x:\n");
MATRIX(_print)(x1, _n, 1);
#endif
// update r
if ( ((i+1)%50) == 0) {
// peridically re-compute: r = b - A*x1
MATRIX(_mul)(_A, _n, _n,
x1, _n, 1,
Ax1, _n, 1);
for (j=0; j<_n; j++)
r1[j] = _b[j] - Ax1[j];
} else {
for (j=0; j<_n; j++)
r1[j] = r0[j] - alpha*q[j];
}
// delta1 = r1^T * r1
MATRIX(_transpose_mul)(r1, _n, 1, &delta1);
// update beta
beta = delta1 / delta0;
// d1 = r + beta*d0
for (j=0; j<_n; j++)
d1[j] = r1[j] + beta*d0[j];
// compute residual
res = sqrt( cabs(delta1) / cabs(delta_init) );
if (i==0 || res < res_opt) {
// save best solution
res_opt = res;
memmove(_x, x1, _n*sizeof(T));
}
#if DEBUG_CGSOLVE
printf(" res = %12.4e\n", res);
#endif
// copy old x, d, r, delta
memmove(x0, x1, _n*sizeof(T));
memmove(d0, d1, _n*sizeof(T));
memmove(r0, r1, _n*sizeof(T));
delta0 = delta1;
// increment counter
i++;
}
}
/**
* Compares accuracy and execution time of the fast Gauss transform with
* increasing expansion degree.
* Similar to the test in F. Andersson and G. Beylkin.
* The fast Gauss transform with double _Complex parameters.
* J. Comput. Physics 203 (2005) 274-286
*
* \author Stefan Kunis
*/
void fgt_test_andersson(void)
{
fgt_plan my_plan;
double _Complex *swap_dgt;
int N;
double _Complex sigma=4*(138+ _Complex_I*100);
int n=128;
int N_dgt_pre_exp=(int)(1U<<11);
int N_dgt=(int)(1U<<19);
printf("n=%d, sigma=%1.3e+i%1.3e\n",n,creal(sigma),cimag(sigma));
for(N=((int)(1U<<6)); N<((int)(1U<<22)); N=N<<1)
{
printf("$%d$\t & ",N);
if(N<N_dgt_pre_exp)
fgt_init_guru(&my_plan, N, N, sigma, n, 1, 7, DGT_PRE_CEXP);
else
fgt_init_guru(&my_plan, N, N, sigma, n, 1, 7, 0);
swap_dgt = (double _Complex*)nfft_malloc(my_plan.M*
sizeof(double _Complex));
fgt_test_init_rand(&my_plan);
fgt_init_node_dependent(&my_plan);
if(N<N_dgt)
{
NFFT_SWAP_complex(swap_dgt,my_plan.f);
if(N<N_dgt_pre_exp)
my_plan.flags^=DGT_PRE_CEXP;
printf("$%1.1e$\t & ",fgt_test_measure_time(&my_plan, 1));
if(N<N_dgt_pre_exp)
my_plan.flags^=DGT_PRE_CEXP;
NFFT_SWAP_complex(swap_dgt,my_plan.f);
}
else
printf("\t\t & ");
if(N<N_dgt_pre_exp)
printf("$%1.1e$\t & ",fgt_test_measure_time(&my_plan, 1));
else
printf("\t\t & ");
my_plan.flags^=FGT_NDFT;
printf("$%1.1e$\t & ",fgt_test_measure_time(&my_plan, 0));
my_plan.flags^=FGT_NDFT;
printf("$%1.1e$\t & ",fgt_test_measure_time(&my_plan, 0));
printf("$%1.1e$\t \\\\ \n",
X(error_l_infty_1_complex)(swap_dgt, my_plan.f, my_plan.M,
my_plan.alpha, my_plan.N));
fflush(stdout);
nfft_free(swap_dgt);
fgt_finalize(&my_plan);
fftw_cleanup();
}
}
int main(int argc, char * argv[]) {
CBlasUplo uplo;
CBlasTranspose trans;
size_t n, k;
if (argc != 5) {
fprintf(stderr, "Usage: %s <uplo> <trans> <n> <k>\n"
"where:\n"
" uplo is 'u' or 'U' for CBlasUpper or 'l' or 'L' for CBlasLower\n"
" trans is 'n' or 'N' for CBlasNoTrans or 'c' or 'C' for CBlasConjTrans\n"
" n and k are the sizes of the matrices\n", argv[0]);
return 1;
}
char u;
if (sscanf(argv[1], "%c", &u) != 1) {
fprintf(stderr, "Unable to read character from '%s'\n", argv[1]);
return 1;
}
switch (u) {
case 'U': case 'u': uplo = CBlasUpper; break;
case 'L': case 'l': uplo = CBlasLower; break;
default: fprintf(stderr, "Unknown uplo '%c'\n", u); return 1;
}
char t;
if (sscanf(argv[2], "%c", &t) != 1) {
fprintf(stderr, "Unable to read character from '%s'\n", argv[2]);
return 2;
}
switch (t) {
case 'N': case 'n': trans = CBlasNoTrans; break;
case 'T': case 't': trans = CBlasTrans; break;
case 'C': case 'c': trans = CBlasConjTrans; break;
default: fprintf(stderr, "Unknown transpose '%c'\n", t); return 2;
}
if (sscanf(argv[3], "%zu", &n) != 1) {
fprintf(stderr, "Unable to parse number from '%s'\n", argv[3]);
return 3;
}
if (sscanf(argv[4], "%zu", &k) != 1) {
fprintf(stderr, "Unable to parse number from '%s'\n", argv[4]);
return 4;
}
srand(0);
double alpha, beta;
double complex * A, * C, * refC;
size_t lda, ldc;
CU_ERROR_CHECK(cuInit(0));
int deviceCount;
CU_ERROR_CHECK(cuDeviceGetCount(&deviceCount));
CUdevice devices[deviceCount];
for (int i = 0; i < deviceCount; i++)
CU_ERROR_CHECK(cuDeviceGet(&devices[i], i));
CUmultiGPU mGPU;
CU_ERROR_CHECK(cuMultiGPUCreate(&mGPU, devices, deviceCount));
CUmultiGPUBLAShandle handle;
CU_ERROR_CHECK(cuMultiGPUBLASCreate(&handle, mGPU));
alpha = (double)rand() / (double)RAND_MAX;
beta = (double)rand() / (double)RAND_MAX;
if (trans == CBlasNoTrans) {
lda = n;
if ((A = malloc(lda * k * sizeof(double complex))) == NULL) {
fputs("Unable to allocate A\n", stderr);
return -1;
}
for (size_t j = 0; j < k; j++) {
for (size_t i = 0; i < n; i++)
A[j * lda + i] = ((double)rand() / (double)RAND_MAX) + ((double)rand() / (double)RAND_MAX) * I;
}
}
else {
lda = k;
if ((A = malloc(lda * n * sizeof(double complex))) == NULL) {
fputs("Unable to allocate A\n", stderr);
return -1;
}
for (size_t j = 0; j < n; j++) {
for (size_t i = 0; i < k; i++)
A[j * lda + i] = ((double)rand() / (double)RAND_MAX) + ((double)rand() / (double)RAND_MAX) * I;
}
}
ldc = n;
if ((C = malloc(ldc * n * sizeof(double complex))) == NULL) {
fputs("Unable to allocate C\n", stderr);
return -3;
}
if ((refC = malloc(ldc * n * sizeof(double complex))) == NULL) {
fputs("Unable to allocate refC\n", stderr);
return -4;
}
for (size_t j = 0; j < n; j++) {
for (size_t i = 0; i < n; i++)
refC[j * ldc + i] = C[j * ldc + i] = ((double)rand() / (double)RAND_MAX) + ((double)rand() / (double)RAND_MAX) * I;
}
zherk_ref(uplo, trans, n, k, alpha, A, lda, beta, refC, ldc);
CU_ERROR_CHECK(cuMultiGPUZherk(handle, uplo, trans, n, k, alpha, A, lda, beta, C, ldc));
CU_ERROR_CHECK(cuMultiGPUSynchronize(mGPU));
double rdiff = 0.0, idiff = 0.0;
for (size_t j = 0; j < n; j++) {
for (size_t i = 0; i < n; i++) {
double d = fabs(creal(C[j * ldc + i]) - creal(refC[j * ldc + i]));
if (d > rdiff)
rdiff = d;
d = fabs(cimag(C[j * ldc + i]) - cimag(refC[j * ldc + i]));
if (d > idiff)
idiff = d;
}
}
struct timeval start, stop;
if (gettimeofday(&start, NULL) != 0) {
fputs("gettimeofday failed\n", stderr);
return -5;
}
for (size_t i = 0; i < 20; i++)
CU_ERROR_CHECK(cuMultiGPUZherk(handle, uplo, trans, n, k, alpha, A, lda, beta, C, ldc));
CU_ERROR_CHECK(cuMultiGPUSynchronize(mGPU));
if (gettimeofday(&stop, NULL) != 0) {
fputs("gettimeofday failed\n", stderr);
return -6;
}
double time = ((double)(stop.tv_sec - start.tv_sec) +
(double)(stop.tv_usec - start.tv_usec) * 1.e-6) / 20.0;
size_t flops = k * 6 + (k - 1) * 2; // k multiplies and k - 1 adds per element
if (alpha != 1.0)
flops += 1; // additional multiply by alpha
if (beta != 0.0)
flops += 2; // additional multiply and add by beta
double error = (double)flops * 2.0 * DBL_EPSILON; // maximum per element error
flops *= n * (n + 1) / 2; // n(n + 1) / 2 elements
bool passed = (rdiff <= error) && (idiff <= error);
fprintf(stdout, "%.3es %.3gGFlops/s Error: %.3e + %.3ei\n%sED!\n", time,
((double)flops * 1.e-9) / time, rdiff, idiff, (passed) ? "PASS" : "FAIL");
free(A);
free(C);
free(refC);
CU_ERROR_CHECK(cuMultiGPUBLASDestroy(handle));
CU_ERROR_CHECK(cuMultiGPUDestroy(mGPU));
return (int)!passed;
}
void
f (double *v, size_t n)
{
const double complex mik = -I * k;
double vtmp;
double tinf = -rho * (kappa * theta * tau + V0) / omega + log (F / K);
double scaledv;
if (!cbuf_initialized)
{
cbuf = (double complex *) malloc (sizeof (double complex) * n);
if (!cbuf)
{
abort ();
}
else
{
cbuf_len = n;
}
cbuf_initialized = true;
}
else
{
if (cbuf_len < n)
{
cbuf_len = 2 * cbuf_len > n ? 2 * cbuf_len : n;
free (cbuf);
cbuf =
(double complex *) malloc (sizeof (double complex) * cbuf_len);
if (!cbuf)
{
abort ();
}
}
}
for (size_t i = 0; i < n; i++)
{
cbuf[i] = -log (v[i]) / Cinf - ialphap1;
}
_bal_heston_characteristic_lord2006 (cbuf, n, kappa, omega, rho, tau, theta,
log (F), V0);
for (size_t i = 0; i < n; i++)
{
scaledv = -log (v[i]) / Cinf;
ctmp =
-exp (scaledv * mik) * cbuf[i] / (v[i] - ialpha) / (v[i] - ialphap1);
vtmp = creal (ctmp) / v[i];
if (isfinite (vtmp) & isfinite (cimag (ctmp)))
{
v[i] = vtmp;
}
else
{
if (isfinite (scaledv) & isfinite (scaledv))
{
vtmp =
-psizero * exp (-scaledv * Cinf) * cos (scaledv * tinf) /
scaledv / scaledv / v[i];
if (isfinite (vtmp))
{
v[i] = vtmp;
}
else
{
v[i] = 0.;
}
}
else
{
v[i] = 0.;
}
}
}
}
int main() {
// Initiate the random numbers generator
srand(1);
// Initiate variables
int i, j, l, t, p, h; // indices
int time;
int first_particle;
int other_particle;
double nx_old[N];
double ny_old[N];
double x[N];
double y[N];
double nx_new[N];
double ny_new[N];
double sumnx[N];
double sumny[N];
double nx_temp[N];
double ny_temp[N];
double r[N];
double v[T];
double complex Ax[T], Ay[T], A1[T], Wk[T];
double complex Ax_complex[T], Ay_complex[T], A1_complex[T],
Wk_complex[T]; // konjugiert komplex
double complex G[3][3], omega[3][3]; // ueberpruebfbare Matrizen
double complex Flux[3][T]; // Flux Matrix
double nxsum;
double nysum;
double tau; // time step
double area; // area
double m; // maximum noise
double s; // noise
double phi; // angle of norm vector
double strength; // strength of the noise
double norm;
double v_total;
double complex A1_average, Ax_average, Ay_average;
double complex A1_average_complex, Ax_average_complex, Ay_average_complex;
double kx = wavevectorx * 2 * M_PI / L, ky = wavevectory * 2 * M_PI / L;
double complex WK_m[m_max];
double k = sqrt(pow(kx, 2) + pow(ky, 2));
char str[10];
FILE *fp, *fp2, *fp3, *fp4;
// Functions
fp = fopen("controllparameter.csv", "w");
fp3 = fopen("suszeptibility.csv", "w");
fp4 = fopen("flux.csv", "w");
// get the maximum of the noise
area = L * L;
m = M_PI * R * R * N / area;
printf("m=%f\n", m);
printf("kx=%f ", kx);
printf("ky=%f\n", ky);
// get the value of the time steps
printf("Enter time step tau\n");
tau = scan_to_number();
for (l = d_min; l < d_max; l++) {
// initiate the arrays with random values
initiate(x, y, nx_old, ny_old, nx_new, ny_new, sumnx, sumny, r,
nx_temp, ny_temp, v, Ax, Ay, A1,Wk, Ax_complex,
Ay_complex, A1_complex, Wk_complex);
strength = l * resolution_of_strength;
v_total = 0;
A1_average = 0;
Ax_average = 0;
Ay_average = 0;
A1_average_complex = 0;
Ax_average_complex = 0;
Ay_average_complex = 0;
renew(G, omega, Flux);
renew2(&WK_m);
sprintf(str, "vorticity%03f,%d,%d.csv", strength * m, wavevectorx,
wavevectory);
fp2 = fopen(str, "w");
for (time = 0; time < T; time++) {
for (first_particle = 0; first_particle < N; first_particle++) {
sumnx[first_particle] = nx_old[first_particle];
sumny[first_particle] = ny_old[first_particle];
// loop over all particles to get the distance from each one to other
// particle
for (other_particle = 0; other_particle < N; other_particle++) {
if (other_particle != first_particle) {
r[other_particle] = radius(x[first_particle], x[other_particle],
y[first_particle], y[other_particle]);
r[other_particle] = sqrt(r[other_particle]);
// if the other particle is in reach of the first particle add its
// velocity to sumnx/sumny
if (r[other_particle] <= R) {
sumnx[first_particle] += nx_old[other_particle];
sumny[first_particle] += ny_old[other_particle];
}
}
}
get_new_direction(
&nx_new, &ny_new, &nx_temp, &ny_temp, &sumnx, &sumny,
first_particle, m,
strength); // calculates new directory with random interference
}
get_new_position(
&nx_new, &ny_new, &nx_old, &ny_old, &x, &y,
tau); // calculates new position of each particle based on v_0 and tau
put_back_to_domain(
&x, &y); // applies periodic boundary conditions for all particles
if (time >= waitingtime) {
if (fmod(time, 1) == 0) {
get_total_velocity(nx_old, ny_old, v, time);
}
}
for (j = 0; j < N; j++) {
A1[time] +=
(cos(kx * x[j] + ky * y[j]) + I * sin(kx * x[j] + ky * y[j]));
Ax[time] +=
(cos(kx * x[j] + ky * y[j]) + I * sin(kx * x[j] + ky * y[j])) *
nx_old[j] * v_0;
Ay[time] +=
(cos(kx * x[j] + ky * y[j]) + I * sin(kx * x[j] + ky * y[j])) *
ny_old[j] * v_0;
A1_complex[time] +=
(cos(kx * x[j] + ky * y[j]) - I * sin(kx * x[j] + ky * y[j]));
Ax_complex[time] +=
(cos(kx * x[j] + ky * y[j]) - I * sin(kx * x[j] + ky * y[j])) *
nx_old[j] * v_0;
Ay_complex[time] +=
(cos(kx * x[j] + ky * y[j]) - I * sin(kx * x[j] + ky * y[j])) *
ny_old[j] * v_0;
}
Wk[time] = kx * Ay[time] - ky * Ax[time];
Wk_complex[time] = kx * Ay_complex[time] - ky * Ax_complex[time];
}
for (t = 0; t < T; t++) {
v_total += v[t];
A1_average += A1[t];
Ax_average += Ax[t];
Ay_average += Ay[t];
A1_average_complex += A1_complex[t];
Ax_average_complex += Ax_complex[t];
Ay_average_complex += Ay_complex[t];
}
for (t = waitingtime; t < T - 1; t++) {
Flux[0][t] = -1 / tau * I * (A1_complex[t] - A1_complex[t + 1]);
Flux[1][t] = -1 / tau * I * (Ax_complex[t] - Ax_complex[t + 1]);
Flux[2][t] = -1 / tau * I * (Ay_complex[t] - Ay_complex[t + 1]);
}
A1_average /= T;
Ax_average /= T;
Ay_average /= T;
A1_average_complex /= T;
Ax_average_complex /= T;
Ay_average_complex /= T;
// printf("A1_average= %f %+fi\n", creal(A1_average), cimag(A1_average));
// printf("Ax_average= %f %+fi\n", creal(Ax_average), cimag(Ax_average));
// printf("Ay_average= %f %+fi\n", creal(Ay_average), cimag(Ay_average));
v_total /= (T - waitingtime);
printf("noise = [%10.4f,%10.4f]", -strength * m / 2, strength * m / 2);
printf("v_total= %f strength= %d\n", v_total, l);
fprintf(fp, "%f;%f\n", v_total, strength * m);
for (j = 0; j < m_max; j += 1) {
p = 0;
for (i = waitingtime; i < T - j; i++) {
WK_m[j] += Wk[i] * Wk_complex[i + j];
p += 1;
}
WK_m[j] /= p;
fprintf(fp2, "%d;%f;%f;%f;%f\n", j, creal(WK_m[j]), cimag(WK_m[j]),
log(creal(WK_m[j])), log(cimag(WK_m[j])));
}
p = 0;
for (t = waitingtime; t < T; t++) {
G[0][0] += 1 / pow(L, 2) * (A1_complex[t] - A1_average_complex) *
(A1[t] - A1_average);
G[1][1] += 1 / pow(L, 2) * (Ax_complex[t] - Ax_average_complex) *
(Ax[t] - Ax_average);
G[2][2] += 1 / pow(L, 2) * (Ay_complex[t] - Ay_average_complex) *
(Ay[t] - Ay_average);
G[0][1] += 1 / pow(L, 2) * (A1_complex[t] - A1_average_complex) *
(Ax[t] - Ax_average);
G[1][0] += 1 / pow(L, 2) * (Ax_complex[t] - Ax_average_complex) *
(A1[t] - A1_average);
G[0][2] += 1 / pow(L, 2) * (A1_complex[t] - A1_average_complex) *
(Ay[t] - Ay_average);
G[2][0] += 1 / pow(L, 2) * (Ay_complex[t] - Ay_average_complex) *
(A1[t] - A1_average);
G[1][2] += 1 / pow(L, 2) * (Ax_complex[t] - Ax_average_complex) *
(Ay[t] - Ay_average);
G[2][1] += 1 / pow(L, 2) * (Ay_complex[t] - Ay_average_complex) *
(Ax[t] - Ax_average);
p += 1;
}
for (i = 0; i < 3; i++) {
for (j = 0; j < 3; j++) {
G[i][j] /= p;
}
}
// for(i=0;i<3;i++){
// for(j=0;j<3;j++){
// printf("G[%d][%d]=%f %+fi, p= %d\n",i,j,creal(G[i][j]),
// cimag(G[i][j]),p);
//}
//}
p = 0;
for (t = waitingtime; t < T; t++) {
omega[0][0] += 1 / (pow(L, 2) * k) * Flux[0][t] * A1[t];
omega[1][1] += 1 / (pow(L, 2) * k) * Flux[1][t] * Ax[t];
omega[2][2] += 1 / (pow(L, 2) * k) * Flux[2][t] * Ay[t];
omega[0][1] += 1 / (pow(L, 2) * k) * Flux[0][t] * Ax[t];
omega[1][0] += 1 / (pow(L, 2) * k) * Flux[1][t] * A1[t];
omega[0][2] += 1 / (pow(L, 2) * k) * Flux[0][t] * Ay[t];
omega[2][0] += 1 / (pow(L, 2) * k) * Flux[2][t] * A1[t];
omega[1][2] += 1 / (pow(L, 2) * k) * Flux[1][t] * Ay[t];
omega[2][1] += 1 / (pow(L, 2) * k) * Flux[2][t] * Ax[t];
p += 1;
}
for (i = 0; i < 3; i++) {
for (j = 0; j < 3; j++) {
omega[i][j] /= p;
}
}
// for(i=0;i<3;i++){
// for(j=0;j<3;j++){
// printf("omega[%d][%d]=%f %+fi, p= %d\n",i,j,creal(omega[i][j]),
// cimag(omega[i][j]),p);
//}
//}
fprintf(fp3, "%f;%f;%f;", strength * m, creal(G[0][0]), cimag(G[0][0]));
fprintf(fp3, "%f;%f;%f;%f;", creal(G[0][1]), cimag(G[0][1]), creal(G[1][0]),
cimag(G[1][0]));
fprintf(fp3, "%f;%f;%f;%f;", creal(G[0][2]), cimag(G[0][2]), creal(G[2][0]),
cimag(G[2][0]));
fprintf(fp3, "%f;%f;%f;%f;", creal(G[2][1]), cimag(G[2][1]), creal(G[1][2]),
cimag(G[1][2]));
fprintf(fp3, "%f;%f;%f;%f\n", creal(G[1][1]), cimag(G[1][1]),
creal(G[2][2]), cimag(G[2][2]));
fprintf(fp4, "%f;%f;%f;", strength * m, creal(omega[0][0]),
cimag(omega[0][0]));
fprintf(fp4, "%f;%f;%f;%f;", creal(omega[0][1]), cimag(omega[0][1]),
creal(omega[1][0]), cimag(omega[1][0]));
fprintf(fp4, "%f;%f;%f;%f;", creal(omega[0][2]), cimag(omega[0][2]),
creal(omega[2][0]), cimag(omega[2][0]));
fprintf(fp4, "%f;%f;%f;%f;", creal(omega[2][1]), cimag(omega[2][1]),
creal(omega[1][2]), cimag(omega[1][2]));
fprintf(fp4, "%f;%f;%f;%f\n", creal(omega[1][1]), cimag(omega[1][1]),
creal(omega[2][2]), cimag(omega[2][2]));
fclose(fp2);
}
fclose(fp);
fclose(fp3);
fclose(fp4);
}
/** \see See \ref BilinearTransform_c for documentation */
int XLALWToZCOMPLEX16ZPGFilter( COMPLEX16ZPGFilter *filter )
{
INT4 i; /* A counter. */
INT4 j; /* Another counter. */
INT4 num; /* The total number of zeros or poles. */
INT4 numZeros; /* The number of finite zeros. */
INT4 numPoles; /* The number of finite poles. */
COMPLEX16 *a; /* A zero or pole in the w plane. */
COMPLEX16 *b; /* A zero or pole in the z plane. */
COMPLEX16 *g; /* A gain correction factor. */
COMPLEX16Vector *z=NULL; /* Vector of zeros or poles in z plane. */
COMPLEX16Vector *gain=NULL; /* Vector of gain correction factors. */
COMPLEX16Vector null; /* A vector of zero length. */
INT4Vector *idx=NULL; /* Index array for sorting absGain. */
/* Make sure the filter pointer is non-null. */
if ( ! filter )
XLAL_ERROR( XLAL_EFAULT );
/* If the filter->zeros or filter->poles pointers is null, this
means that there are no zeros or no poles. For simplicity, we
set the pointer to point to a vector of zero length. */
null.length=0;
null.data=NULL;
if(!filter->zeros)
filter->zeros=&null;
if(!filter->poles)
filter->poles=&null;
/* Check that the vector lengths are non-negative, and, if positive,
that the vector data pointer is non-null. */
numZeros=filter->zeros->length;
if (numZeros<0)
XLAL_ERROR(XLAL_EINVAL);
if(numZeros>0)
if (!filter->zeros->data)
XLAL_ERROR(XLAL_EFAULT);
numPoles=filter->poles->length;
if (numPoles<0)
XLAL_ERROR(XLAL_EINVAL);
if(numPoles>0)
if (!filter->poles->data)
XLAL_ERROR(XLAL_EFAULT);
/* Compute the total number of zeros and poles in the w-plane,
including those at w=infinity. */
num = (numZeros>numPoles) ? numZeros : numPoles;
numZeros=numPoles=num;
/* If there are neither zeros nor poles, then there is nothing to
transform. (The <0 case should never occur if the ASSERT()
macros have done their job, but is included for extra safety.) */
if(num<=0){
filter->zeros=NULL;
filter->poles=NULL;
return 0;
}
/* Compute the revised number of zeros and poles in the z-plane,
excluding those at z=infinity (w=-i). */
for(i=0,a=filter->zeros->data;i<(INT4)filter->zeros->length;i++,a++)
if((creal(*a)==0.0)&&(cimag(*a)==-1.0))
numZeros--;
for(i=0,a=filter->poles->data;i<(INT4)filter->poles->length;i++,a++)
if((creal(*a)==0.0)&&(cimag(*a)==-1.0))
numPoles--;
/* Create the vector of gain correction factors. */
/* Create the new vector of zeros. */
gain=XLALCreateCOMPLEX16Vector(filter->zeros->length+filter->poles->length);
z=XLALCreateCOMPLEX16Vector(numZeros);
if (!gain||!z)
{
XLALDestroyCOMPLEX16Vector(gain);
XLALDestroyCOMPLEX16Vector(z);
XLAL_ERROR(XLAL_EFUNC);
}
g=gain->data;
b=z->data;
/* Transform existing zeros from w to z, except for those at w=-i,
which are mapped to z=infinity. At the same time, compute the
gain correction factors. */
for(i=0,j=0,a=filter->zeros->data;i<(INT4)filter->zeros->length;
i++,a++,g++){
REAL8 ar=creal(*a);
REAL8 ai=cimag(*a);
if(ar==0.0){
if(ai==-1.0){
/* w=-i is mapped to z=infinity. */
*g=2.0*I;
}else{
/* w=i*y is mapped to z=(1-y)/(1+y). */
*b=(1.0-ai)/(1.0+ai);
*g=-(1.0+ai)*I;
b++;
j++;
}
}else if(fabs(1.0+ai)>fabs(ar)){
REAL8 ratio = -ar/(1.0+ai);
REAL8 denom = 1.0+ai - ratio*ar;
*b = (1.0-ai + ratio*ar)/denom;
*b += I*(ar - ratio*(1.0-ai))/denom;
*g = -ar;
*g += -(1.0+ai)*I;
b++;
j++;
}else{
REAL8 ratio = -(1.0+ai)/ar;
REAL8 denom = -ar + ratio*(1.0+ai);
*b = ((1.0-ai)*ratio + ar)/denom;
*b += I*(ar*ratio - 1.0+ai)/denom;
*g = -ar;
*g += -(1.0+ai)*I;
b++;
j++;
}
}
/* Transform any remaining zeros at w=infinity to z=-1. */
for(;j<numZeros;b++,j++){
*b = -1.0;
}
/* Replace the old filter zeros with the new ones. */
if(filter->zeros->length>0)
XLALDestroyCOMPLEX16Vector(filter->zeros);
filter->zeros=z;
z=NULL;
/* Create the new vector of poles. */
z=XLALCreateCOMPLEX16Vector(numPoles);
if (!gain||!z)
{
XLALDestroyCOMPLEX16Vector(gain);
XLAL_ERROR(XLAL_EFUNC);
}
b=z->data;
/* Transform existing poles from w to z, except for those at w=-i,
which are mapped to z=infinity. At the same time, compute the
gain correction factors. */
for(i=0,j=0,a=filter->poles->data;i<(INT4)filter->poles->length;
i++,a++,g++){
REAL8 ar=creal(*a);
REAL8 ai=cimag(*a);
if(ar==0.0){
if(ai==-1.0){
/* w=-i is mapped to z=infinity. */
*g=-0.5*I;
}else{
/* w=i*y is mapped to z=(1-y)/(1+y). */
*b=(1.0-ai)/(1.0+ai);
*g=I*1.0/(1.0+ai);
b++;
j++;
}
}else if(fabs(1.0+ai)>fabs(ar)){
REAL8 ratio = -ar/(1.0+ai);
REAL8 denom = 1.0+ai - ratio*ar;
*b = (1.0-ai + ratio*ar)/denom;
*b += I*(ar - ratio*(1.0-ai))/denom;
*g = ratio/denom;
*g += I*1.0/denom;
b++;
j++;
}else{
REAL8 ratio = -(1.0+ai)/ar;
REAL8 denom = -ar + ratio*(1.0+ai);
*b = ((1.0-ai)*ratio + ar)/denom;
*b += I*(ar*ratio - 1.0+ai)/denom;
*g = ratio/denom;
*g += I*1.0/denom;
b++;
j++;
}
}
/* Transform any remaining poles at w=infinity to z=-1. */
for(;j<numPoles;b++,j++){
*b = -1.0;
}
/* Replace the old filter poles with the new ones. */
if(filter->poles->length>0)
XLALDestroyCOMPLEX16Vector(filter->poles);
filter->poles=z;
z=NULL;
/* To avoid numerical overflow when applying the gain correction
factors, we should multiply alternately by large and small
factors. Create an idx vector that indexes the magnitudes
from small to large. */
idx=XLALCreateINT4Vector(gain->length);
if(!idx||XLALHeapIndex(idx->data,gain->data,gain->length,sizeof(*gain->data),NULL,CompareCOMPLEX16Abs)<0)
{
XLALDestroyCOMPLEX16Vector(gain);
XLALDestroyINT4Vector(idx);
XLAL_ERROR(XLAL_EFUNC);
}
/* Now multiply the gain alternately by small and large correction
factors. */
for(i=0,j=gain->length-1;i<j;i++,j--){
/* Multiply the small and largest factors together. */
/* Multiply the gain by the combined factor. */
filter->gain *= gain->data[idx->data[i]] * gain->data[idx->data[j]];
}
if(i==j){
/* Multiply by the remaining odd factor. */
filter->gain *= gain->data[idx->data[i]];
}
/* Free remaining temporary vectors, and exit. */
XLALDestroyCOMPLEX16Vector(gain);
XLALDestroyINT4Vector(idx);
return 0;
}
static void
do_node(struct AffNode_s *node, void *ptr)
{
struct arg *arg = ptr;
enum AffNodeType_e type = aff_node_type(node);
uint32_t size = aff_node_size(node);
enum affNodeTypeMask node_mask;
if (node == arg->root)
printf("/");
else {
print_path(arg->root, node);
}
switch(type)
{
case affNodeVoid: node_mask = affNodeVoidMask; break;
case affNodeChar: node_mask = affNodeCharMask; break;
case affNodeInt: node_mask = affNodeIntMask; break;
case affNodeDouble: node_mask = affNodeDoubleMask; break;
case affNodeComplex:node_mask = affNodeComplexMask; break;
default:
fprintf(stderr, "lhpc-aff: Internal error: uknown node type %d\n",
type);
exit(1);
}
printf(": %s[%d]", type_name(type), size);
if (count_subnodes && !recursive)
{
struct node_count_arg cnt_arg;
cnt_arg.cnt = 0;
aff_node_foreach(node, node_count, &cnt_arg);
printf(" %lld", (long long int)cnt_arg.cnt);
}
printf("\n");
if (long_format && (node_mask & aff_ls_mask) )
{
switch (type) {
case affNodeVoid:
break;
case affNodeChar: {
char *ptr = malloc(sizeof (char) * size);
int i;
if (ptr == 0) {
fprintf(stderr, "lhpc-aff: not enough memory\n");
exit(1);
}
if (aff_node_get_char(arg->r, node, ptr, size)) {
fprintf(stderr, "lhpc-aff: error getting data\n");
free(ptr);
exit(1);
}
printf(" \"");
for (i = 0; i < size; i++) {
unsigned char p = ptr[i];
if (p < 32 || p >= 127 || p == '\"' || p == '\\')
printf("\\x%02x", p);
else
printf("%c", p);
}
printf("\"\n");
free(ptr);
} break;
case affNodeInt: {
uint32_t *ptr = malloc(sizeof (uint32_t) * size);
int i;
if (ptr == 0) {
fprintf(stderr, "lhpc-aff: not enough memory\n");
exit(1);
}
if (aff_node_get_int(arg->r, node, ptr, size)) {
fprintf(stderr, "lhpc-aff: error getting data\n");
free(ptr);
exit(1);
}
for (i = 0; i < size; i++)
printf(" %5d %11d\n", i, ptr[i]);
free(ptr);
break;
}
case affNodeDouble: {
double *ptr = malloc(sizeof (double) * size);
int i;
if (ptr == 0) {
fprintf(stderr, "lhpc-aff: not enough memory\n");
exit(1);
}
if (aff_node_get_double(arg->r, node, ptr, size)) {
fprintf(stderr, "lhpc-aff: error getting data\n");
free(ptr);
exit(1);
}
for (i = 0; i < size; i++)
printf(" %5d %24.16e\n", i, ptr[i]);
free(ptr);
break;
}
case affNodeComplex: {
double _Complex *ptr = malloc(sizeof (double _Complex) * size);
int i;
if (ptr == 0) {
fprintf(stderr, "lhpc-aff: not enough memory\n");
exit(1);
}
if (aff_node_get_complex(arg->r, node, ptr, size)) {
fprintf(stderr, "lhpc-aff: error getting data\n");
free(ptr);
exit(1);
}
for (i = 0; i < size; i++)
printf(" %5d %24.16e %24.16e\n", i, creal(ptr[i]), cimag(ptr[i]));
free(ptr);
break;
}
default:
fprintf(stderr, "lhpc-aff: Internal error: uknown node type %d\n",
type);
exit(1);
}
}
if (!directory_only)
aff_node_foreach(node, short_list, arg);
if (recursive)
aff_node_foreach(node, do_node, arg);
}
JL_DLLEXPORT struct11 test_11(struct11 a, float b) {
//Unpack a nested ComplexPair{Float32} struct
if (verbose) fprintf(stderr,"%g + %g i & %g\n", creal(a.x), cimag(a.x), b);
a.x += b*1 - (b*2.0*I);
return a;
}