Example #1
0
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));
}
Example #3
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);
}
Example #4
0
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;
}
Example #5
0
double remixmatrixu_(int*id, int*i,int*j){return creal(cMixMatrixU(*id,*i,*j));}
Example #6
0
/**
   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)];
      }
   }
}
Example #8
0
// 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 ;
}
Example #9
0
// 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 ;
}
Example #10
0
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()
Example #12
0
// 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);
    
}
Example #13
0
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;
}
Example #14
0
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;
}
Example #15
0
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;
}
Example #16
0
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;
}
Example #17
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);

}
Example #19
0
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);
}
Example #20
0
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);                

}
Example #21
0
void printcomp(double complex integ)
{
	printf("abs %.2f %+.2fi\n", creal(integ), cimag(integ));
	while(!getch());
}
Example #22
0
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);
}
Example #23
0
// 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++;
    }
}
Example #24
0
/**
 * 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.;
	    }
	}
    }
}
Example #27
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;
}
Example #29
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);
}
Example #30
0
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;
}