void
LALFindChirpSPData (
LALStatus *status,
FindChirpSegmentVector *fcSegVec,
DataSegmentVector *dataSegVec,
FindChirpDataParams *params
)
{
UINT4 i, k;
UINT4 cut;
CHAR infoMsg[512];
REAL4 *w;
REAL4 *amp;
COMPLEX8 *wtilde;
REAL4 *tmpltPower;
REAL4Vector *dataVec;
REAL4 *spec;
COMPLEX8 *resp;
COMPLEX8 *outputData;
REAL4 segNormSum;
/* stuff added for continous chisq test */
REAL4Vector *dataPower = NULL;
REAL4 PSDsum = 0;
INT4 startIX = 0;
INT4 endIX = 0;
COMPLEX8Vector *fftVec = NULL;
FindChirpSegment *fcSeg;
DataSegment *dataSeg;
INITSTATUS(status);
ATTATCHSTATUSPTR( status );
/*
*
* make sure that the arguments are reasonable
*
*/
/* check that the output exists */
ASSERT( fcSegVec, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL
": fcSegVec" );
ASSERT( fcSegVec->data, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL
": fcSegVec->data" );
ASSERT( fcSegVec->data->data, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL
": fcSegVec->data->dat" );
ASSERT( fcSegVec->data->data->data, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL
": fcSegVec->data->data->data" );
/* check that the parameter structure exists */
ASSERT( params, status, FINDCHIRPSPH_ENULL,
FINDCHIRPSPH_MSGENULL ": params" );
/* check that the workspace vectors exist */
ASSERT( params->ampVec, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL );
ASSERT( params->ampVec->data, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL );
ASSERT( params->wVec, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL );
ASSERT( params->wVec->data, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL );
ASSERT( params->wtildeVec, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL );
ASSERT( params->wtildeVec->data, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL );
ASSERT( params->tmpltPowerVec, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL );
ASSERT( params->tmpltPowerVec->data, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL );
/* check that the fft plans exist */
ASSERT( params->fwdPlan, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL );
ASSERT( params->invPlan, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL );
/* check that the parameter values are reasonable */
ASSERT( params->fLow >= 0, status,
FINDCHIRPSPH_EFLOW, FINDCHIRPSPH_MSGEFLOW );
ASSERT( params->dynRange > 0, status,
FINDCHIRPSPH_EDYNR, FINDCHIRPSPH_MSGEDYNR );
/* check that the input exists */
ASSERT( dataSegVec, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL
": dataSegVec" );
ASSERT( dataSegVec->data, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL
": dataSegVec->data" );
ASSERT( dataSegVec->data->chan, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL
": dataSegVec->data->chan" );
ASSERT( dataSegVec->data->chan->data, status,
FINDCHIRPSPH_ENULL, FINDCHIRPSPH_MSGENULL
": dataSegVec->data->chan->data" );
/* check that the parameter structure is set */
/* to the correct waveform approximant */
if ( params->approximant != FindChirpSP )
{
ABORT( status, FINDCHIRPSPH_EMAPX, FINDCHIRPSPH_MSGEMAPX );
}
/*
*
* set up local segment independent pointers
*
*/
w = params->wVec->data;
amp = params->ampVec->data;
wtilde = params->wtildeVec->data;
tmpltPower = params->tmpltPowerVec->data;
/* allocate memory to store some temporary info for the
continous chisq test */
fcSeg = &(fcSegVec->data[0]);
fftVec = XLALCreateCOMPLEX8Vector( fcSeg->data->data->length );
/*
*
* loop over data segments
*
*/
for ( i = 0; i < dataSegVec->length; ++i )
{
/*
*
* set up segment dependent pointers
*
*/
dataSeg = &(dataSegVec->data[i]);
fcSeg = &(fcSegVec->data[i]);
dataVec = dataSeg->chan->data;
spec = dataSeg->spec->data->data;
resp = dataSeg->resp->data->data;
outputData = fcSeg->data->data->data;
dataPower = fcSeg->dataPower->data;
ASSERT( params->wtildeVec->length == fcSeg->data->data->length, status,
FINDCHIRPSPH_EMISM, FINDCHIRPSPH_MSGEMISM );
/* store the waveform approximant in the data segment */
fcSeg->approximant = params->approximant;
/*
*
* compute htilde and store in fcSeg
*
*/
LALForwardRealFFT( status->statusPtr, fcSeg->data->data,
dataVec, params->fwdPlan );
CHECKSTATUSPTR( status );
/* compute strain */
for ( k = 0; k < fcSeg->data->data->length; ++k )
{
REAL4 p = crealf(outputData[k]);
REAL4 q = cimagf(outputData[k]);
REAL4 x = crealf(resp[k]) * params->dynRange;
REAL4 y = cimagf(resp[k]) * params->dynRange;
outputData[k] = crectf( p*x - q*y, p*y + q*x );
}
/*
*
* compute inverse power spectrum
*
*/
/* set low frequency cutoff inverse power spectrum */
cut = params->fLow / dataSeg->spec->deltaF > 1 ?
params->fLow / dataSeg->spec->deltaF : 1;
snprintf( infoMsg, XLAL_NUM_ELEM(infoMsg),
"low frequency cut off index = %d\n", cut );
LALInfo( status, infoMsg );
/* set inverse power spectrum to zero */
memset( wtilde, 0, params->wtildeVec->length * sizeof(COMPLEX8) );
/* compute inverse of S_v */
for ( k = cut; k < params->wtildeVec->length; ++k )
{
if ( spec[k] == 0 )
{
ABORT( status, FINDCHIRPSPH_EDIVZ, FINDCHIRPSPH_MSGEDIVZ );
}
wtilde[k] = crectf( 1.0 / spec[k], cimagf(wtilde[k]) );
}
/*
*
* truncate inverse power spectrum in time domain if required
*
*/
if ( params->invSpecTrunc )
{
/* compute square root of inverse power spectrum */
for ( k = cut; k < params->wtildeVec->length; ++k )
{
wtilde[k] = crectf( sqrt( crealf(wtilde[k]) ), cimagf(wtilde[k]) );
}
/* set nyquist and dc to zero */
wtilde[params->wtildeVec->length-1] = crectf( 0.0, cimagf(wtilde[params->wtildeVec->length-1]) );
wtilde[0] = crectf( 0.0, cimagf(wtilde[0]) );
/* transform to time domain */
LALReverseRealFFT( status->statusPtr, params->wVec, params->wtildeVec,
params->invPlan );
CHECKSTATUSPTR (status);
/* truncate in time domain */
memset( w + params->invSpecTrunc/2, 0,
(params->wVec->length - params->invSpecTrunc) * sizeof(REAL4) );
/* transform to frequency domain */
LALForwardRealFFT( status->statusPtr, params->wtildeVec, params->wVec,
params->fwdPlan );
CHECKSTATUSPTR (status);
/* normalise fourier transform and square */
{
REAL4 norm = 1.0 / (REAL4) params->wVec->length;
for ( k = cut; k < params->wtildeVec->length; ++k )
{
wtilde[k] = crectf( crealf(wtilde[k]) * ( norm ), cimagf(wtilde[k]) );
wtilde[k] = crectf( crealf(wtilde[k]) * ( crealf(wtilde[k]) ), cimagf(wtilde[k]) );
wtilde[k] = crectf( crealf(wtilde[k]), 0.0 );
}
}
/* set nyquist and dc to zero */
wtilde[params->wtildeVec->length-1] = crectf( 0.0, cimagf(wtilde[params->wtildeVec->length-1]) );
wtilde[0] = crectf( 0.0, cimagf(wtilde[0]) );
}
/* set inverse power spectrum below cut to zero */
memset( wtilde, 0, cut * sizeof(COMPLEX8) );
/* convert from S_v to S_h */
for ( k = cut; k < params->wtildeVec->length; ++k )
{
REAL4 respRe = crealf(resp[k]) * params->dynRange;
REAL4 respIm = cimagf(resp[k]) * params->dynRange;
REAL4 modsqResp = (respRe * respRe + respIm * respIm);
REAL4 invmodsqResp;
if ( modsqResp == 0 )
{
ABORT( status, FINDCHIRPSPH_EDIVZ, FINDCHIRPSPH_MSGEDIVZ );
}
invmodsqResp = 1.0 / modsqResp;
wtilde[k] = crectf( crealf(wtilde[k]) * ( invmodsqResp ), cimagf(wtilde[k]) );
}
/*
*
* compute segment normalisation, outputData, point fcSeg at data segment
*
*/
for ( k = 0; k < cut; ++k )
{
outputData[k] = 0.0;
}
for ( k = 0; k < cut; ++k )
{
fftVec->data[k] = 0.0;
}
memset( tmpltPower, 0, params->tmpltPowerVec->length * sizeof(REAL4) );
memset( fcSeg->segNorm->data, 0, fcSeg->segNorm->length * sizeof(REAL4) );
fcSeg->tmpltPowerVec = params->tmpltPowerVec;
segNormSum = 0.0;
for ( k = 1; k < fcSeg->data->data->length; ++k )
{
tmpltPower[k] = amp[k] * amp[k] * crealf(wtilde[k]);
segNormSum += tmpltPower[k];
fcSeg->segNorm->data[k] = segNormSum;
}
/* Compute whitened data for continous chisq test */
for ( k = 0; k < fcSeg->data->data->length; ++k )
{
fftVec->data[k] = crectf( crealf(outputData[k]) * sqrt( crealf(wtilde[k]) ), cimagf(outputData[k]) * sqrt( crealf(wtilde[k]) ) );
}
/* get the whitened time series */
LALReverseRealFFT( status->statusPtr, dataPower, fftVec,
params->invPlan );
dataPower->data[0] = 0;
/* compute the cumulative power used for the continous
chisq test */
for ( k = 1; k < dataPower->length; k++ )
{
dataPower->data[k] =
dataPower->data[k-1] +
dataPower->data[k] * dataPower->data[k];
}
/* hard wired to quarter segment !! */
startIX = floor(1.0/4.0 * (REAL4) dataPower->length + 0.5);
endIX = floor(3.0/4.0 * (REAL4) dataPower->length + 0.5);
/* compute the total power in the uncorrupted data */
dataPower->data[dataPower->length - 1 ] = 2.0 *
(dataPower->data[endIX] - dataPower->data[startIX]);
for ( k = cut; k < fcSeg->data->data->length; ++k )
{
outputData[k] *= ((REAL4) crealf(wtilde[k]) * amp[k]);
}
/* set output frequency series parameters */
strncpy( fcSeg->data->name, dataSeg->chan->name, LALNameLength );
fcSeg->data->epoch.gpsSeconds = dataSeg->chan->epoch.gpsSeconds;
fcSeg->data->epoch.gpsNanoSeconds = dataSeg->chan->epoch.gpsNanoSeconds;
fcSeg->data->f0 = dataSeg->chan->f0;
fcSeg->data->deltaF = 1.0 /
( (REAL8) dataSeg->chan->data->length * dataSeg->chan->deltaT ) ;
fcSeg->deltaT = dataSeg->chan->deltaT;
fcSeg->number = dataSeg->number;
fcSeg->analyzeSegment = dataSeg->analyzeSegment;
/* store low frequency cutoff and invSpecTrunc in segment */
fcSeg->fLow = params->fLow;
fcSeg->invSpecTrunc = params->invSpecTrunc;
} /* end loop over data segments */
/* Find the min power from the whitened time series */
/* For the continuous chisq test */
fcSeg = &(fcSegVec->data[0]);
PSDsum = fcSeg->dataPower->data->data[fcSeg->dataPower->data->length - 1 ];
for ( i = 1; i < dataSegVec->length; ++i )
{
fcSeg = &(fcSegVec->data[i]);
if
(
((fcSeg->dataPower->data->data[fcSeg->dataPower->data->length - 1 ] < PSDsum) &&
(fcSeg->dataPower->data->data[fcSeg->dataPower->data->length - 1 ] > 0))
||
PSDsum == 0
)
{
PSDsum = fcSeg->dataPower->data->data[fcSeg->dataPower->data->length - 1 ];
}
}
/* reset each dataPower's last element to the min power */
for ( i = 0; i < dataSegVec->length; ++i )
{
fcSeg = &(fcSegVec->data[i]);
fcSeg->dataPower->data->data[fcSeg->dataPower->data->length - 1 ] = PSDsum;
}
/* clean up the data used for the continous chisq test */
XLALDestroyCOMPLEX8Vector( fftVec );
/* normal exit */
DETATCHSTATUSPTR( status );
RETURN( status );
}
int main( int argc, char *argv[] )
{
static LALStatus status;
RealFFTPlan *fwd = NULL;
RealFFTPlan *rev = NULL;
REAL4Vector *dat = NULL;
REAL4Vector *rfft = NULL;
REAL4Vector *ans = NULL;
COMPLEX8Vector *dft = NULL;
COMPLEX8Vector *fft = NULL;
#if LAL_CUDA_ENABLED
/* The test itself should pass at 1e-4, but it might fail at
* some rare cases where accuracy is bad for some numbers. */
REAL8 eps = 3e-4;
#else
/* very conservative floating point precision */
REAL8 eps = 1e-6;
#endif
REAL8 lbn;
REAL8 ssq;
REAL8 var;
REAL8 tol;
UINT4 nmax;
UINT4 m;
UINT4 n;
UINT4 i;
UINT4 j;
UINT4 k;
UINT4 s = 0;
FILE *fp;
ParseOptions( argc, argv );
m = m_;
n = n_;
fp = verbose ? stdout : NULL ;
if ( n == 0 )
{
nmax = 65536;
}
else
{
nmax = n--;
}
while ( n < nmax )
{
if ( n < 128 )
{
++n;
}
else
{
n *= 2;
}
LALSCreateVector( &status, &dat, n );
TestStatus( &status, CODES( 0 ), 1 );
LALSCreateVector( &status, &rfft, n );
TestStatus( &status, CODES( 0 ), 1 );
LALSCreateVector( &status, &ans, n );
TestStatus( &status, CODES( 0 ), 1 );
LALCCreateVector( &status, &dft, n / 2 + 1 );
TestStatus( &status, CODES( 0 ), 1 );
LALCCreateVector( &status, &fft, n / 2 + 1 );
TestStatus( &status, CODES( 0 ), 1 );
LALCreateForwardRealFFTPlan( &status, &fwd, n, 0 );
TestStatus( &status, CODES( 0 ), 1 );
LALCreateReverseRealFFTPlan( &status, &rev, n, 0 );
TestStatus( &status, CODES( 0 ), 1 );
/*
*
* Do m trials of random data.
*
*/
for ( i = 0; i < m; ++i )
{
srand( s++ ); /* seed the random number generator */
/*
*
* Create data and compute error tolerance.
*
* Reference: Kaneko and Liu,
* "Accumulation of round-off error in fast fourier tranforms"
* J. Asssoc. Comp. Mach, Vol 17 (No 4) 637-654, October 1970.
*
*/
srand( i ); /* seed the random number generator */
ssq = 0;
for ( j = 0; j < n; ++j )
{
dat->data[j] = 20.0 * rand() / (REAL4)( RAND_MAX + 1.0 ) - 10.0;
ssq += dat->data[j] * dat->data[j];
fp ? fprintf( fp, "%e\n", dat->data[j] ) : 0;
}
lbn = log( n ) / log( 2 );
var = 2.5 * lbn * eps * eps * ssq / n;
tol = 5 * sqrt( var ); /* up to 5 sigma excursions */
fp ? fprintf( fp, "\neps = %e \ntol = %e\n", eps, tol ) : 0;
/*
*
* Perform forward FFT and DFT (only if n < 100).
*
*/
LALForwardRealFFT( &status, fft, dat, fwd );
TestStatus( &status, CODES( 0 ), 1 );
LALREAL4VectorFFT( &status, rfft, dat, fwd );
TestStatus( &status, CODES( 0 ), 1 );
LALREAL4VectorFFT( &status, ans, rfft, rev );
TestStatus( &status, CODES( 0 ), 1 );
fp ? fprintf( fp, "rfft()\t\trfft(rfft())\trfft(rfft())\n\n" ) : 0;
for ( j = 0; j < n; ++j )
{
fp ? fprintf( fp, "%e\t%e\t%e\n",
rfft->data[j], ans->data[j], ans->data[j] / n ) : 0;
}
if ( n < 128 )
{
LALForwardRealDFT( &status, dft, dat );
TestStatus( &status, CODES( 0 ), 1 );
/*
*
* Check accuracy of FFT vs DFT.
*
*/
fp ? fprintf( fp, "\nfftre\t\tfftim\t\t" ) : 0;
fp ? fprintf( fp, "dtfre\t\tdftim\n" ) : 0;
for ( k = 0; k <= n / 2; ++k )
{
REAL8 fftre = creal(fft->data[k]);
REAL8 fftim = cimag(fft->data[k]);
REAL8 dftre = creal(dft->data[k]);
REAL8 dftim = cimag(dft->data[k]);
REAL8 errre = fabs( dftre - fftre );
REAL8 errim = fabs( dftim - fftim );
REAL8 avere = fabs( dftre + fftre ) / 2 + eps;
REAL8 aveim = fabs( dftim + fftim ) / 2 + eps;
REAL8 ferre = errre / avere;
REAL8 ferim = errim / aveim;
fp ? fprintf( fp, "%e\t%e\t", fftre, fftim ) : 0;
fp ? fprintf( fp, "%e\t%e\n", dftre, dftim ) : 0;
/* fp ? fprintf( fp, "%e\t%e\t", errre, errim ) : 0; */
/* fp ? fprintf( fp, "%e\t%e\n", ferre, ferim ) : 0; */
if ( ferre > eps && errre > tol )
{
fputs( "FAIL: Incorrect result from forward transform\n", stderr );
fprintf( stderr, "\tdifference = %e\n", errre );
fprintf( stderr, "\ttolerance = %e\n", tol );
fprintf( stderr, "\tfrac error = %e\n", ferre );
fprintf( stderr, "\tprecision = %e\n", eps );
return 1;
}
if ( ferim > eps && errim > tol )
{
fputs( "FAIL: Incorrect result from forward transform\n", stderr );
fprintf( stderr, "\tdifference = %e\n", errim );
fprintf( stderr, "\ttolerance = %e\n", tol );
fprintf( stderr, "\tfrac error = %e\n", ferim );
fprintf( stderr, "\tprecision = %e\n", eps );
return 1;
}
}
}
/*
*
* Perform reverse FFT and check accuracy vs original data.
*
*/
LALReverseRealFFT( &status, ans, fft, rev );
TestStatus( &status, CODES( 0 ), 1 );
fp ? fprintf( fp, "\ndat->data[j]\tans->data[j] / n\n" ) : 0;
for ( j = 0; j < n; ++j )
{
REAL8 err = fabs( dat->data[j] - ans->data[j] / n );
REAL8 ave = fabs( dat->data[j] + ans->data[j] / n ) / 2 + eps;
REAL8 fer = err / ave;
fp ? fprintf( fp, "%e\t%e\n", dat->data[j], ans->data[j] / n ) : 0;
/* fp ? fprintf( fp, "%e\t%e\n", err, fer ) : 0; */
if ( fer > eps && err > tol )
{
fputs( "FAIL: Incorrect result after reverse transform\n", stderr );
fprintf( stderr, "\tdifference = %e\n", err );
fprintf( stderr, "\ttolerance = %e\n", tol );
fprintf( stderr, "\tfrac error = %e\n", fer );
fprintf( stderr, "\tprecision = %e\n", eps );
return 1;
}
}
}
LALSDestroyVector( &status, &dat );
TestStatus( &status, CODES( 0 ), 1 );
LALSDestroyVector( &status, &rfft );
TestStatus( &status, CODES( 0 ), 1 );
LALSDestroyVector( &status, &ans );
TestStatus( &status, CODES( 0 ), 1 );
LALCDestroyVector( &status, &dft );
TestStatus( &status, CODES( 0 ), 1 );
LALCDestroyVector( &status, &fft );
TestStatus( &status, CODES( 0 ), 1 );
LALDestroyRealFFTPlan( &status, &fwd );
TestStatus( &status, CODES( 0 ), 1 );
LALDestroyRealFFTPlan( &status, &rev );
TestStatus( &status, CODES( 0 ), 1 );
}
LALCheckMemoryLeaks();
return 0;
}
