/// Destructor.
CVodeInt::~CVodeInt()
{
if (m_cvode_mem) CVodeFree(m_cvode_mem);
if (m_y) N_VFree(nv(m_y));
if (m_abstol) N_VFree(nv(m_abstol));
delete[] m_iopt;
}
static void KINFreeVectors(KINMem kin_mem)
{
N_VFree(unew);
N_VFree(fval);
N_VFree(pp);
N_VFree(vtemp1);
N_VFree(vtemp2);
}
static boole KINAllocVectors(KINMem kin_mem, integer neq,
void *machEnv)
{
/* Allocate unew, fval, pp, vtemp1 and vtemp2
* Any future modifier of this code is advised to be wary
* --- watch scope carefully --
* unew, pp, vtemp1 and vtemp2 are used in more than one context */
unew = N_VNew(neq, machEnv);
if (unew == NULL)
return(FALSE);
fval = N_VNew(neq, machEnv);
if (fval == NULL)
{
N_VFree(unew);
return(FALSE);
}
pp = N_VNew(neq, machEnv);
if (pp == NULL)
{
N_VFree(unew);
N_VFree(fval);
return(FALSE);
}
vtemp1 = N_VNew(neq, machEnv);
if (vtemp1 == NULL)
{
N_VFree(unew);
N_VFree(fval);
N_VFree(pp);
return(FALSE);
}
vtemp2 = N_VNew(neq, machEnv);
if (vtemp2 == NULL)
{
N_VFree(unew);
N_VFree(fval);
N_VFree(pp);
N_VFree(vtemp1);
return(FALSE);
}
return(TRUE);
}
static void FreeVectorArray(N_Vector *A, int indMax)
{
int j;
for (j=0; j <= indMax; j++) N_VFree(A[j]);
free(A);
}
void CVodeInt::initialize(double t0, FuncEval& func)
{
m_neq = func.neq();
m_t0 = t0;
if (m_y) {
N_VFree(nv(m_y)); // free solution vector if already allocated
}
m_y = reinterpret_cast<void*>(N_VNew(m_neq, 0)); // allocate solution vector
// check abs tolerance array size
if (m_itol == 1 && m_nabs < m_neq)
throw CVodeErr("not enough absolute tolerance values specified.");
func.getInitialConditions(m_t0, m_neq, N_VDATA(nv(m_y)));
// set options
m_iopt[MXSTEP] = m_maxsteps;
m_iopt[MAXORD] = m_maxord;
m_ropt[HMAX] = m_hmax;
if (m_cvode_mem) CVodeFree(m_cvode_mem);
// pass a pointer to func in m_data
m_data = (void*)&func;
if (m_itol) {
m_cvode_mem = CVodeMalloc(m_neq, cvode_rhs, m_t0, nv(m_y), m_method,
m_iter, m_itol, &m_reltol,
nv(m_abstol), m_data, NULL, TRUE, m_iopt,
DATA_PTR(m_ropt), NULL);
}
else {
m_cvode_mem = CVodeMalloc(m_neq, cvode_rhs, m_t0, nv(m_y), m_method,
m_iter, m_itol, &m_reltol,
&m_abstols, m_data, NULL, TRUE, m_iopt,
DATA_PTR(m_ropt), NULL);
}
if (!m_cvode_mem) throw CVodeErr("CVodeMalloc failed.");
if (m_type == DENSE + NOJAC) {
CVDense(m_cvode_mem, NULL, NULL);
}
else if (m_type == DENSE + JAC) {
CVDense(m_cvode_mem, cvode_jac, NULL);
}
else if (m_type == DIAG) {
CVDiag(m_cvode_mem);
}
else if (m_type == GMRES) {
CVSpgmr(m_cvode_mem, NONE, MODIFIED_GS, 0, 0.0,
NULL, NULL, NULL);
}
else {
throw CVodeErr("unsupported option");
}
}
void SpgmrFree(SpgmrMem mem)
{
int i, l_max;
real **Hes;
if (mem == NULL) return;
l_max = mem->l_max;
Hes = mem->Hes;
FreeVectorArray(mem->V, l_max);
for (i=0; i <= l_max; i++) free(Hes[i]);
free(Hes);
free(mem->givens);
N_VFree(mem->xcor);
free(mem->yg);
N_VFree(mem->vtemp);
free(mem);
}
void CVodeInt::setTolerances(double reltol, int n, double* abstol) {
m_itol = 1;
m_nabs = n;
if (n != m_neq) {
if (m_abstol) N_VFree(nv(m_abstol));
m_abstol = reinterpret_cast<void*>(N_VNew(n, 0));
}
for (int i=0; i<n; i++) {
N_VIth(nv(m_abstol), i) = abstol[i];
}
m_reltol = reltol;
}
SpgmrMem SpgmrMalloc(integer N, int l_max, void *machEnv)
{
SpgmrMem mem;
N_Vector *V, xcor, vtemp;
real **Hes, *givens, *yg;
int k, i;
/* Check the input parameters */
if ((N <= 0) || (l_max <= 0)) return(NULL);
/* Get memory for the Krylov basis vectors V[0], ..., V[l_max] */
V = (N_Vector *) malloc((l_max+1)*sizeof(N_Vector));
if (V == NULL) return(NULL);
for (k=0; k <= l_max; k++) {
V[k] = N_VNew(N, (machEnvType)machEnv);
if (V[k] == NULL) {
FreeVectorArray(V, k-1);
return(NULL);
}
}
/* Get memory for the Hessenberg matrix Hes */
Hes = (real **) malloc((l_max+1)*sizeof(real *));
if (Hes == NULL) {
FreeVectorArray(V, l_max);
return(NULL);
}
for (k=0; k <= l_max; k++) {
Hes[k] = (real *) malloc(l_max*sizeof(real));
if (Hes[k] == NULL) {
for (i=0; i < k; i++) free(Hes[i]);
FreeVectorArray(V, l_max);
return(NULL);
}
}
/* Get memory for Givens rotation components */
givens = (real *) malloc(2*l_max*sizeof(real));
if (givens == NULL) {
for (i=0; i <= l_max; i++) free(Hes[i]);
FreeVectorArray(V, l_max);
return(NULL);
}
/* Get memory to hold the correction to z_tilde */
xcor = N_VNew(N, (machEnvType)machEnv);
if (xcor == NULL) {
free(givens);
for (i=0; i <= l_max; i++) free(Hes[i]);
FreeVectorArray(V, l_max);
return(NULL);
}
/* Get memory to hold SPGMR y and g vectors */
yg = (real *) malloc((l_max+1)*sizeof(real));
if (yg == NULL) {
N_VFree(xcor);
free(givens);
for (i=0; i <= l_max; i++) free(Hes[i]);
FreeVectorArray(V, l_max);
return(NULL);
}
/* Get an array to hold a temporary vector */
vtemp = N_VNew(N, (machEnvType)machEnv);
if (vtemp == NULL) {
free(yg);
N_VFree(xcor);
free(givens);
for (i=0; i <= l_max; i++) free(Hes[i]);
FreeVectorArray(V, l_max);
return(NULL);
}
/* Get memory for an SpgmrMemRec containing SPGMR matrices and vectors */
mem = (SpgmrMem) malloc(sizeof(SpgmrMemRec));
if (mem == NULL) {
N_VFree(vtemp);
free(yg);
N_VFree(xcor);
free(givens);
for (i=0; i <= l_max; i++) free(Hes[i]);
FreeVectorArray(V, l_max);
return(NULL);
}
/* Set the fields of mem */
mem->N = N;
mem->l_max = l_max;
mem->V = V;
mem->Hes = Hes;
mem->givens = givens;
mem->xcor = xcor;
mem->yg = yg;
mem->vtemp = vtemp;
/* Return the pointer to SPGMR memory */
return(mem);
}
integer main(integer argc, char *argv[])
{
integer i, j, l, code;
struct tm *newtime;
time_t long_time;
remove("success.qo");
remove("failure.qo");
if (argc <= 2) {
sprintf(errmsg, "Usage: %s infile outfile1 [outfile2]\n", argv[0]);
fatal_error(errmsg);
}
fp = fopen(argv[1], "rb");
if (fp == NULL) {
sprintf(errmsg, "Error reading problem definition file: %s\n", argv[1]);
fatal_error(errmsg);
}
op = fopen(argv[2], "wb");
if (op == NULL) {
sprintf(errmsg, "Error writing output file: %s\n", argv[2]);
fatal_error(errmsg);
}
photocurflag = (argc >= 4); /* Flag indicating if photocurrent record
* needed */
if (photocurflag) {
php = fopen(argv[3], "wb");
if (php == NULL) {
sprintf(errmsg, "Error writing output file: %s\n", argv[3]);
fatal_error(errmsg);
}
}
fread(&code, sizeof(integer), 1, fp);
if (code != 3001) {
sprintf(errmsg, "Invalid code in %s, expected %d, found %d.\n", argv[0], 3001, code);
fatal_error(errmsg);
}
fread(&N, sizeof(integer), 1, fp); /* Size of sparse matrices */
RHS.N = N;
fread(&RHS.nterms, sizeof(integer), 1, fp); /* Number of RHS terms */
fread(&nhomodyne, sizeof(integer), 1, fp); /* Number of homodyne
* operators */
homodyne = (struct FS *) calloc(nhomodyne, sizeof(struct FS));
homodyne--;
for (i = 1; i <= nhomodyne; i++) {
homodyne[i].N = N;
fread(&homodyne[i].nterms, sizeof(integer), 1, fp);
}
fread(&nheterodyne, sizeof(integer), 1, fp); /* Number of heterodyne
* operators */
heterodyne = (struct FS *) calloc(nheterodyne, sizeof(struct FS));
heterodyne--;
for (i = 1; i <= nheterodyne; i++) {
heterodyne[i].N = N;
fread(&heterodyne[i].nterms, sizeof(integer), 1, fp);
}
fread(&ncollapses, sizeof(integer), 1, fp); /* Number of collapse
* operators */
if (ncollapses > 0) {
fatal_error("Jump processes are not currently supported.");
}
Cprobs = vector(1, ncollapses);
collapses = (struct FS *) calloc(ncollapses, sizeof(struct FS));
collapses--;
for (i = 1; i <= ncollapses; i++) {
collapses[i].N = N;
fread(&collapses[i].nterms, sizeof(integer), 1, fp);
}
fread(&nopers, sizeof(integer), 1, fp); /* Number of operators for which
* to calculate averages */
opers = (struct FS *) calloc(nopers, sizeof(struct FS));
opers--;
for (i = 1; i <= nopers; i++) {
opers[i].N = N;
fread(&opers[i].nterms, sizeof(integer), 1, fp);
}
/* First read in terms on RHS of evolution equation */
file2FS(fp, &RHS);
/* Next read in homodyne operator terms */
if (nhomodyne > 0) {
h**o = vector(1, nhomodyne);
for (i = 1; i <= nhomodyne; i++)
file2FS(fp, &homodyne[i]);
}
/* Next read in heterodyne operator terms */
if (nheterodyne > 0) {
heteror = vector(1, nheterodyne);
heteroi = vector(1, nheterodyne);
for (i = 1; i <= nheterodyne; i++)
file2FS(fp, &heterodyne[i]);
}
/* Next read in collapse operator terms */
if (ncollapses > 0) {
for (i = 1; i <= ncollapses; i++)
file2FS(fp, &collapses[i]);
}
/* Finally read in operator terms for averages */
if (nopers > 0) {
for (i = 1; i <= nopers; i++)
file2FS(fp, &opers[i]);
}
/* Read in intial conditions */
fread(&code, sizeof(integer), 1, fp);
if (code != 2003) {
sprintf(errmsg, "Invalid code in %s, expected %d, found %d.\n", argv[0], 2003, code);
fatal_error(errmsg);
}
ystart = N_VNew(2 * N, NULL); /* Get memory for initial condition */
if (ystart == NULL) {
fatal_error("Memory allocation failure for initial condition.\n");
}
y = N_VNew(2 * N, NULL); /* Get memory for dependent vector */
if (y == NULL) {
fatal_error("Memory allocation failure for state vector.\n");
}
fread(N_VDATA(ystart), sizeof(real), N, fp); /* Read in real parts of
* initial value */
fread(N_VDATA(ystart) + N, sizeof(real), N, fp); /* Read in imaginary
* parts of initial
* value */
fread(&ntimes, sizeof(integer), 1, fp);
tlist = N_VNew(ntimes, NULL); /* Get memory for time vector */
if (tlist == NULL) {
fatal_error("Memory allocation failure for time vector.\n");
}
fread(N_VDATA(tlist), sizeof(real), ntimes, fp);
/* Check that the list of times is equally spaced */
top = Ith(tlist, 1);
deltat = (Ith(tlist, ntimes) - top) / (ntimes - 1);
for (i = 1; i <= ntimes; i++) {
if (fabs(Ith(tlist, i) - top - (i - 1) * deltat) > 0.01 * deltat) {
fatal_error("List of times must be equally spaced.\n");
}
}
fread(&iseed, sizeof(integer), 1, fp);
fread(&ntraj, sizeof(integer), 1, fp); /* Number of trajectories to
* compute */
fread(&ftraj, sizeof(integer), 1, fp); /* Frequency at which expectation
* values are written */
fread(&refine, sizeof(integer), 1, fp); /* Substeps between entries in
* tlist over which noise is
* constant */
/* Calculate internal step size and noise amplitudes */
dt = deltat / refine;
namplr = 1.0 / sqrt(dt);
namplc = 1.0 / sqrt(2.0 * dt);
head = 0;
/* Allocate memory for noise buffers */
if (nhomodyne > 0) {
homnoise = N_VNew(nhomodyne, NULL);
if (homnoise == NULL) {
fatal_error("Memory allocation failure for homodyne noise buffer.\n");
}
}
if (nheterodyne > 0) {
hetnoiser = N_VNew(nheterodyne, NULL);
hetnoisei = N_VNew(nheterodyne, NULL);
if (hetnoiser == NULL || hetnoisei == NULL) {
fatal_error("Memory allocation failure for heterodyne noise buffer.\n");
}
}
/* Read in options for differential equation solver */
method = 0;
itertype = 0;
reltol = RELTOL;
abstol = ABSTOL;
abstolp = &abstol;
nabstol = 1;
if (fread(&code, sizeof(integer), 1, fp) > 0) {
if (code != 1001) {
sprintf(errmsg, "Invalid code in %s, expected %d, found %d.\n", argv[0], 1001, code);
fatal_error(errmsg);
}
fread(&method, sizeof(integer), 1, fp);
fread(&itertype, sizeof(integer), 1, fp);
fread(&reltol, sizeof(real), 1, fp);
fread(&nabstol, sizeof(integer), 1, fp);
if (nabstol == 1)
fread(&abstol, sizeof(real), 1, fp);
else if (nabstol == N) {/* Vector of absolute tolerances */
abstolv = N_VNew(2 * N, NULL);
if (abstolv == NULL) {
fatal_error("Memory allocation failure for absolute tolerance vector.\n");
}
fread(N_VDATA(abstolv), sizeof(real), N, fp);
for (i = 1; i <= N; i++)
Ith(abstolv, N + i) = Ith(abstolv, i);
abstolp = abstolv;
} else {
fatal_error("Absolute tolerance vector has invalid length.\n");
}
fread(&iopt[MAXORD], sizeof(integer), 1, fp);
fread(&iopt[MXSTEP], sizeof(integer), 1, fp);
fread(&iopt[MXHNIL], sizeof(integer), 1, fp);
fread(&ropt[H0], sizeof(real), 1, fp);
fread(&ropt[HMAX], sizeof(real), 1, fp);
fread(&ropt[HMIN], sizeof(real), 1, fp);
}
/* Allocate arrays for expectation values */
if (nopers > 0) {
opr = (N_Vector *) calloc(nopers, sizeof(N_Vector));
opi = (N_Vector *) calloc(nopers, sizeof(N_Vector));
if (opr == NULL || opi == NULL) {
fatal_error("Allocation failure for expectation value array pointers.\n");
}
opr--;
opi--;
for (i = 1; i <= nopers; i++) {
opr[i] = N_VNew(ntimes, NULL);
opi[i] = N_VNew(ntimes, NULL);
if (opr[i] == NULL || opi[i] == NULL) {
fatal_error("Allocation failure for expectation value arrays.\n");
}
}
}
/* Set up the random seeds */
setall(abs(iseed ^ 1234567890L), abs(iseed ^ 987654321L));
pl = vector(1, 2 * N); /* Storage for complex wave function */
q = vector(1, 2 * N); /* Temporary complex storage */
fprintf(stderr, "Integrating stochastic differential equation, %d trajectories, %d times:\n", ntraj, ntimes);
progress = 0;
fprintf(stderr, "Progress: ");
if (nopers == 0)
for (i = 1; i <= ntraj; i++)
sdesim(i, ntraj);
else {
j = 0;
while (j < ntraj) {
clearaver();
for (i = 1; i <= ftraj; i++) {
j++;
sdesim(j, ntraj);
}
writeaver(j);
}
}
fprintf(stderr, "\n");
/* Tidy up at end of algorithm */
if (nopers > 0) {
for (i = 1; i <= nopers; i++) {
N_VFree(opr[i]);
N_VFree(opi[i]);
}
opr++;
free(opr);
opi++;
free(opi);
}
N_VFree(tlist);
N_VFree(y);
N_VFree(ystart);
fclose(fp);
fclose(op);
free_vector(q, 1, 2 * N);
free_vector(pl, 1, 2 * N);
if (photocurflag)
fclose(php);
if (clrecflag)
fclose(cp);
/* Indicate successful completion */
time(&long_time); /* Get time as long integer. */
newtime = localtime(&long_time); /* Convert to local time. */
fp = fopen("success.qo", "w");
fprintf(fp, "SOLVESDE succeeded at %19s\n", asctime(newtime));
fclose(fp);
return 0;
}
integer main(int argc, char *argv[])
{
integer i, j, k, code, dummy;
struct tm *newtime;
time_t long_time;
remove("success.qo");
remove("failure.qo");
if (argc <= 2) {
sprintf(errmsg, "Usage: %s infile outfile1 [outfile2]\n", argv[0]);
fatal_error(errmsg);
}
fp = fopen(argv[1], "rb");
if (fp == NULL) {
sprintf(errmsg, "Error reading problem definition file: %s\n", argv[1]);
fatal_error(errmsg);
}
op = fopen(argv[2], "wb");
if (op == NULL) {
sprintf(errmsg, "Error writing output file: %s\n", argv[2]);
fatal_error(errmsg);
}
clrecflag = (argc >= 4); /* Flag indicating if classical record needed */
if (clrecflag) {
cp = fopen(argv[3], "wb");
if (cp == NULL) {
sprintf(errmsg, "Error writing output file: %s\n", argv[3]);
fatal_error(errmsg);
}
}
fread(&code, sizeof(integer), 1, fp);
if (code != 2001) {
sprintf(errmsg, "Invalid code in %s, expected %d, found %d.\n", argv[0], 2001, code);
fatal_error(errmsg);
}
fread(&N, sizeof(integer), 1, fp); /* Size of sparse matrices */
if (N <= 0) {
fatal_error("Size of problem must be >0.\n");
}
RHS.N = N;
fread(&RHS.nterms, sizeof(integer), 1, fp); /* Number of RHS terms */
if (RHS.nterms <= 0) {
fatal_error("Number of terms on RHS must be >0.\n");
}
fread(&ncollapses, sizeof(integer), 1, fp); /* Number of collapse
* operators */
if (ncollapses < 0) {
fatal_error("Number of collapse operators must be >=0.\n");
}
if (ncollapses > 0) {
Cprobs = vector(1, ncollapses);
collapses = (struct FS *) calloc(ncollapses, sizeof(struct FS));
collapses--;
for (i = 1; i <= ncollapses; i++) {
collapses[i].N = N;
fread(&collapses[i].nterms, sizeof(integer), 1, fp);
if (collapses[i].nterms <= 0) {
sprintf(errmsg, "Invalid number of terms for collapse operator %d.\n", i);
fatal_error(errmsg);
}
}
}
fread(&nopers, sizeof(integer), 1, fp);
opers = (struct FS *) calloc(nopers, sizeof(struct FS));
opers--;
for (i = 1; i <= nopers; i++) {
opers[i].N = N;
fread(&opers[i].nterms, sizeof(integer), 1, fp);
if (opers[i].nterms <= 0) {
sprintf(errmsg, "Invalid number of terms for average operator %d.\n", i);
fatal_error(errmsg);
}
}
/* First read in terms on RHS of evolution equation */
file2FS(fp, &RHS);
/* Next read in collapse operator terms */
if (ncollapses > 0) {
for (i = 1; i <= ncollapses; i++)
file2FS(fp, &collapses[i]);
}
/* Next read in operator terms for averages */
if (nopers > 0) {
for (i = 1; i <= nopers; i++)
file2FS(fp, &opers[i]);
}
/* Read in intial conditions */
fread(&code, sizeof(integer), 1, fp);
if (code != 2003) {
sprintf(errmsg, "Invalid code in %s, expected %d, found %d.\n", argv[0], 2003, code);
fatal_error(errmsg);
}
ystart = N_VNew(2 * N, NULL); /* Get memory for initial condition */
if (ystart == NULL) {
fatal_error("Memory allocation failure for initial condition.\n");
}
y = N_VNew(2 * N, NULL); /* Get memory for dependent vector */
if (y == NULL) {
fatal_error("Memory allocation failure for state vector.\n");
}
fread(N_VDATA(ystart), sizeof(real), N, fp); /* Read in real parts of
* initial value */
fread(N_VDATA(ystart) + N, sizeof(real), N, fp); /* Read in imaginary
* parts of initial
* value */
fread(&ntimes, sizeof(integer), 1, fp);
tlist = N_VNew(ntimes, NULL); /* Get memory for time vector */
if (tlist == NULL) {
fatal_error("Memory allocation failure for time vector.\n");
}
fread(N_VDATA(tlist), sizeof(real), ntimes, fp);
fread(&iseed, sizeof(integer), 1, fp);
fread(&ntraj, sizeof(integer), 1, fp); /* Number of trajectories to
* compute */
fread(&ftraj, sizeof(integer), 1, fp); /* Frequency at which expectation */
/* values are written */
fread(&dummy, sizeof(integer), 1, fp); /* Unused parameter */
/* Read in options for differential equation solver */
method = 0;
itertype = 0;
reltol = RELTOL;
abstol = ABSTOL;
abstolp = &abstol;
nabstol = 1;
if (fread(&code, sizeof(integer), 1, fp) > 0) {
if (code != 1001) {
sprintf(errmsg, "Invalid code in %s, expected %d, found %d.\n", argv[0], 1001, code);
fatal_error(errmsg);
}
fread(&method, sizeof(integer), 1, fp);
fread(&itertype, sizeof(integer), 1, fp);
fread(&reltol, sizeof(real), 1, fp);
fread(&nabstol, sizeof(integer), 1, fp);
if (nabstol == 1)
fread(&abstol, sizeof(real), 1, fp);
else if (nabstol == N) {/* Vector of absolute tolerances */
abstolv = N_VNew(2 * N, NULL);
if (abstolv == NULL) {
fatal_error("Memory allocation failure for absolute tolerance vector.\n");
}
fread(N_VDATA(abstolv), sizeof(real), N, fp);
for (i = 1; i <= N; i++)
Ith(abstolv, N + i) = Ith(abstolv, i);
abstolp = abstolv;
} else {
fatal_error("Absolute tolerance vector has invalid length.\n");
}
fread(&iopt[MAXORD], sizeof(integer), 1, fp);
fread(&iopt[MXSTEP], sizeof(integer), 1, fp);
fread(&iopt[MXHNIL], sizeof(integer), 1, fp);
fread(&ropt[H0], sizeof(real), 1, fp);
fread(&ropt[HMAX], sizeof(real), 1, fp);
fread(&ropt[HMIN], sizeof(real), 1, fp);
}
/* Allocate arrays for expectation values */
if (nopers > 0) {
opr = (N_Vector *) calloc(nopers, sizeof(N_Vector));
opi = (N_Vector *) calloc(nopers, sizeof(N_Vector));
if (opr == NULL || opi == NULL) {
fatal_error("Allocation failure for expectation value array pointers.\n");
}
opr--;
opi--;
for (i = 1; i <= nopers; i++) {
opr[i] = N_VNew(ntimes, NULL);
opi[i] = N_VNew(ntimes, NULL);
if (opr[i] == NULL || opi[i] == NULL) {
fatal_error("Allocation failure for expectation value arrays.\n");
}
}
}
/* Set up the random seeds */
setall(abs(iseed ^ 1234567890L), abs(iseed ^ 987654321L));
progress = 0;
if (ncollapses > 0) { /* Use quantum trajectory algorithm */
fprintf(stderr, "Integrating differential equation, %d trajectories, %d times.\n", ntraj, ntimes);
fprintf(stderr, "Progress: ");
q = N_VNew(2 * N, NULL);/* Get memory for temporary storage */
if (nopers == 0) /* Calculate and store wave functions */
for (i = 1; i <= ntraj; i++)
mcwfalg(i, ntraj);
else { /* Only store averages of specified operators */
j = 0;
while (j < ntraj) {
clearaver();
for (i = 1; i <= ftraj; i++) {
j++;
mcwfalg(j, ntraj);
}
writeaver(j);
}
}
N_VFree(q);
} else {
fprintf(stderr, "Integrating differential equation, %d times.\n", ntimes);
fprintf(stderr, "Progress: ");
integrate(); /* Use direct integration */
}
fprintf(stderr, "\n");
/* Tidy up at end of algorithm */
if (nopers > 0) {
for (i = 1; i <= nopers; i++) {
N_VFree(opr[i]);
N_VFree(opi[i]);
}
opr++;
free(opr);
opi++;
free(opi);
}
N_VFree(tlist);
N_VFree(y);
N_VFree(ystart);
fclose(fp);
fclose(op);
if (clrecflag)
fclose(cp);
/* Indicate successful completion */
time(&long_time); /* Get time as long integer. */
newtime = localtime(&long_time); /* Convert to local time. */
fp = fopen("success.qo", "w");
fprintf(fp, "SUCCESS\nSOLVEMC succeeded at %19s\n", asctime(newtime));
fclose(fp);
return 0;
}
int main()
{
M_Env machEnv;
realtype abstol, reltol, t, tout, ropt[OPT_SIZE];
long int iopt[OPT_SIZE];
N_Vector y;
UserData data;
CVBandPreData bpdata;
void *cvode_mem;
int ml, mu, iout, flag, jpre;
/* Initialize serial machine environment */
machEnv = M_EnvInit_Serial(NEQ);
/* Allocate and initialize y, and set problem data and tolerances */
y = N_VNew(NEQ, machEnv);
data = (UserData) malloc(sizeof *data);
InitUserData(data);
SetInitialProfiles(y, data->dx, data->dz);
abstol = ATOL; reltol = RTOL;
/* Call CVodeMalloc to initialize CVODE:
NEQ is the problem size = number of equations
f is the user's right hand side function in y'=f(t,y)
T0 is the initial time
y is the initial dependent variable vector
BDF specifies the Backward Differentiation Formula
NEWTON specifies a Newton iteration
SS specifies scalar relative and absolute tolerances
&reltol and &abstol are pointers to the scalar tolerances
data is the pointer to the user-defined block of coefficients
FALSE indicates there are no optional inputs in iopt and ropt
iopt and ropt arrays communicate optional integer and real input/output
A pointer to CVODE problem memory is returned and stored in cvode_mem. */
cvode_mem = CVodeMalloc(NEQ, f, T0, y, BDF, NEWTON, SS, &reltol,
&abstol, data, NULL, FALSE, iopt, ropt, machEnv);
if (cvode_mem == NULL) { printf("CVodeMalloc failed."); return(1); }
/* Call CVBandPreAlloc to initialize band preconditioner */
ml = mu = 2;
bpdata = CVBandPreAlloc (NEQ, f, data, mu, ml, cvode_mem);
/* Call CVSpgmr to specify the CVODE linear solver CVSPGMR with
left preconditioning, modified Gram-Schmidt orthogonalization,
default values for the maximum Krylov dimension maxl and the tolerance
parameter delt, preconditioner setup and solve routines CVBandPrecond
and CVBandPSolve, the pointer to the user-defined block data, and
NULL for the user jtimes routine and Jacobian data pointer. */
flag = CVSpgmr(cvode_mem, LEFT, MODIFIED_GS, 0, 0.0, CVBandPrecond,
CVBandPSolve, bpdata, NULL, NULL);
if (flag != SUCCESS) { printf("CVSpgmr failed."); return(1); }
printf("2-species diurnal advection-diffusion problem, %d by %d mesh\n",
MX, MZ);
printf("SPGMR solver; band preconditioner; mu = %d, ml = %d\n\n",
mu, ml);
/* Loop over jpre (= LEFT, RIGHT), and solve the problem */
for (jpre = LEFT; jpre <= RIGHT; jpre++) {
/* On second run, re-initialize y, CVODE, CVBANDPRE, and CVSPGMR */
if (jpre == RIGHT) {
SetInitialProfiles(y, data->dx, data->dz);
flag = CVReInit(cvode_mem, f, T0, y, BDF, NEWTON, SS, &reltol,
&abstol, data, NULL, FALSE, iopt, ropt, machEnv);
if (flag != SUCCESS) { printf("CVReInit failed."); return(1); }
flag = CVReInitBandPre(bpdata, NEQ, f, data, mu, ml);
flag = CVReInitSpgmr(cvode_mem, jpre, MODIFIED_GS, 0, 0.0,
CVBandPrecond, CVBandPSolve, bpdata, NULL, NULL);
if (flag != SUCCESS) { printf("CVReInitSpgmr failed."); return(1); }
printf("\n\n-------------------------------------------------------");
printf("------------\n");
}
printf("\n\nPreconditioner type is: jpre = %s\n\n",
(jpre == LEFT) ? "LEFT" : "RIGHT");
/* In loop over output points, call CVode, print results, test for error */
for (iout = 1, tout = TWOHR; iout <= NOUT; iout++, tout += TWOHR) {
flag = CVode(cvode_mem, tout, y, &t, NORMAL);
PrintOutput(iopt, ropt, y, t);
if (flag != SUCCESS) {
printf("CVode failed, flag = %d.\n", flag);
break;
}
}
/* Print final statistics */
PrintFinalStats(iopt);
} /* End of jpre loop */
/* Free memory */
N_VFree(y);
free(data);
CVBandPreFree(bpdata);
CVodeFree(cvode_mem);
M_EnvFree_Serial(machEnv);
return(0);
}
