double gennch(lua_RNG *o,double df,double xnonc)
/*
**********************************************************************
Generate random value of Noncentral CHIsquare variable
Function
Generates random deviate from the distribution of a noncentral
chisquare with DF degrees of freedom and noncentrality parameter
xnonc.
Arguments
df --> Degrees of freedom of the chisquare
(Must be > 1.0)
xnonc --> Noncentrality parameter of the chisquare
(Must be >= 0.0)
Method
Uses fact that noncentral chisquare is the sum of a chisquare
deviate with DF-1 degrees of freedom plus the square of a normal
deviate with mean XNONC and standard deviation 1.
**********************************************************************
*/
{
static double gennch;
if(!(df <= 1.0 || xnonc < 0.0)) goto S10;
fputs("DF <= 1 or XNONC < 0 in GENNCH - ABORT",stderr);
fprintf(stderr,"Value of DF: %16.6E Value of XNONC%16.6E\n",df,xnonc);
exit(1);
S10:
gennch = genchi(o,df-1.0)+pow(gennor(o,sqrt(xnonc),1.0),2.0);
return gennch;
}
static int rnorm_rng (lua_State *L) {
nl_RNG *r = getrng(L);
lua_Number mean = luaL_optnumber(L, 1, 0);
lua_Number sd = luaL_optnumber(L, 2, 1);
checknp(L, sd);
setdeviate(number, gennor(r, mean, sd), 3);
return 1;
}
void sdesim(integer itraj, integer ntraj)
/* Integrate a stochastic differential equation */
{
integer flag, indx, i, j, k, l, m, N;
real t, xnorm2;
real temp, tempr, tempi, tl, tmp;
top = Ith(tlist, 1);
head = 0;
N = RHS.N;
for (j = 1; j <= 2 * N; j++)
Ith(y, j) = Ith(ystart, j);
/* Initialize ODE solver */
ropt[HMAX] = dt;
cvode_mem = CVodeMalloc(2 * N, derivs, Ith(tlist, 1), y,
(method == 0) ? ADAMS : BDF,
(itertype == 0) ? FUNCTIONAL : NEWTON,
(nabstol == 1) ? SS : SV,
&reltol, abstolp, NULL, NULL, TRUE, iopt, ropt, NULL);
if (cvode_mem == NULL) {
fatal_error("CVodeMalloc failed.\n");
}
/* Call CVDiag */
CVDiag(cvode_mem);
if (nopers == 0)
fwrite(&itraj, sizeof(integer), 1, op);
if (photocurflag)
fwrite(&itraj, sizeof(integer), 1, php);
if (clrecflag) {
temp = itraj;
fwrite(&temp, sizeof(real), 1, cp);
temp = 0.0;
fwrite(&temp, sizeof(real), 1, cp);
}
m = 1;
tl = Ith(tlist, 1);
if (nopers == 0) /* Write the wave function */
fwrite(N_VDATA(y), sizeof(real), 2 * N, op);
else /* Record operator expectations in
* accumulation buffer */
operAccum(N_VDATA(y) - 1, q, N, tl, 1);
for (i = 2; i <= ntimes; i++) {
for (k = 1; k <= nhomodyne; k++) /* Initialize buffers for
* photocurrent records */
h**o[k] = 0;
for (k = 1; k <= nheterodyne; k++)
heteror[k] = heteroi[k] = 0;
for (l = 1; l <= refine; l++) {
for (k = 1; k <= nhomodyne; k++)
Ith(homnoise, k) = gennor(0.0, namplr);
for (k = 1; k <= nheterodyne; k++) {
Ith(hetnoiser, k) = gennor(0.0, namplc);
Ith(hetnoisei, k) = gennor(0.0, namplc);
}
tl = Ith(tlist, i - 1) + (l - 1) * dt;
flag = CVodeRestart(cvode_mem, tl, y);
if (flag != SUCCESS) {
sprintf(errmsg, "CVodeRestart failed, flag=%d.\n", flag);
fatal_error(errmsg);
}
flag = CVode(cvode_mem, tl + dt, y, &t, NORMAL);
if (flag != SUCCESS) {
sprintf(errmsg, "CVode failed, flag=%d.\n", flag);
fatal_error(errmsg);
}
/* Evaluate photocurrent during the previous interval */
xnorm2 = norm2(N_VDATA(y) - 1, N);
for (k = 1; k <= nhomodyne; k++) {
FSmul(&homodyne[k], tl, N_VDATA(y) - 1, q); /* Calculate homodyne
* terms */
inprod(N_VDATA(y) - 1, q, N, &tempr, &tempi);
temp = 2 * tempr / xnorm2;
if (photocurflag) {
h**o[k] += (temp + Ith(homnoise, k));
if (l == refine) {
tmp = h**o[k] / refine;
fwrite(&tmp, sizeof(real), 1, php);
}
}
}
for (k = 1; k <= nheterodyne; k++) {
FSmul(&heterodyne[k], tl, N_VDATA(y) - 1, q); /* Calculate heterodyne
* terms */
inprod(N_VDATA(y) - 1, q, N, &tempr, &tempi);
tempr = tempr / xnorm2;
tempi = -tempi / xnorm2;
if (photocurflag) {
heteror[k] += (tempr + Ith(hetnoiser, k));
heteroi[k] += (tempi + Ith(hetnoisei, k));
if (l == refine) {
tmp = heteror[k] / refine;
fwrite(&tmp, sizeof(real), 1, php);
tmp = heteroi[k] / refine;
fwrite(&tmp, sizeof(real), 1, php);
}
}
}
}
/* Normalize the wave function */
xnorm2 = 1. / sqrt(norm2(N_VDATA(y) - 1, N));
for (j = 1; j <= 2 * N; j++)
pl[j] = Ith(y, j) * xnorm2;
if (nopers == 0)
fwrite(&pl[1], sizeof(real), 2 * N, op);
else
operAccum(pl, q, N, tl, i);
if (xnorm2 < 1e-6 || xnorm2 > 1e6) { /* Restart integrator if norm
* is too large or small */
CVodeFree(cvode_mem);
ropt[HMAX] = dt;
for (j = 1; j <= 2 * N; j++)
Ith(y, j) = pl[j];
cvode_mem = CVodeMalloc(2 * N, derivs, Ith(tlist, 1), y,
(method == 0) ? ADAMS : BDF,
(itertype == 0) ? FUNCTIONAL : NEWTON,
(nabstol == 1) ? SS : SV,
&reltol, abstolp, NULL, NULL, TRUE, iopt, ropt, NULL);
if (cvode_mem == NULL) {
fatal_error("CVodeMalloc failed.\n");
}
/* Call CVDiag */
CVDiag(cvode_mem);
}
progress += NHASH;
while (progress >= (ntimes - 1) * ntraj) {
fprintf(stderr, "#");
progress -= (ntimes - 1) * ntraj;
}
}
CVodeFree(cvode_mem);
}
int main(int argc, char *argv[])
{
float *data1, *data2;
fcomplex *ptr1, *ptr2;
long n, npts, tmp = 0, ct, plimit, prn = 0;
long i, isign = -1;
double err = 0.0;
#if defined USERAWFFTW
FILE *wisdomfile;
fftw_plan plan_forward, plan_inverse;
static char wisdomfilenm[120];
#endif
struct tms runtimes;
double ttim, stim, utim, tott;
if (argc <= 1 || argc > 4) {
printf("\nUsage: testffts [sign (1/-1)] [print (0/1)] [frac err tol]\n\n");
exit(0);
} else if (argc == 2) {
isign = atoi(argv[1]);
prn = 0;
err = 0.02;
} else if (argc == 3) {
isign = atoi(argv[1]);
prn = atoi(argv[2]);
err = 0.02;
}
if (argc == 4) {
isign = atoi(argv[1]);
prn = atoi(argv[2]);
err = atof(argv[3]);
}
/* import the wisdom for FFTW */
#if defined USERAWFFTW
sprintf(wisdomfilenm, "%s/fftw_wisdom.txt", DATABASE);
wisdomfile = fopen(wisdomfilenm, "r");
if (wisdomfile == NULL) {
printf("Error opening '%s'. Run makewisdom again.\n", \
wisdomfilenm);
printf("Exiting.\n");
exit(1);
}
if (FFTW_FAILURE == fftw_import_wisdom_from_file(wisdomfile)) {
printf("Error importing FFTW wisdom.\n");
printf("Exiting.\n");
exit(1);
}
fclose(wisdomfile);
#endif
for (i = 0; i <= 8; i++) {
/* npts = 1 << (i + 14); # of points in FFT */
/* npts = 1 << 16; # of points in FFT */
/* npts = 4096; # of points in FFT */
/* npts = 524288; # of points in FFT */
npts = 300000 * (i + 1);
n = npts << 1; /* # of float vals */
data1 = gen_fvect(n);
data2 = gen_fvect(n);
ptr1 = (fcomplex *)data1;
ptr2 = (fcomplex *)data2;
/* make the data = {1,1,1,1,-1,-1,-1,-1} (all real) */
/*
for (ct = 0; ct < npts/2; ct++) {
tmp = 2 * ct;
data1[tmp] = 1.0;
data1[tmp + 1] = 0.0;
data1[tmp + npts] = -1.0;
data1[tmp + npts + 1] = 0.0;
data2[tmp] = 1.0;
data2[tmp + 1] = 0.0;
data2[tmp + npts] = -1.0;
data2[tmp + npts + 1] = 0.0;
}
*/
/* make the data a sin wave of fourier freq 12.12345... */
/*
for (ct = 0; ct < npts; ct++) {
tmp = 2 * ct;
data1[tmp] = sin(2.0*3.14159265358979*ct*12.12345/npts)+1.0;
data2[tmp] = data1[tmp];
data1[tmp+1] = 0.0;
data2[tmp+1] = data1[tmp+1];
}
*/
/* make the data a sin wave of fourier freq 12.12345... with noise */
for (ct = 0; ct < npts; ct++) {
tmp = 2 * ct;
data1[tmp] = 10.0 * sin(TWOPI * ct * 12.12345 / npts) + 100.0;
data1[tmp] = gennor(data1[tmp], 10.0);
data2[tmp] = data1[tmp];
data1[tmp + 1] = gennor(100.0, 10.0);
data2[tmp + 1] = data1[tmp + 1];
}
printf("\nCalculating...\n");
/* The challenger... */
tott = times(&runtimes) / (double) CLK_TCK;
utim = runtimes.tms_utime / (double) CLK_TCK;
stim = runtimes.tms_stime / (double) CLK_TCK;
tablesixstepfft(ptr1, npts, isign);
/* tablesixstepfft(plan1, plan2, ptr1, npts, isign); */
/* sixstepfft(ptr1, npts, isign); */
/* four1(ptr1 - 1, npts, isign); */
/* tablefft(ptr1, npts, isign); */
/* tablesplitfft(ptr1, npts, isign); */
/* realfft(ptr1, n, isign); */
/* fftw(plan, 1, in, 1, 0, out, 1, 0); */
tott = times(&runtimes) / (double) CLK_TCK - tott;
printf("Timing summary (Ransom) npts = %ld:\n", npts);
utim = runtimes.tms_utime / (double) CLK_TCK - utim;
stim = runtimes.tms_stime / (double) CLK_TCK - stim;
ttim = utim + stim;
printf("CPU usage: %.3f sec total (%.3f sec user, %.3f sec system)\n", \
ttim, utim, stim);
printf("Total time elapsed: %.3f sec.\n\n", tott);
/* The "Standard" FFT... */
/* The following is for the fftw FFT */
/* Create new plans */
#if defined USERAWFFTW
plan_forward = fftw_create_plan(npts, -1, FFTW_MEASURE | \
FFTW_USE_WISDOM | \
FFTW_IN_PLACE);
plan_inverse = fftw_create_plan(npts, +1, FFTW_MEASURE | \
FFTW_USE_WISDOM | \
FFTW_IN_PLACE);
#endif
tott = times(&runtimes) / (double) CLK_TCK;
utim = runtimes.tms_utime / (double) CLK_TCK;
stim = runtimes.tms_stime / (double) CLK_TCK;
/* four1(ptr2 - 1, npts, isign); */
/* tablefft(ptr2, npts, isign); */
/* tablesplitfft(ptr1, npts, isign); */
/* tablesixstepfft(ptr2, npts, isign); */
/* realft(ptr2 - 1, n, isign); */
fftwcall(ptr2, npts, -1);
#if defined USERAWFFTW
if (isign == -1) {
fftw(plan_forward, 1, (FFTW_COMPLEX *) ptr2, 1, 1, NULL, 1, 1);
} else {
fftw(plan_inverse, 1, (FFTW_COMPLEX *) ptr2, 1, 1, NULL, 1, 1);
}
#endif
tott = times(&runtimes) / (double) CLK_TCK - tott;
printf("Timing summary (FFTW) npts = %ld:\n", npts);
utim = runtimes.tms_utime / (double) CLK_TCK - utim;
stim = runtimes.tms_stime / (double) CLK_TCK - stim;
ttim = utim + stim;
printf("CPU usage: %.3f sec total (%.3f sec user, %.3f sec system)\n", \
ttim, utim, stim);
printf("Total time elapsed: %.3f sec.\n\n", tott);
/* The following is for the fftw FFT */
#if defined USERAWFFTW
fftw_destroy_plan(plan_forward);
fftw_destroy_plan(plan_inverse);
#endif
/* Check if correct with fractional errors... */
for (ct = 0; ct < n; ct++) {
if (data2[ct] != 0.0) {
if (fabs((1.0 - (data1[ct] / data2[ct]))) > err) {
if ((ct % 2) == 1) {
printf("Values at freq %ld do not match to %4.2f%% fractional error:\n", (ct - 1) / 2, err * 100);
printf(" rl1 = %f im1 = %f rl2 = %f im2 = %f\n",
data1[ct - 1], data1[ct], data2[ct - 1], data2[ct]);
} else {
printf("Values at freq %ld do not match to %4.2f%% fractional error:\n", ct / 2, err * 100);
printf(" rl1 = %f im1 = %f rl2 = %f im2 = %f\n", data1[ct],
data1[ct + 1], data2[ct], data2[ct + 1]);
}
}
}
}
if (npts >= 64)
plimit = 64;
else
plimit = npts;
/* Print the output... */
if (prn) {
printf("\n #1: Challenger FFT... ");
printf("#2: Standard...\n");
for (ct = 0; ct < plimit; ct++) {
printf(" %3ld rl = %12.3f ", ct, data1[2 * ct]);
printf("im = %12.3f rl = %12.3f im = %12.3f\n", \
data1[2 * ct + 1], data2[2 * ct], data2[2 * ct + 1]);
}
}
free(data1);
free(data2);
}
return 0;
}
static int rmvnorm_rng (lua_State *L) {
nl_RNG *r = getrng(L);
nl_Matrix *m = nl_checkmatrix(L, 1);
nl_Matrix *S = nl_checkmatrix(L, 2);
nl_Matrix *u;
int i, n = m->size;
lua_Number *em, *ev, *eu;
/* check args */
checkrvector(L, m, 1);
luaL_argcheck(L, !S->iscomplex, 2, "real matrix expected");
if (S->ndims == 1) {
luaL_argcheck(L, S->size == n, 2, "arguments are not conformable");
for (i = 0, ev = S->data; i < n; i++, ev += S->stride)
luaL_argcheck(L, *ev > 0, 2, "variance is not positive");
}
else
luaL_argcheck(L, S->ndims == 2 && S->dim[0] == n && S->dim[1] == n, 2,
"arguments are not conformable");
/* setup destination */
lua_settop(L, 3);
if (lua_isnil(L, 3))
u = nl_pushmatrix(L, 0, 1, &n, 1, n,
lua_newuserdata(L, n * sizeof(lua_Number)));
else {
u = nl_checkmatrix(L, 3);
checkrvector(L, u, 3);
luaL_argcheck(L, u->size == n, 3, "arguments are not conformable");
}
/* sample */
if (S->ndims == 1) {
em = m->data; ev = S->data; eu = u->data;
for (i = 0; i < n; i++) {
*eu = gennor(r, *em, *ev);
em += m->stride; ev += S->stride; eu += u->stride;
}
}
else {
char uplo = 'L', trans = 'N', diag = 'N';
lua_Number one = 1.0;
/* u ~ N(0, I_n) */
eu = u->data;
for (i = 0; i < n; i++, eu += u->stride)
*eu = gennor(r, 0, 1);
/* u = S * u */
if (S->stride != 1 /* non-unitary stride? */
|| (S->section != NULL /* non-block section? */
&& (S->section[0].step != 1 || S->section[1].step != 1))) {
nl_Buffer *buf = nl_getbuffer(L, n * n);
/* copy S to buffer */
for (i = 0; i < S->size; i++)
buf->data.bnum[i] = S->data[nl_mshift(S, i)];
DTRMV(&uplo, &trans, &diag, &n, buf->data.bnum, &n,
u->data, &u->stride, 1, 1, 1);
nl_freebuffer(buf);
}
else {
int ld = S->section ? S->section[0].ld : S->dim[0];
DTRMV(&uplo, &trans, &diag, &n, S->data, &ld,
u->data, &u->stride, 1, 1, 1);
}
/* u = u + m */
DAXPY(&n, &one, m->data, &m->stride, u->data, &u->stride);
}
return 1;
}
int main (int argc, char *argv[]) {
int i, j;
int last_i;
// Original Lorenz equation result data
double lorenz[N][DIM];
// Calculation limits for vector variation
double strt[DIM];
double fnsh[DIM];
double base_x, base_y, base_z;
// Current element
double curr[DIM];
double next[DIM];
double tran[DIM];
double points_d, points_s;
double diff_d, diff_s;
double resolution;
double h, a, b, c;
double sigma, dw, rand;
// Distance from origin
double orig_dist;
double curr_dist;
// Report differences
double last_sum_diff;
double sum_diff;
FILE *output;
struct exp_header header;
h = 0.01;
a = 10.0;
b = 28.0;
c = 8.0/3.0;
if (argc != 8) {
fprintf(stderr, "Number of parameters incorrect: %d.\n", argc);
fprintf(stderr, "./%s x y z dr ds r file\n", argv[0]);
return -1;
}
// Initialize base execution elements
base_x = atof(argv[1]);
base_y = atof(argv[2]);
base_z = atof(argv[3]);
points_d = atof(argv[4]);
points_s = atof(argv[5]);
resolution = atof(argv[6]);
diff_d = resolution/points_d;
diff_s = 1.0/points_s;
// Initialize exploration limits
strt[X] = base_x - 1;
strt[Y] = base_y - 1;
strt[Z] = base_z - 1;
fnsh[X] = base_x + 1;
fnsh[Y] = base_y + 1;
fnsh[Z] = base_z + 1;
if ( (output = fopen(argv[7], "w")) == NULL) {
fprintf(stderr, "Results file creation failed.\n");
fclose(output);
return -1;
}
setall(SEED1, SEED2);
// Initialize the vector for Lorenz results
for (i = 0; i < N; i++)
for (j = 0; j < DIM; j++)
lorenz[i][j] = 0;
// Step 1: store the standard Lorenz equation
fprintf(stdout, "Calculating original Lorenz equations at %f, %f, %f.\n",
base_x, base_y, base_z);
curr[X] = base_x;
curr[Y] = base_y;
curr[Z] = base_z;
for (i = 0; i < N; i++) {
lorenz[i][X] = curr[X];
lorenz[i][Y] = curr[Y];
lorenz[i][Z] = curr[Z];
next[X] = curr[X] + h*a*(curr[Y] - curr[X]);
next[Y] = curr[Y] + h*(curr[X]*(b - curr[Z]) - curr[Y]);
next[Z] = curr[Z] + h*(curr[X]*curr[Y] - c*curr[Z]);
curr[X] = next[X];
curr[Y] = next[Y];
curr[Z] = next[Z];
}
// Print headers
fprintf(output, "X0 Y0 Z0 XK YK ZK sigma OD S NL XL YL ZL\n");
// Setp 2: calculate all possible scenarios and their accumulated difference
fprintf(stdout, "Parameter sweep...\n");
for (j = 0; j < RAND_ITERS; j++) {
fprintf(stdout, "Iteration %i \n", j);
// Reset for each run
curr[X] = strt[X];
curr[Y] = strt[Y];
curr[Z] = strt[Z];
while (curr[X] <= fnsh[X]) {
while (curr[Y] <= fnsh[Y]) {
while (curr[Z] <= fnsh[Z]) {
// Calculate distance from origin to current scenario
orig_dist = distance(base_x, curr[X], base_y, curr[Y],
base_z, curr[Z]);
#pragma omp parallel for
for (sigma = 0; sigma <= 1.0; sigma += diff_s) {
// Difference starts at 0
sum_diff = 0;
// Calculation and comparison against Lorenz
tran[X] = curr[X];
tran[Y] = curr[Y];
tran[Z] = curr[Z];
for (i = 0; i < N; i++) {
last_sum_diff = sum_diff;
sum_diff += distance(lorenz[i][X], tran[X],
lorenz[i][Y], tran[Y],
lorenz[i][Z], tran[Z]);
if(! isfinite(sum_diff)) {
sum_diff = last_sum_diff;
i = i - 1;
break;
}
rand = gennor(0, 1);
dw = sqrt(h)*rand;
next[X] = tran[X]
+ h*a*(tran[Y] - tran[X])
+ sigma*tran[X]*dw;
next[Y] = tran[Y]
+ h*(tran[X]*(b - tran[Z]) - tran[Y])
+ sigma*tran[Y]*dw;
next[Z] = tran[Z]
+ h*(tran[X]*tran[Y]
- c*tran[Z])
+ sigma*tran[Z]*dw;
tran[X] = next[X];
tran[Y] = next[Y];
tran[Z] = next[Z];
}
// Write results
#pragma omp atomic
fprintf(output, "%f %f %f %f %f %f %f %f %.7e %i %.7e %.7e %.7e\n",
base_x, base_y, base_z,
curr[X], curr[Y], curr[Z],
sigma, orig_dist, sum_diff,
i, tran[X], tran[Y], tran[Z]);
}
curr[Z] += diff_d;
}
curr[Z] = strt[Z];
curr[Y] += diff_d;
}
curr[Y] = strt[Y];
curr[X] += diff_d;
}
}
fclose(output);
return 0;
}
