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); }
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 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; }
void mcwfalg(integer itraj, integer ntraj) { integer i, N, exflag, flag; real eps = 1.0e-6, t, temp; real nl, nr, na, tl, tr, taim, thresh; double sum = 0.0; N = RHS.N; for (i = 1; i <= 2 * N; i++) Ith(y, i) = Ith(ystart, i); /* Initialize ODE solver */ 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); q = N_VNew(2 * N, NULL); thresh = genunf(0.0, 1.0); /* Generate target value of norm^2 */ if (nopers == 0) fwrite(&itraj, sizeof(integer), 1, op); if (clrecflag) { temp = itraj; fwrite(&temp, sizeof(real), 1, cp); temp = 0.0; fwrite(&temp, sizeof(real), 1, cp); } tr = Ith(tlist, 1); nr = norm2(N_VDATA(y) - 1, N); if (nopers == 0) fwrite(N_VDATA(y), sizeof(real), 2 * N, op); else operAccum(N_VDATA(y) - 1, N_VDATA(q) - 1, N, tr, 1); for (i = 2; i <= ntimes;) { taim = Ith(tlist, i); tl = tr; nl = nr; flag = CVode1(cvode_mem, taim, y, &tr, ONE_STEP); if (flag != SUCCESS) { sprintf(errmsg, "CVode failed, flag=%d.\n", flag); fatal_error(errmsg); } nr = norm2(N_VDATA(y) - 1, N); for (; i <= ntimes;) { if (tr < taim) { if (nr < thresh) { tr = docollapse(tl, nl, tr, nr, thresh); /* A collapse has * occured */ nr = 1.0; thresh = genunf(0.0, 1.0); /* Generate target value of * norm^2 */ } break; } else { flag = CVode1(cvode_mem, taim, y, &t, NORMAL); /* Interpolate */ if (flag != SUCCESS) { sprintf(errmsg, "CVode failed, flag=%d.\n", flag); fatal_error(errmsg); } na = norm2(N_VDATA(y) - 1, N); if (na < thresh) { tr = docollapse(tl, nl, taim, na, thresh); /* A collapse has * occured */ nr = 1.0; thresh = genunf(0.0, 1.0); /* Generate target value of * norm^2 */ break; } else { /* Write out results */ tl = taim; nl = na; if (nopers == 0) fwrite(N_VDATA(y), sizeof(real), 2 * N, op); else operAccum(N_VDATA(y) - 1, N_VDATA(q) - 1, N, taim, i); i += 1; progress += NHASH; while (progress >= (ntimes - 1) * ntraj) { fprintf(stderr, "#"); progress -= (ntimes - 1) * ntraj; } taim = Ith(tlist, i); } } } } CVodeFree(cvode_mem); }
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); }
/* Main Function */ int main(int argc, char *argv[]) { char *filename = "shalehills"; /* Input file name prefix */ char *StateFile; /* Output file name string */ char *FluxFile; char *ETISFile; char *QFile; Model_Data mData; /* Model Data */ Control_Data cData; /* Solver Control Data */ N_Vector CV_Y; /* State Variables Vector */ M_Env machEnv; /* Machine Environments */ realtype ropt[OPT_SIZE]; /* Optional real type and integer type */ long int iopt[OPT_SIZE]; /* vecter for Message Passing to solver */ void *cvode_mem; /* Model Data Pointer */ int flag; /* flag to test return value */ FILE *res_state_file; /* Output file for States */ FILE *res_flux_file; /* Output file for Flux */ FILE *res_etis_file; /* Output file for ET and IS */ FILE *res_q_file; int N; /* Problem size */ int i; /* loop index */ realtype t; /* simulation time */ realtype NextPtr, StepSize; /* stress period & step size */ clock_t start, end_r, end_s; /* system clock at points */ realtype cputime_r, cputime_s; /* for duration in realtype */ /* allocate memory for model data structure */ mData = (Model_Data)malloc(sizeof *mData); start = clock(); /* get user specified file name in command line */ if(argc >= 2) { filename = (char *)malloc(strlen(argv[1])*sizeof(char)); strcpy(filename, argv[1]); } printf("\nBelt up! PIHM 1.0 is starting ... \n"); /* read in 7 input files with "filename" as prefix */ read_alloc(filename, mData, &cData); /* problem size */ N = 3*mData->NumEle + mData->NumRiv; /* initial machine environment variable */ machEnv = M_EnvInit_Serial(N); /* initial state variable depending on machine*/ CV_Y = N_VNew(N, machEnv); /* initialize mode data structure */ initialize(filename, mData, &cData, CV_Y); if(cData.Debug == 1) {PrintModelData(mData);} end_r = clock(); cputime_r = (end_r - start)/(realtype)CLOCKS_PER_SEC; printf("\nSolving ODE system ... \n"); /* initial control parameter for CVODE solver. Otherwise the default value by C could cause problems. */ for(i=0; i<OPT_SIZE; i++) { ropt[i] = 0.0; iopt[i] = 0; } /* set user specified control parameter */ ropt[H0] = cData.InitStep; ropt[HMAX] = cData.MaxStep; /* allocate memory for solver */ cvode_mem = CVodeMalloc(N, f, cData.StartTime, CV_Y, BDF, NEWTON, SS, &cData.reltol, &cData.abstol, mData, NULL, TRUE, iopt, ropt, machEnv); if(cvode_mem == NULL) {printf("CVodeMalloc failed. \n"); return(1);} if(cData.Solver == 1) { /* using dense direct solver */ flag = CVDense(cvode_mem, NULL, NULL); if(flag != SUCCESS) {printf("CVDense failed. \n"); return(1);} } else if(cData.Solver == 2) { /* using iterative solver */ flag = CVSpgmr(cvode_mem, NONE, cData.GSType, cData.MaxK, cData.delt, NULL, NULL, mData, NULL, NULL); if (flag != SUCCESS) {printf("CVSpgmr failed."); return(1);} } /*allocate and copy to get output file name */ StateFile = (char *)malloc((strlen(filename)+4)*sizeof(char)); strcpy(StateFile, filename); FluxFile = (char *)malloc((strlen(filename)+5)*sizeof(char)); strcpy(FluxFile, filename); ETISFile = (char *)malloc((strlen(filename)+5)*sizeof(char)); strcpy(ETISFile, filename); QFile = (char *)malloc((strlen(filename)+2)*sizeof(char)); strcpy(QFile, filename); /* open output file */ if (cData.res_out == 1) {res_state_file = fopen(strcat(StateFile, ".res"), "w");} if (cData.flux_out == 1) {res_flux_file = fopen(strcat(FluxFile, ".flux"), "w");} if (cData.etis_out == 1) {res_etis_file = fopen(strcat(ETISFile, ".etis"), "w");} if (cData.q_out == 1) {res_q_file = fopen(strcat(QFile, ".q"), "w");} /* print header of output file */ if (cData.res_out == 1) {FPrintYheader(res_state_file, mData);} if (cData.etis_out == 1) {FPrintETISheader(res_etis_file, mData);} if (cData.q_out == 1) {FPrintETISheader(res_q_file, mData);} printf("\n"); /* set start time */ t = cData.StartTime; /* start solver in loops */ for(i=0; i<cData.NumSteps; i++) { /* prompt information in non-verbose mode */ if (cData.Verbose != 1) { printf(" Running: %-4.1f%% ... ", (100*(i+1)/((realtype) cData.NumSteps))); fflush(stdout); } /* inner loops to next output points with ET step size control */ while(t < cData.Tout[i+1]) { if (t + cData.ETStep >= cData.Tout[i+1]) { NextPtr = cData.Tout[i+1]; } else { NextPtr = t + cData.ETStep; } StepSize = NextPtr - t; /* calculate Interception Storage */ calIS(t, StepSize, mData); /* solving ODE system */ flag = CVode(cvode_mem, NextPtr, CV_Y, &t, NORMAL); /* calculate ET and adjust states variables*/ calET(t, StepSize, CV_Y, mData); } if(cData.Verbose == 1) {PrintVerbose(i, t, iopt, ropt);} /* uncomment it if user need it verbose mode */ /* if(cData.Verbose == 1) {PrintY(mData, CV_Y, t);} */ /* print out results to files at every output time */ if (cData.res_out == 1) {FPrintY(mData, CV_Y, t, res_state_file);} if (cData.flux_out == 1) {FPrintFlux(mData, t, res_flux_file);} if (cData.etis_out == 1) {FPrintETIS(mData, t, res_etis_file);} if (cData.q_out == 1) {FPrintQ(mData, t, res_q_file);} if (cData.Verbose != 1) {printf("\r");} if(flag != SUCCESS) {printf("CVode failed, flag = %d. \n", flag); return(flag);} /* clear buffer */ fflush(stdout); } /* free memory */ /* N_VFree(CV_Y); CVodeFree(cvode_mem); M_EnvFree_Serial(machEnv); */ /* capture time */ end_s = clock(); cputime_s = (end_s - end_r)/(realtype)CLOCKS_PER_SEC; /* print out simulation statistics */ PrintFarewell(cData, iopt, ropt, cputime_r, cputime_s); if (cData.res_out == 1) {FPrintFarewell(cData, res_state_file, iopt, ropt, cputime_r, cputime_s);} /* close output files */ if (cData.res_out == 1) {fclose(res_state_file);} if (cData.flux_out == 1) {fclose(res_flux_file);} if (cData.etis_out == 1) {fclose(res_etis_file);} if (cData.q_out == 1) {fclose(res_q_file);} free(mData); return 0; }